Penniless Pilgrim

August 10, 2018

My solution to the Penniless Pilgrim Puzzle performs depth-first search through the graph with vertices consisting of street corners labelled A to Z (with J omitted) from top to bottom, left to right, along with edges consisting of blocks of the street. Unlike Ben, who calculated the graph in code, we represent the graph as data, with the adjacency matrix decorated with the functions that calculate the accumulated cost:

(define grid `(
  (A (B ,add2)   (F ,double)                        )
  (B (A ,sub2)   (C ,add2)   (G ,double)            )
  (C (B ,sub2)   (D ,add2)   (H ,double)            )
  (D (C ,sub2)   (E ,add2)   (I ,double)            )
  (E (D ,sub2)   (K ,double)                        )
  (F (A ,halve)  (G ,add2)   (L ,double)            )
  (G (B ,halve)  (F ,sub2)   (H ,add2)   (M ,double))
  (H (C ,halve)  (G ,sub2)   (I ,add2)   (N ,double))
  (I (D ,halve)  (H ,sub2)   (K ,add2)   (O ,double))
  (K (E ,halve)  (I ,sub2)   (P ,double)            )
  (L (F ,halve)  (M ,add2)   (Q ,double)            )
  (M (G ,halve)  (L ,sub2)   (N ,add2)   (R ,double))
  (N (H ,halve)  (M ,sub2)   (O ,add2)   (S ,double))
  (O (I ,halve)  (N ,sub2)   (P ,add2)   (T ,double))
  (P (K ,halve)  (O ,sub2)   (U ,double)            )
  (Q (L ,halve)  (R ,add2)   (V ,double)            )
  (R (M ,halve)  (Q ,sub2)   (S ,add2)   (W ,double))
  (S (N ,halve)  (R ,sub2)   (T ,add2)   (X ,double))
  (T (O ,halve)  (S ,sub2)   (U ,add2)   (Y ,double))
  (U (P ,halve)  (T ,sub2)   (Z ,double)            )
  (V (Q ,halve)  (W ,add2)                          )
  (W (R ,halve)  (V ,sub2)   (X ,add2)              )
  (X (S ,halve)  (W ,sub2)   (Y ,add2)              )
  (Y (T ,halve)  (X ,sub2)   (Z ,add2)              )
  (Z (U ,halve)  (Y ,sub2)                          )))

It is nearly always preferable to represent complex data structures like this in data rather than code; the result is more compact and more readable. The add2, sub2, halve and double functions each take a single argument and do what you expect them to do. We need a quasi-quote so the function name is treated as a function and not as a symbol.

A path through the graph is represented as a list of vertices. Function visited? calls function follows? to index through the path to determine if an edge has previously been traversed in either direction:

(define (follows? y x xs) ; does y follow x in list xs?
  (if (null? xs) #f
    (let loop ((xs xs))
      (cond ((null? (cdr xs)) #f)
            ((and (equal? (car xs) x) (equal? (cadr xs) y)) #t)
            (else (loop (cdr xs)))))))
(define (visited? from to path)
  (or (follows? from to path) (follows? to from path)))

The primary process is a depth-first search through the graph, keeping track of both the current path and its accumulated cost. Function pilgrim checks each path to determine if the result has been found, and calls extend to push more nodes onto the partial path:

(define (extend cost-and-path paths)
  (let ((cost (car cost-and-path))
        (path (cdr cost-and-path))
        (neighbors (cdr (assoc (cadr cost-and-path) grid))))
    (let loop ((neighbors neighbors) (paths paths))
      (cond ((null? neighbors) paths)
            ((not (visited? (car path) (caar neighbors) path))
              (loop (cdr neighbors)
                    (cons (cons ((cadar neighbors) cost)
                                (cons (caar neighbors) path))
                          paths)))
            (else (loop (cdr neighbors) paths))))))
(define (pilgrim paths)
  (let loop ((paths paths))
    (if (null? paths) #f
      (let ((path (car paths)))
        (if (and (zero? (car path)) (equal? (cadr path) 'Z))
            (reverse (cdr path))
            (loop (extend path (cdr paths))))))))

We call the program by initializing the list of paths with (4 C B A), which encodes the starting path A, B, C in reverse order along with its accumulated cost; note that street corner H is visited twice, traversing the first time from north to south and the second time from east to west:

> (time (pilgrim (cons '(4 C B A) (list))))
(time (pilgrim (cons (...) ...)))
    16 collections
    842 ms elapsed cpu time, including 0 ms collecting
    841 ms elapsed real time, including 1 ms collecting
    68500632 bytes allocated, including 67328032 bytes reclaimed
(A B C H N S T U P K E D I H G F L Q V W X Y Z)

You can run the program at ideone, where we compared the three available Scheme interpreters: Guile timed out after 15 seconds, Chicken completed the task in 5.25 seconds, and Stalin, after a lengthy compilation, completed the task in an astonishing 0.17 seconds.


Advertisements

Pages: 1 2 3

4 Responses to “Penniless Pilgrim”

  1. Again BFI – works well as the grid is small – and need recursive code – keep track of “$h” and “$v” the state of the edges both horizontally and vertically….

    Found 3 solutions

    [sourecode]
    eesswseene|nnwswwwssseeee
    eesswsenesen|nnwswwwssseeee
    eessseen|nnwswwwssseeee
    [/sourecode]

    which are all identical after where I’ve put the |

    move( 4, 'ee', 2, 0,
          '111001 100001 100001 100001 100001',
          '11111 00000 00000 00000 00000 11111',
          '2 4' );
    
    sub move {
      my( $s, $path, $x, $y, $h, $v, $ss ) = @_;
      if( $x == 4 && $y == 4 && $s == 0) {
        printf "%30s [%s]\n", $path, $ss;
      }
      unless( substr $h, $x+1 + $y * 7, 1 ) {
        substr my $t = $h, $x+1 + $y * 7, 1, '1';
        move( $s+2, $path.'e', $x+1, $y, $t, $v, $ss.' '.($s+2) );
      }
      unless( substr $h, $x + $y * 7, 1 ) {
        substr my $t = $h, $x + $y * 7, 1, '1';
        move( $s-2, $path.'w', $x-1, $y, $t, $v, $ss.' '.($s-2) );
      }
      unless( substr $v, $x + $y * 6 + 6, 1 ) {
        substr my $t = $v, $x + $y * 6 + 6, 1, '1';
        move( $s*2, $path.'s', $x, $y+1, $h, $t, $ss.' '.($s*2) );
      }
      unless( substr $v, $x + $y * 6, 1 ) {
        substr my $t = $v, $x + $y * 6, 1, '1';
        move( $s/2, $path.'n', $x, $y-1, $h, $t, $ss.' '.($s/2) );
      }
    }
    
  2. Daniel said

    Here’s a solution in Python.

    from collections import deque
    from fractions import Fraction
    
    # Elements in queue are tuples of:
    #   (cost, x-position, y-position, path, edges)
    q = deque([(Fraction(4), 2, 0, 'ee', set([(1,0), (3,0)]))])
    while q:
      c, x, y, p, e = q.popleft()
      if (len(p) != len(e)) or  not (x in range(0,5) and y in range(0,5)):
        continue
      if x == 4 and y == 4 and c == 0:
        print(p)
      q.append((c + 2, x + 1, y, p + 'e', e | set([(x * 2 + 1, y * 2)])))
      q.append((c - 2, x - 1, y, p + 'w', e | set([(x * 2 - 1, y * 2)])))
      q.append((c / 2, x, y - 1, p + 'n', e | set([(x * 2, y * 2 - 1)])))
      q.append((c * 2, x, y + 1, p + 's', e | set([(x * 2, y * 2 + 1)])))
    

    Output:

    eessseennnwswwwssseeee
    eesswseenennwswwwssseeee
    eesswsenesennnwswwwssseeee
    
  3. Daniel said

    Here’s an alternative version of my earlier solution. This uses depth-first search instead of breadth-first search. This is slightly simpler since it doesn’t have the deque dependency.

    from fractions import Fraction
    
    q = [(Fraction(4), 2, 0, 'ee', set([(1, 0), (3, 0)]))]
    while q:
        c, x, y, p, e = q.pop()
        if (len(p) != len(e)) or not (x in range(0, 5) and y in range(0, 5)):
            continue
        if x == 4 and y == 4 and c == 0:
            print(p)
        q.append((c + 2, x + 1, y, p + 'e', e | set([(x * 2 + 1, y * 2)])))
        q.append((c - 2, x - 1, y, p + 'w', e | set([(x * 2 - 1, y * 2)])))
        q.append((c / 2, x, y - 1, p + 'n', e | set([(x * 2, y * 2 - 1)])))
        q.append((c * 2, x, y + 1, p + 's', e | set([(x * 2, y * 2 + 1)])))
    

    Output:

    eessseennnwswwwssseeee
    eesswsenesennnwswwwssseeee
    eesswseenennwswwwssseeee
    
  4. Jamie Hope said

    Running @Praxis’s solution in Kawa took 3.5 seconds the first time. Subsequent runs dropped to ~3.04 (JIT kicks in after a method has been invoked enough times).

    Ben’s solution isn’t the same one as in the video he embedded, so the obvious next question is: how many solutions are there? And are there any solutions that end with a negative cost (a tax refund, which presumably the pilgrim would give to the temple as an offering..)?

    (define (pilgrim-all paths)
      (let loop ((paths paths) (soln '()))
        (if (null? paths) soln
            (let ((path (car paths)))
              (if (and (<= (car path) 0) (equal? (cadr path) 'Z))
                  (loop (cdr paths) (cons (cons (car path) (reverse (cdr path))) soln))
                  (loop (extend path (cdr paths)) soln))))))
    

    After 68 seconds, that spit out:

    [pre]
    ((-2 A B C H G F L Q R S T U P K E D I H N M R W X Y Z)
    (0 A B C H N M R S N O T U P K E D I H G F L Q V W X Y Z)
    (0 A B C H N M R S T O P K E D I H G F L Q V W X Y Z)
    (-2 A B C H N M R S T U P K E D I H G F L Q R W X Y Z)
    (-4 A B C H N M R S T U P K E D I H G F L Q V W X Y Z)
    (0 A B C H N S T U P K E D I H G F L Q V W X Y Z))
    [/pre]

    So, there are 3 zero-cost paths, and three negative-cost paths.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Google+ photo

You are commenting using your Google+ account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s

%d bloggers like this: