Rebol3 Code Examplex


Solve the no connection puzzle

Arrange the numbered pieces so that no consecutive numbers are adjacent along any connection line, leaving a valid non-touching placement.

Rebol [
    title: "Rosetta code: Solve the no connection puzzle"
    file:  %Solve_the_no_connection_puzzle.r3
    url:   https://rosettacode.org/wiki/Solve_the_no_connection_puzzle
]

no-connection-puzzle: function [][
    points:   [a b c d e f g h]
    links:    [a c a d a e b d b e b f c d c g d e d g d h e f e g e h f h]
    all-pegs: [1 2 3 4 5 6 7 8]

    connected?: func [x y][all [
        0 != (x * y)          ;; both non-zero
        1 == absolute (x - y) ;; adjacent (differ by 1)
    ]]
    
    valid?: function [
        pegs [block!]
    ][
        ;; Assign peg values to named points
        set points append/dup copy pegs 0 8
        ;; return false if any linked pair is connected
        foreach [x y] links [
            if connected? get x get y [return false]
        ]
        true
    ]

    ;; Recursively extend valid peg placements; record complete solutions
    check: function [
        pegs [block!]
    ][
        if valid? pegs [
            rest: difference all-pegs pegs
            either empty? rest [
                append/only solutions pegs
            ][
                foreach peg rest [check append copy pegs peg]
            ]   
        ]
    ]
    solutions: copy []
    check [] ; start with an empty placement
    new-line/all solutions on
]

print-solution: function [p][
    print reword {
         $A   $B
        /│\ /│\
       / │ X │ \
      /  │/ \│  \
     $C───$D───$E───$F
      \  │\ /│  /
       \ │ X │ /
        \│/ \│/
         $G   $H
    }
    [a: p/1 b: p/2 c: p/3 d: p/4 e: p/5 f: p/6 g: p/7 h: p/8]
]

solutions: no-connection-puzzle
print "First solution:"
print-solution solutions/1

print ["All solutions:" mold solutions]

Output:

First solution:

         3   4
        /│\ /│\
       / │ X │ \
      /  │/ \│  \
     7───1───8───2
      \  │\ /│  /
       \ │ X │ /
        \│/ \│/
         5   6
    
All solutions: [
    [3 4 7 1 8 2 5 6]
    [3 5 7 1 8 2 4 6]
    [3 6 7 1 8 2 4 5]
    [3 6 7 1 8 2 5 4]
    [4 3 2 8 1 7 6 5]
    [4 5 2 8 1 7 6 3]
    [4 5 7 1 8 2 3 6]
    [4 6 7 1 8 2 3 5]
    [5 3 2 8 1 7 6 4]
    [5 4 2 8 1 7 6 3]
    [5 4 7 1 8 2 3 6]
    [5 6 7 1 8 2 3 4]
    [6 3 2 8 1 7 4 5]
    [6 3 2 8 1 7 5 4]
    [6 4 2 8 1 7 5 3]
    [6 5 2 8 1 7 4 3]
]