PasteRack.org
Paste # 62205
2016-04-23 17:08:21

Fork as a new paste.

Paste viewed 169 times.


Embed:

  1. #lang racket
  2.  
  3. #|
  4. Constant values
  5. hex-syms: a list of possible unique ID's for each hexagon edge
  6. root - southeast: the list index which corresponds to the direction
  7. |#
  8. (define hex-syms (list 'A 'B 'C 'D 'E 'F))
  9. (define ROOT 0)
  10. (define NORTH 1)
  11. (define NORTHWEST 2)
  12. (define NORTHEAST 3)
  13. (define SOUTH 4)
  14. (define SOUTHWEST 5)
  15. (define SOUTHEAST 6)
  16.  
  17. #|
  18. A class that represents a hexagon with edges
  19. |#
  20. (define hex%
  21.   (class object%
  22.     (init-field n nw ne s sw se)
  23.     (super-new)
  24.     (inspect (make-inspector))
  25.     (define/public (n?) n)
  26.     (define/public (nw?) nw)
  27.     (define/public (ne?) ne)
  28.     (define/public (s?) s)
  29.     (define/public (sw?) sw)
  30.     (define/public (se?) se)))
  31.  
  32. #|
  33. Helper function, prints an instance of a hex to string for debugging
  34. |#
  35. (define (hex%->string hx)
  36.   (format "(n: ~a) (nw: ~a) (ne: ~a) (s: ~a) (sw: ~a) (se: ~a)"
  37.           (send hx n?)
  38.           (send hx nw?)
  39.           (send hx ne?)
  40.           (send hx s?)
  41.           (send hx sw?)
  42.           (send hx se?)))
  43.  
  44. #|
  45. Helper function, create a new hex without having to supply parameter names
  46. |#
  47. (define (new-hex n nw ne s sw se)
  48.   (new hex% [n n][nw nw][ne ne][s s][sw sw][se se]))
  49.  
  50. #|
  51. Given a listen of N elements, arrange the contents randomly
  52. |#
  53. (define (arrange-randomly lst)
  54.   (flatten (let loop
  55.     ([pool lst][out (list)])
  56.     (if
  57.      (empty? pool) out
  58.      ((lambda ()
  59.       (define rand-el (list-ref pool (random (length pool))))
  60.       (loop (remove rand-el pool) (list out (list rand-el)))))))))
  61.  
  62. #|
  63. Rearrange a list of symbols and create a hexagon randomly
  64. |#
  65. (define (new-random-hex)
  66.   (define random-syms (arrange-randomly hex-syms))
  67.   (new-hex
  68.    (list-ref random-syms 0)
  69.    (list-ref random-syms 1)
  70.    (list-ref random-syms 2)
  71.    (list-ref random-syms 3)
  72.    (list-ref random-syms 4)
  73.    (list-ref random-syms 5)))
  74.  
  75. #|
  76. A method that creates a list of hexagons that is a known and proven arrangement to the solution
  77. |#
  78. (define (solution-hex-list)
  79.   (list
  80.    (new-hex 'A 'D 'C 'E 'F 'B) ; root
  81.    (new-hex 'D 'F 'C 'A 'E 'B) ; north
  82.    (new-hex 'F 'C 'E 'A 'B 'D) ; northwest
  83.    (new-hex 'A 'B 'F 'D 'C 'E) ; northeast
  84.    (new-hex 'E 'D 'A 'F 'B 'C) ; south
  85.    (new-hex 'A 'C 'F 'E 'B 'D) ; southwest
  86.    (new-hex 'D 'B 'F 'C 'A 'E) ; southeast
  87.    ))
  88.  
  89. #|
  90. Attempt to arrange the list and align the elements around the root
  91. If no solution is possible, return #f
  92. |#
  93. (define (match-north lst)
  94.   (remove* (list #f) (let
  95.       ([r_hex (list-ref lst ROOT)])
  96.     (for/list ([i (remove r_hex lst)])
  97.       (if (equal? (send r_hex n?) (send i s?)) i #f)))))
  98. (define (match-northwest lst)
  99.   (remove* (list #f) (let
  100.       ([r_hex (list-ref lst ROOT)])
  101.     (for/list ([i (remove r_hex lst)])
  102.       (if (equal? (send r_hex nw?) (send i se?)) i #f)))))
  103. (define (match-northeast lst)
  104.   (remove* (list #f) (let
  105.       ([r_hex (list-ref lst ROOT)])
  106.     (for/list ([i (remove r_hex lst)])
  107.       (if (equal? (send r_hex ne?) (send i sw?)) i #f)))))
  108. (define (match-south lst)
  109.   (remove* (list #f) (let
  110.       ([r_hex (list-ref lst ROOT)])
  111.     (for/list ([i (remove r_hex lst)])
  112.       (if (equal? (send r_hex s?) (send i n?)) i #f)))))
  113. (define (match-southwest lst)
  114.   (remove* (list #f) (let
  115.       ([r_hex (list-ref lst ROOT)])
  116.     (for/list ([i (remove r_hex lst)])
  117.       (if (equal? (send r_hex sw?) (send i ne?)) i #f)))))
  118. (define (match-southeast lst)
  119.   (remove* (list #f) (let
  120.       ([r_hex (list-ref lst ROOT)])
  121.     (for/list ([i (remove r_hex lst)])
  122.       (if (equal? (send r_hex se?) (send i nw?)) i #f)))))
  123.  
  124. #|
  125. Validates and checks if the nodes around the root are valid (child check)
  126. |#
  127. (define (check-root-hex lst)
  128.   (let
  129.       ([r_hex (list-ref lst ROOT)]
  130.        [n_hex (list-ref lst NORTH)]
  131.        [nw_hex (list-ref lst NORTHWEST)]
  132.        [ne_hex (list-ref lst NORTHEAST)]
  133.        [s_hex (list-ref lst SOUTH)]
  134.        [sw_hex (list-ref lst SOUTHWEST)]
  135.        [se_hex (list-ref lst SOUTHEAST)])
  136.     (and
  137.      (equal? (send r_hex n?) (send n_hex s?))
  138.      (equal? (send r_hex nw?) (send nw_hex se?))
  139.      (equal? (send r_hex ne?) (send ne_hex sw?))
  140.      (equal? (send r_hex s?) (send s_hex n?))
  141.      (equal? (send r_hex sw?) (send sw_hex ne?))
  142.      (equal? (send r_hex se?) (send se_hex nw?)))))
  143.  
  144. #|
  145. Validates and checks if the nodes around the root are valid to each other (circle check)
  146. |#
  147. (define (check-outside-hex lst)
  148.   (let
  149.       ([n_hex (list-ref lst NORTH)]
  150.        [nw_hex (list-ref lst NORTHWEST)]
  151.        [ne_hex (list-ref lst NORTHEAST)]
  152.        [s_hex (list-ref lst SOUTH)]
  153.        [sw_hex (list-ref lst SOUTHWEST)]
  154.        [se_hex (list-ref lst SOUTHEAST)])
  155.     (and
  156.      (equal? (send n_hex se?) (send ne_hex nw?))
  157.      (equal? (send ne_hex s?) (send se_hex n?))
  158.      (equal? (send se_hex sw?) (send s_hex ne?))
  159.      (equal? (send s_hex nw?) (send sw_hex se?))
  160.      (equal? (send sw_hex n?) (send nw_hex s?))
  161.      (equal? (send nw_hex ne?) (send n_hex sw?)))))
  162.  
  163. #|
  164. Create 7 hexagons randomly
  165. |#
  166. (define (random-hex-list)
  167.   (for/list ([i 7]) (new-random-hex)))
  168.  
  169. (define (do-loop)
  170.   (define base_rhex (random-hex-list))
  171.   (define solution_found #f)
  172.   (for ([i 7])
  173.     (define a (list-ref base_rhex 0))
  174.     (define b (list-ref base_rhex i))
  175.     (define vec_rhex (list->vector base_rhex))
  176.     (vector-set! vec_rhex 0 b)
  177.     (vector-set! vec_rhex i a)
  178.     (define lst_rhex (vector->list vec_rhex))
  179.     (define mn  (match-north     lst_rhex))
  180.     (define mnw (match-northwest lst_rhex))
  181.     (define mne (match-northeast lst_rhex))
  182.     (define ms  (match-south     lst_rhex))
  183.     (define msw (match-southwest lst_rhex))
  184.     (define mse (match-southeast lst_rhex))
  185.     (define printsol (lambda ()
  186.                        (printf "Solution Found!~n")
  187.                        (printf "RT: ~a~n" b)
  188.                        (printf "N : ~a~n" mn)
  189.                        (printf "NW: ~a~n" mnw)
  190.                        (printf "NE: ~a~n" mne)
  191.                        (printf "S : ~a~n" ms)
  192.                        (printf "SW: ~a~n" msw)
  193.                        (printf "SE: ~a~n" mse)
  194.                        (set! solution_found #t)))
  195.  
  196.     (cond
  197.       [(or (empty? mn) (empty? mnw) (empty? mne) (empty? ms) (empty? msw) (empty? mse)) #f]
  198.       [else (printsol)]))
  199.   (if solution_found #t (do-loop)))
  200.  
  201. (do-loop)
  202.  

=>

Solution Found!

RT: #(struct:object:hex% B F C E A D)

N : (#(struct:object:hex% F A C B D E) #(struct:object:hex% F D C B E A))

NW: (#(struct:object:hex% D B C A E F))

NE: (#(struct:object:hex% F B E A C D))

S : (#(struct:object:hex% E B F A D C))

SW: (#(struct:object:hex% F C A D B E))

SE: (#(struct:object:hex% F D C B E A))

#t