Home > Mathematica, Mathematics > Pilgrim’s Progress

## Pilgrim’s Progress

The New York Times Number Play: Daniel Finkel’s Pilgrim’s Puzzle is an interesting puzzle.

It was an opportunity to play with Mathematica in assisting finding a solution by cut down trial and error.

I used the following to code the conditions of the puzzle and visualise candidate answers,

fun[x_String] := Module[
{char, set = {{0, 0}}, sum = 0},
char = Characters[x];
Which[# == "s", sum = 2 sum; AppendTo[set, Last@set + {0, -1}],
# == "n", sum = sum/2; AppendTo[set, Last@set + {0, 1}],
# == "e", sum = sum + 2; AppendTo[set, Last@set + {1, 0}],
# == "w", sum = sum - 2; AppendTo[set, Last@set + {-1, 0}]
] & /@ char;
{sum, set}
];
gr[x_String] := Module[
{plot, sm, pts},
{sm, pts} = fun[x];
plot = Graphics[{Point[{0, 0}], {Red, Thick, Line@pts}},
GridLines -> {Range[0, 4, 1], Range[-4, 0, 1]},
PlotRange -> {{0, 4}, {0, -4}}];
Column[{sm, plot}]
];

“ssseenwwsseeee” yielded a possible solution.

I visualize it in the following animated gif. The number in the upper right hand corner is the progressive tax owing.