Friday, December 31, 2010

Checkers game-over in Haskell

The programming subreddit recently had a discussion about testing a checkers board for game-over. I wondered how specifying the rules for legal moves would look with Haskell's pattern matching, and this post is a study of that technique. In fact, you can run yourself. Copy-and-paste the post body to a file named Checkers.lhs to get a working program!

The game is American checkers or English draughts, played on an eight-by-eight checkerboard, of all surfaces.

> {-# LANGUAGE ViewPatterns #-}
> module Checkers where
> import Data.Char (toLower,toUpper)
> import Data.List (tails,transpose)
> import Test.HUnit
> data Board = Board [String] deriving (Show)
> size :: Int
> size = 8

For a rough idea of the punchline, I was hoping for code along the lines of

move ('w':' ':_)     = 1
move ('W':' ':_)     = 1
move (' ':'W':_)     = 1
move ('w':'b':' ':_) = 1
move ('w':'B':' ':_) = 1
move ('W':'b':' ':_) = 1
move ('W':'B':' ':_) = 1
move (' ':'b':'W':_) = 1
move (' ':'B':'W':_) = 1
move _ = 0

and eventually

> gameOver :: Board -> Bool
> gameOver b = blueMoves b == 0 || whiteMoves b == 0

The OP on reddit chose white and blue for the sides' colors, and above we have more-or-less declarative rules for legal white moves. A pawn or king (w and W respectively) can move to an empty space before it. Kings are special in that they can move backwards. The list ends with legal jumps, and everything else is invalid.

The code is repetitive, but I'll clean that up later.

An immediate problem is the patterns are linear, but all legal moves in checkers are along diagonals. I kicked around ideas such as using IArray or nasty double-applications of !!. Then I realized I could rotate the board by 45° with a shear, a transposition, and removal of placeholders.

-- diagonals with positive slopes
posdiags = map reverse . filter used . transpose . map shear . zip [0..]
  where shear (i,s) = (replicate i              '#') ++ s ++
                      (replicate (k - size - i) '#')
        k = 2 * size - 1
        used = not . all (`elem` "#.")

Getting the other diagonals is similar, but again brings too much repetition.

negdiags = map reverse . filter used . transpose . map shear . zip [0..]
  where shear (i,s) = (replicate (k - size - i) '#') ++ s ++
                      (replicate i              '#')
        k = 2 * size - 1
        used = not . all (`elem` "#.")

Having Board values to play with is trivial:

> board :: String -> Board
> board s = Board $ go s
>   where go [] = []
>         go xs = let (a,bs) = splitAt size xs
>                 in a : go bs

It chops one long string into rows, but with Haskell's usually-awkward multiline strings, it's not so bad. For example

startBoard =
  ".b.b.b.b\
  \b.b.b.b.\
  \.b.b.b.b\
  \ . . . .\
  \. . . . \
  \w.w.w.w.\
  \.w.w.w.w\
  \w.w.w.w."

An early cut at blueMoves and reducing the repetition in the rules for moves was

blueMoves :: Board -> Int
blueMoves (diagonals -> (p,n)) =
  sum $ map move $ concatMap tails $ p ++ n
  where move ( b :' ':_) | b `elem` "Bb" = 1
        move (' ':'B':_) = 1
        move ('b': w :' ':_) | w `elem` "Ww" = 1
        move (' ': w :'B':_) | w `elem` "Ww" = 1
        move _ = 0

Sticking with the theme of repetition, whiteMoves is nearly identical with little breadcrumbs of differences. That was all good because I wanted to have a testsuite before I started refactoring.

tests :: Test
tests = test
  [ assertEqual "white must have piece to move"
      0 (nw ".b.b.b.b\
            \b.b.b.b.\
            \.b.b.b.b\
            \ . . . .\
            \. . . . \
            \ . . . .\
            \. . . . \
            \ . . . .")
  ]
  where nw = whiteMoves . board

Not bad for a start, but each testcase will have a dual for the other side—way too much copy-and-paste.

*Checkers> runTestTT tests
Loading package HUnit-1.2.2.1 ... linking ... done.
Cases: 1  Tried: 1  Errors: 0  Failures: 0
Counts {cases = 1, tried = 1, errors = 0, failures = 0}

Whee!

To wring out the duplication in the code for each side's moves, I considered using Template Haskell—a cousin of Lisp macros for Haskell. I decided to push lexical closures as far as I could, and the result is below.

> blueMoves, whiteMoves :: Board -> Int
> [blueMoves, whiteMoves] =
>   let blueOrder = id  -- diagonals emerge in blue's perspective
>       whiteOrder = map reverse
>       count (direction,side) (diagonals -> ds) =
>         sum $ map sideCanMove $ concatMap tails $ direction $ ds
>         where sideCanMove ( p :' ':_)     | same p = 1
>               sideCanMove (' ': k :_)     | king k = 1
>               sideCanMove ( p : o :' ':_) | same p && opponent o = 1
>               sideCanMove (' ': o : k :_) | king k && opponent o = 1
>               sideCanMove _ = 0
>               same p     = piece p && toLower p == toLower side
>               opponent p = piece p && toLower p /= toLower side
>               king p     =  same p &&         p == toUpper side
>               piece p    = p `elem` "BbWw"  -- filter empty spaces
>   in map count [ (blueOrder, 'b'), (whiteOrder, 'w') ]

The code in count (notice the view pattern?) is a skeleton to be customized for the blue side and the white side, and it distills the repeated code. The definition of sideCanMove generalizes the rules for legal moves on either side. We have to reverse the diagonals to make them usable on the white side.

To get both sets of diagonals, the only difference is how to shear the board: bottom-away for positive slopes and top-away for negative.

> -- positive slopes slice from NW to SE
> -- negative slopes slice from SW to NE
> -- both extend in blue's direction (north-to-south)
> diagonals :: Board -> [String]
> diagonals (Board rows) = positiveSlopes rows ++ negativeSlopes rows
>   where positiveSlopes = go $ \(i,xs) -> (i, k - size - i, xs)
>         negativeSlopes = go $ \(i,xs) -> (k - size - i, i, xs)
>         k = 2 * size - 1
>         used = not . all ignored
>         go order = filter (not . null)
>                  . map (filter $ not . ignored)
>                  . transpose
>                  . map (shear . order)
>                  . zip [0..]
>         ignored = (`elem` "#.")
>         shear (l,r,s) = (replicate l '#') ++ s ++ (replicate r '#')

Finally come the tests that I added as I went. To factor out duplication, each board becomes two testcases. The first is as-is, and the same condition should hold for the other side. See the definition of invert in the where clause.

I had hoped for a more elegant result, but it was an interesting exercise and a fun problem!

> tests :: Test
> tests = test $ concat
>   [ checkMoves "must have piece to move"
>       0 ".b.b.b.b\
>         \b.b.b.b.\
>         \.b.b.b.b\
>         \ . . . .\
>         \. . . . \
>         \ . . . .\
>         \. . . . \
>         \ . . . ."
>   , checkMoves "one move"
>       1 ". . . . \
>         \ . . . .\
>         \. . . . \
>         \ . . . .\
>         \. . . . \
>         \ . . . .\
>         \. . . . \
>         \w. . . ."
>   , checkMoves "one king move"
>       1 ". . . . \
>         \ . . . .\
>         \. . . . \
>         \ . . . .\
>         \. . . . \
>         \ . . . .\
>         \. . . . \
>         \W. . . ."
>   , checkMoves "two moves"
>       2 ". . . . \
>         \ . . . .\
>         \. . . . \
>         \ . . . .\
>         \. . . . \
>         \ . . . .\
>         \. . . . \
>         \ .w. . ."
>   , checkMoves "king can move back from end"
>       2 ". . .W. \
>         \ . . . .\
>         \. . . . \
>         \ . . . .\
>         \. . . . \
>         \ . . . .\
>         \. . . . \
>         \ . . . ."
>   , checkMoves "can jump opponent pawn"
>       1 ". . . . \
>         \ . . . .\
>         \. . . . \
>         \ . . . .\
>         \. . . . \
>         \ . . . .\
>         \.b. . . \
>         \w. . . ."
>   , checkMoves "can't jump blocked opponent"
>       0 ". . . . \
>         \ . . . .\
>         \. . . . \
>         \ . . . .\
>         \. . . . \
>         \ .b. . .\
>         \.b. . . \
>         \w. . . ."
>   , checkMoves "can jump opponent king"
>       1 ". . . . \
>         \ . . . .\
>         \. . . . \
>         \ . . . .\
>         \. . . . \
>         \ . . . .\
>         \.B. . . \
>         \w. . . ."
>   , checkMoves "king can jump trailing opponent"
>       1 ". . . .W\
>         \ . . .b.\
>         \. . . . \
>         \ . . . .\
>         \. . . . \
>         \ . . . .\
>         \. . . . \
>         \ . . . ."
>   , checkMoves "king can't jump protected opponent"
>       0 ". . . .W\
>         \ . . .b.\
>         \. . .b. \
>         \ . . . .\
>         \. . . . \
>         \ . . . .\
>         \. . . . \
>         \ . . . ."
>   , checkMoves "king can't jump onto own piece"
>       1 ". . . .W\
>         \ . . .b.\
>         \. . .w. \
>         \ . . . .\
>         \. . . . \
>         \ . . . .\
>         \. . . . \
>         \ . . . ."
>   , checkMoves "king has four moves"
>       4 ". . . . \
>         \ . . . .\
>         \. . . . \
>         \ . .W. .\
>         \. . . . \
>         \ . . . .\
>         \. . . . \
>         \ . . . ."
>   , checkMoves "cannot displace opponent on king row"
>       0 ". . .b.b\
>         \ . . .w.\
>         \. . . . \
>         \ . . . .\
>         \. . . . \
>         \ . . . .\
>         \. . . . \
>         \ . . . ."
>   ]
>   where nw = whiteMoves . board
>         nb = blueMoves  . board
>         checkMoves name expect b =
>           [ assertEqual ("white: " ++ name) expect (nw b)
>           , assertEqual ("blue: "  ++ name) expect (nb $ invert b)
>           ]
>         invert = reverse . replace [('W','B'), ('w','b'), ('B','W'), ('b','w')]
>         replace tbl = map (\c -> maybe c id $ lookup c tbl)

Monday, October 18, 2010

Healthy weight loss diet the CrossFit way

The CrossFit Journal published an easy guide to starting the Zone diet, and it's available as a free download.

Check the chart on page 2 to find how many blocks per day you should eat. You could also tinker with this Zone block calculator. You'll need to know your weight and have an idea of your body-fat percentage. The recommended activity level is 0.7 for Crossfitters, so select “Light to medium 2-3x per week.” Yes, I share your likely indignation at that unjust description!

Page 3 gives a block chart with columns for proteins, carbs, and fats—plus a small combo section. The next page lists unfavorable carbs that earn this designation due to their tendency to rapidly spike your insulin (also known as having a high glycemic load). This doesn't mean you can't have them—you can Zone just about anything—but that you want to limit how often you eat them. Being from 2004, the table is a bit dated, and the Dr. Sears people have since promoted carrots to favorable status, for example. I'm not aware of other changes.

The inset picture is a cellphone snapshot of my 4-block breakfast: 4 eggs scrambled in 1⅓ teaspoons of butter, an orange, half a cup of salsa, and a cucumber.

I keep a copy of the block charts above my refrigerator at home. To put together a meal with the chart, you need to know how large it will be, i.e., how many blocks, and then you pick that many blocks of protein, carbs, and fat. The chart on page 2 suggests five 2-block meals for a ten-block day, for example, but size your meals in a way that works best for you: maybe three 3-block meals and then a 1-block snack before bed.

Let's walk through my thought process for today's 4-block “first lunch.” I wanted chicken breast, and the chart tells me an ounce is one block. That means I get four ounces of chicken breast. I like pears, and a pear counts for two blocks, leaving me with two more to go. A half-cup of carrots is a block, so a whole cup makes two blocks. For fat, about three pistachios constitute a block, so I had 12 (= 4 blocks × 3 pistachios/block). In summary,
  • Protein: 4 ounces of chicken breast (4 blocks)
  • Carb: a pear (2 blocks); 1 c. carrots (2 blocks)
  • Fat: 12 pistachios (4 blocks)
After doing it a while, you'll memorize your frequent choices, and I put together the above meal without having to consult the chart. Pistachios aren't listed, so I must have looked it up on the web. For other examples (with pictures!), read Jeff's “The Zone Diet Explained” blog post. For tips on eating out, read “Top 10 Zone-Friendly Meals in Huntsville.”

If you'd like a more exciting meal, the number of ingredients is entirely up to you. Remember that you don't necessarily have to use whole-block portions, so you could make a salad with several different ingredients. Just be sure that the totals add up correctly. The rest of the article has tasty and easy recipes, separated into 2-, 3-, 4-, and 5-block meals and also 1-block snacks. The chili is delicious!

It does take a week or two of getting used to. Some suggest that many of our food cravings are due to hormonal imbalance, and Zone is designed to level them out. I no longer have the ups and downs from spiking my blood sugar with carb overload, and I'm leaner than I've been in 10+ years. Don't go crazy either: let yourself cheat now and then. Among many other benefits, fish oil will cut you some slack on your diet. A common recommendation is to start off eating strictly for a month and then, after seeing the great results this will produce, maintaining on an 80/20 cycle—strict during the week and relaxed on the weekends.

Thursday, June 24, 2010

Hard-boiled eggs in a microwave

I found instructions at eHow for making hard-boiled eggs in a microwave. I tried it this morning, and it worked!

The tl;dr version of the steps is

  1. fill bowl with enough water to cover eggs
  2. remove eggs
  3. bring water to a boil
  4. carefully place eggs in hot water
  5. cover with a plate and cook on low power for 8 minutes
  6. let stand for another 6-8 minutes

I cooked the eggs in a GE Profile JES2251SJ microwave. I unintentionally left out the salt and vinegar. I cooked four eggs, and it took the water about 4 minutes to come to the initial boil. This particular model has power settings from 1 to 10, and I used setting 2 on the fifth step. The instructions say the plate is for limiting the mess in case an egg explodes, but I used an upside-down paper plate. I doubt it would have been great for containment.

After all this, I poured out the hot water and ran cold water over the eggs a couple of times. Then I added ice and waited a few minutes for them to cool off.

At this point, I was relieved that none of the eggs had exploded, but—as you might imagine—I was worried that I hadn't cooked them enough. I picked up the first, and it felt pretty solid. Then a gentle tap-tap-tap. No runny mess!

The yolks were well done, but the whites were a touch runny in places on the outside. Next time, I'll either try a slightly less-low low-power setting or let the eggs stand a bit longer.

Thursday, May 13, 2010

Intel WiFi 6000 on Ubuntu 10.04

A fresh install of Ubuntu 10.04 on a Dell Studio XPS 16 didn't want to enable its Intel Wireless WiFi Link 6000. Pressing the wifi touchkey didn't help.

Running rfkill list gave

0: phy0: Wireless LAN
             Soft blocked: yes
             Hard blocked: no
NetworkManager Applet reported wireless as disabled or device not ready.

I read that removing the dell_laptop kernel module might help, but it did no good in my case.

What finally did the trick for me was

sudo rfkill unblock wifi

Monday, March 01, 2010

Perl: conditional use and scope

A reader asks

If I conditionally load a perl module, do those module variables get passed to the whole perl script.

if ( some_test ) {
  use "perlmodule_001";
}
else {
  use "perlmodule_002";
}
Are the elements of either perl module available outside the if statement?

The main program from the question has a syntax error:

syntax error at prog0 line 2, near "use "perlmodule_001""

Perl's documentation for use explains:

use Module

Imports some semantics into the current package from the named module, generally by aliasing certain subroutine or variable names into your package. It is exactly equivalent to

BEGIN { require Module; Module->import( LIST ); }
except that Module must be a bareword.

Note the bareword constraint at the end: the compiler doesn't like the double quotes around the argument to use. Our friend was likely thinking of the older require operator that does accept strings and arbitrary expressions in general.

Say we have two modules with alternative definitions of $Foo and $Bar:

package Perlmodule_001;

use Exporter 'import';
our @EXPORT = qw/ $Foo $Bar /;

our $Foo = "apple";
our $Bar = "orange";

1;

and

package Perlmodule_002;

use Exporter 'import';
our @EXPORT = qw/ $Foo $Bar /;

our $Foo = 42;
our $Bar = "w00t!";

1;

Note the use of Perlmodule_001, for example, rather than perlmodule_001: the perlmodlib documentation notes, “Perl informally reserves lowercase module names for 'pragma' modules like integer and strict.”

Consider the following simple driver:

#! /usr/bin/perl

use warnings;
use strict;

if (@ARGV && $ARGV[0] eq "two") {
  use Perlmodule_002;
}
else {
  use Perlmodule_001;
}

sub maybeUndef {
  defined $_[0] ? $_[0] : "<undefined>";
  # got 5.10?
  # $_[0] // "<undefined>";
}

print "Foo = ", maybeUndef($Foo),  "\n",
      "Bar = ", maybeUndef($Bar),  "\n";

It uses maybeUndef to explicitly show when a value is undefined and also to silence potential undefined-value warnings.

The program seems to run as intended

$ ./prog1
Foo = apple
Bar = orange

but the output is the same even when an argument of two is supplied on the command line!

$ ./prog1 two
Foo = apple
Bar = orange

The good news is that the imported variables are in scope for the rest of the program, as indicated in the above documentation for use (with emphasis added):

Imports some semantics into the current package from the named module …

To understand why we never see Perlmodule_002's $Foo and $Bar, note that use “is exactly equivalent to” require at BEGIN time, and the perlmod documentation explains exactly when that is (with added emphasis):

A BEGIN code block is executed as soon as possible, that is, the moment it is completely defined, even before the rest of the containing file (or string) is parsed.

So the compiler sees use Perlmodule_002 and processes it. Then it sees use Perlmodule_001 and processes it. When the compiler finishes digesting the rest of the code, it's time for the execution phase, when the @ARGV check finally takes place. As written, Perlmodule_001 will always win!

Because ordinary modules affect the current package, useing an ordinary module inside a conditional block is entirely misleading. I was careful to qualify the previous statement for ordinary modules because the effects of some pragmatic modules (e.g., strict and integer—note the lowercase names!) are limited tightly to the enclosing block only.

The fix is to process @ARGV at BEGIN time and conditionalize the module imports with the equivalent require and import:

#! /usr/bin/perl

use warnings;
use strict;

BEGIN {
  if (@ARGV && $ARGV[0] eq "two") {
    require Perlmodule_002;
    Perlmodule_002->import;
  }
  else {
    require Perlmodule_001;
    Perlmodule_001->import;
  }
}

sub maybeUndef {
  defined $_[0] ? $_[0] : "<undefined>";
  # got 5.10?
  # $_[0] // "<undefined>";
}

print "Foo  = ", maybeUndef($Foo),  "\n",
      "Bar  = ", maybeUndef($Bar),  "\n";

An alternative is protecting use with eval as in

BEGIN {
  if (@ARGV && $ARGV[0] eq "two") {
    eval "use Perlmodule_002";
  }
  # ...

so a particular use runs only when control reaches its eval but is ignored otherwise. This is a safe, sensible use of eval.

Either way, the program now does what we expect!

$ ./prog2
Foo  = apple
Bar  = orange
$ ./prog2 two
Foo  = 42
Bar  = w00t!

You might wonder why the code has to be inside a BEGIN block after the uses are conditionalized. If you have the strict pragma enabled—and you should!—it wants variables to be imported and declared before execution begins. Otherwise, compilation will fail because for all it knows, $Foo and $Bar in the main package were typos.

Sunday, February 21, 2010

Haskell Platform on a fresh Ubuntu install

With newly-installed Ubuntu 9.10, I attempted to install version 2009.2.0.2 of the Haskell Platform, but the build of mtl failed:
Could not find module `Control.Monad'
But ghci knew about Control.Monad!
Prelude> :m + Control.Monad
Prelude Control.Monad>
Google searches yielded no relevant hits. I did find Installing haskell-platform in Ubuntu 9.10 “Karmic Koala” by David Siegel, where he mentions installing prerequisites:
sudo apt-get install ghc6 ghc6-prof ghc6-doc haddock libglut-dev happy alex \
  libedit-dev zlib1g-dev checkinstall
Even with these packages in place, the build continued to fail with the same error.

In an earlier iteration, I had installed libghc6-mtl-dev from APT, but after removing it, the mtl build succeeded along with the rest of the Haskell Platform!

The problem is the Haskell Platform build wants to install packages with and without profiling, but this means you also need profiling versions of all the prerequisite Haskell packages. (Note the presence of ghc6-prof in the above apt-get command.)

Cabal could have saved me lots of headscratching by telling me in its error message that it couldn't find a profiling version of Control.Monad!

Friday, February 19, 2010

Reading variable-length lines from a text file in C

Suppose for each line of some text file you want to read the entire line into a buffer and do some processing on it.

A common approach is to choose a fixed maximum length and hope for the best with fgets, but such a program breaks if any line's length is greater than this arbitrary limit.

The program below handles all the edge cases concomitant with fgets:

#include <errno.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>

/* argv[0], potentially used in error messages */
const char *progname;

typedef void (*processor)(const char *s);
int for_each_line(const char *path, processor p);

/* simple processor that prints each line to the standard output */
void print(const char *s)
{
  printf("%s\n", s);
}

int main(int argc, char **argv)
{
  progname = argv[0];

  if (argc != 2) {
    fprintf(stderr, "Usage: %s file\n", progname);
    return 1;
  }

  return for_each_line(argv[1], print) ? 0 : 1;
}

int for_each_line(const char *path, processor p)
{
  FILE *f;
  char *buf, *line;
  size_t capacity = 80;  /* reasonable guess at max length */
  size_t remaining = capacity;
  int success = 1;

  f = fopen(path, "r");
  if (!f) {
    fprintf(stderr, "%s: open %s: %s\n",
                    progname, path, strerror(errno));
    return 0;
  }

  line = malloc(capacity);
  if (!line) {
    fprintf(stderr, "%s: malloc: %s\n", progname, strerror(errno));
    fclose(f);
    return 0;
  }

  /*
   * On each iteration, read into buf the rest of a line whose length
   * is at most remaining. We can be certain that we have the whole
   * line only when the string contains '\n', in which case we
   * remove the terminator and call the processor on the entire line.
   *
   * Otherwise, we double line's size and try again.
   *
   * It may seem tempting to also test feof(f) to check whether we
   * have the whole line, but in the unlucky edge case where a file
   * doesn't end with '\n' and its last line is exactly remaining-1
   * in length, feof(f) will not yet be true, hence the possibility
   * of printing the last line outside the loop.
   */
  buf = line;
  line[0] = '\0';
  while (fgets(buf, remaining, f)) {
    char *eol = strchr(buf, '\n');
    if (eol) {
      *eol = '\0';
      p(line);
      buf = line;
      remaining = capacity;
      line[0] = '\0';
    }
    else {
      size_t used = buf + remaining - line;

      line = realloc(line, capacity * 2);
      if (!line) {
        fprintf(stderr, "%s: realloc: %s\n", progname, strerror(errno));
        fclose(f);
        return 0;
      }

      buf = line + used - 1;
      capacity *= 2;
      remaining = capacity - used;
    }
  }

  if (errno) {
    fprintf(stderr, "%s: fgets: %s\n", progname, strerror(errno));
    success = 0;
  }
  else if (line[0]) {
    char *eol = strchr(buf, '\n');
    if (eol)
      *eol = '\0';
    p(line);
  }

  fclose(f);
  free(line);

  return success;
}