js/games/nluqo.github.io/~bh/logic-code/backtrack.lg


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42

;;; Solve logic problems by pure backtracking


to track :lists :tests
foreach first :lists [make ? array count bf :lists]
catch "tracked [track1 first :lists bf :lists 1]
end

to track1 :master :others :index
if emptyp :others [tracktest stop]
track2 :master first :others bf :others
end

to track2 :names :these :those
if emptyp :these [track1 :master :those :index+1 stop]
foreach :these [setitem :index thing first :names ?
                track2 bf :names remove ? :these :those]
end

to tracktest
foreach :tests [if not run ? [stop]]
foreach :master [pr se ? arraytolist thing ?]
throw "tracked
end

to is :this :that
if memberp :this :master [output memberp :that thing :this]
if memberp :that :master [output memberp :this thing :that]
localmake "who find [memberp :this thing ?] :master
output memberp :that thing :who
end


to differ :things
if emptyp bf :things [op "true]
op and (differ1 first :things bf :things) (differ bf :things)
end

to differ1 :this :those
foreach :those [if is :this ? [output "false]]
output "true
end