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]
]