0. #lang racket
1. (define << arithmetic-shift)
2. (define bwbs? bitwise-bit-set?)
3. ;; 1,2,2,3,3,3,4,4,4,4,5,5,5,5,5
4. ;; OEIS: A002024: n appears n times
5. (define (A002024 n) (exact-floor (+ 1/2 (sqrt (* n 2)))))
6. ;; 1, 1, 2, 1, 2, 3, 1, 2, 3, 4
7. ;; OEIS: A002260: Triangle T(n,k) = k for k = 1..n.
8. (define (A002260 n) (+ 1 (A002262 (sub1 n))))
9. ;; OEIS: A000217: Triangular numbers: a(n) = C(n+1,2) = n(n+1)/2 = 0+1+2+...+n.
10. (define (tri n) (* n (sub1 n) 1/2))
11. ;; OEIS: A002262: Triangle read by rows: T(n,k)
12. (define (A002262 n)
13.   (define trinv (exact-floor (/ (+ 1 (sqrt (+ 1 (* n 8)))) 2)))
14.   (- n (/ (* trinv (- trinv 1)) 2)))
15. (define row-number A002024)
16. (define col-number A002260)
17. (define (r.c->n r c) (and (<= 1 r 5) (<= 1 c r) (+ 1 (tri r) (- c 1))))
18.  
19. (define (available-jumps n) ; takes a peg number, and returns a list of (jumped-peg . landing-site)
20.   (define r (row-number n))
21.   (define c (col-number n))
22.   ;; Six possible directions - although noone gets all six: "J" - landing site, "j" jumped peg
23.   ;;   Triangle   Row/column (square edge)
24.   ;;    A . B     A.B
25.   ;;   . a b      .ab
26.   ;;  C c X d D   CcXdD
27.   ;; . . e f      ..ef
28.   ;;. . E . F     ..E.F
29.   (define (N+.n+ r+ c+) (cons (r.c->n (+ r (* 2 r+)) (+ c (* 2 c+))) (r.c->n (+ r r+) (+ c c+))))
30.   (define-values (A.a B.b C.c D.d E.e F.f)
31.     (values (N+.n+ -1 -1) (N+.n+ -1 0) (N+.n+ 0 -1) (N+.n+ 0 1) (N+.n+ 1 0) (N+.n+ 1 1)))
32.   (filter car (list A.a B.b C.c D.d E.e F.f)))
33.  
34. (define (available-jumps/bits n0)
35.   (for/list ((A.a (available-jumps (add1 n0))))
36.     (match-define (cons (app sub1 A) (app sub1 a)) A.a)
37.     (list A a (bitwise-ior (<< 1 n0) (<< 1 A) (<< 1 a))))) ; on a hop, these three bits will flip
38.  
39. (define avalable-jumps-list/bits (for/vector #:length 15 ((bit 15)) (available-jumps/bits bit)))
40.  
41. ;; OK -- we'll be complete about this (so it might take a little longer)
42. ;;
43. ;; There are 2^15 possible start configurations; so we'll just systematically go though them, and
44. ;; build an hash of what can go where. Bits are numbered from 0 - peg#1 to 14 - peg#15.
45. ;; It's overkill for finding a single solution, but it seems that Joe Nord needs a lot of questions
46. ;; answered (which should be herein).
47. (define paths# (make-hash))
48. (for* ((board (in-range 0 (expt 2 15)))
49.        (peg (in-range 15))
50.        #:when (bwbs? board peg)
51.        (Jjf (in-list (vector-ref avalable-jumps-list/bits peg)))
52.        #:when (bwbs? board (second Jjf)) ; need something to jump
53.        #:unless (bwbs? board (first Jjf))) ; need a clear landing space
54.   (define board- (bitwise-xor board (third Jjf)))
55.   (hash-update! paths# board (λ (old) (cons (cons board- Jjf) old)) null))
56.  
57. (define (find-path start end (acc null))
58.   (if (= start end) (reverse acc)
59.       (for*/first
60.           ((hop (hash-ref paths# start null))
61.            (inr (in-value (find-path (car hop) end (cons hop acc)))) #:when inr) inr)))
62.  
63. (define (display-board board.Jjf)
64.   (match-define (list board (app add1 J) (app add1 j) _) board.Jjf)
65.   (printf "from ~a to ~a, (jumping ~a) ->" board.Jjf J j)
66.   (for* ((r (in-range 1 6))
67.          (c (in-range 1 (add1 r)))
68.          (n (in-value (r.c->n r c))))
69.     (when (= c 1) (printf "~%~a" (make-string (quotient (* 5 (- 5 r)) 2) #\space)))
70.     (printf "[~a] " (~a #:width 2 #:pad-string " " #:align 'right (if (bwbs? board (sub1 n)) n ""))))
71.   (newline))
72.  
73. (define (flip-peg p b) (bitwise-xor (<< 1 (sub1 p)) b))
74. (define empty-board #b000000000000000)
75. (define full-board  #b111111111111111)
76.  
77. ;; Solve #1 missing -> #13 left alone
78. (for-each display-board (find-path (flip-peg 1 full-board) (flip-peg 13 empty-board)))

=>

from (32731 0 2 37) to 1, (jumping 3) ->           [ 1]        [ 2] [  ]      [ 4] [ 5] [  ]   [ 7] [ 8] [ 9] [10] [11] [12] [13] [14] [15] from (15867 5 9 16928) to 6, (jumping 10) ->           [ 1]        [ 2] [  ]      [ 4] [ 5] [ 6]   [ 7] [ 8] [ 9] [  ] [11] [12] [13] [14] [  ] from (15995 9 8 896) to 10, (jumping 9) ->           [ 1]        [ 2] [  ]      [ 4] [ 5] [ 6]   [ 7] [  ] [  ] [10] [11] [12] [13] [14] [  ] from (15455 2 5 548) to 3, (jumping 6) ->           [ 1]        [ 2] [ 3]      [ 4] [ 5] [  ]   [ 7] [  ] [  ] [  ] [11] [12] [13] [14] [  ] from (15693 8 4 274) to 9, (jumping 5) ->           [ 1]        [  ] [ 3]      [ 4] [  ] [  ]   [ 7] [  ] [ 9] [  ] [11] [12] [13] [14] [  ] from (7261 4 8 8464) to 5, (jumping 9) ->           [ 1]        [  ] [ 3]      [ 4] [ 5] [  ]   [ 7] [  ] [  ] [  ] [11] [12] [13] [  ] [  ] from (9309 13 12 14336) to 14, (jumping 13) ->           [ 1]        [  ] [ 3]      [ 4] [ 5] [  ]   [ 7] [  ] [  ] [  ] [11] [  ] [  ] [14] [  ] from (9239 1 3 74) to 2, (jumping 4) ->           [ 1]        [ 2] [ 3]      [  ] [ 5] [  ]   [  ] [  ] [  ] [  ] [11] [  ] [  ] [14] [  ] from (9347 7 4 148) to 8, (jumping 5) ->           [ 1]        [ 2] [  ]      [  ] [  ] [  ]   [  ] [ 8] [  ] [  ] [11] [  ] [  ] [14] [  ] from (9352 3 1 11) to 4, (jumping 2) ->           [  ]        [  ] [  ]      [ 4] [  ] [  ]   [  ] [ 8] [  ] [  ] [11] [  ] [  ] [14] [  ] from (13312 12 7 4232) to 13, (jumping 8) ->           [  ]        [  ] [  ]      [  ] [  ] [  ]   [  ] [  ] [  ] [  ] [11] [  ] [13] [14] [  ] from (3072 11 12 14336) to 12, (jumping 13) ->           [  ]        [  ] [  ]      [  ] [  ] [  ]   [  ] [  ] [  ] [  ] [11] [12] [  ] [  ] [  ] from (4096 12 11 7168) to 13, (jumping 12) ->           [  ]        [  ] [  ]      [  ] [  ] [  ]   [  ] [  ] [  ] [  ] [  ] [  ] [13] [  ] [  ]