RosettaCodeData/Task/Amb/Phix/amb-2.phix
2026-02-01 16:33:20 -08:00

72 lines
2.3 KiB
Text

with javascript_semantics
function amb(sequence sets, integer testrid, resrid=-1, idx=1, object res=0)
bool flag = (res==0),
pass = false
if idx>length(sets) then
pass = true
if resrid!=-1 then
resrid(sets,res)
end if
else
if flag then
res = repeat(0,length(sets))
end if
for k=1 to length(sets[idx]) do
res[idx] = k
if flag or testrid(sets,deep_copy(res),idx) then
{pass,res} = amb(sets,testrid,resrid,idx+1,deep_copy(res))
if pass and resrid=-1 then exit end if
end if
end for
end if
return {pass,res}
end function
function pairable(sequence sets, res, integer idx)
return sets[idx-1][res[idx-1]][$] = sets[idx][res[idx]][1]
end function
procedure AMB_Show(sequence sets, res)
res = deep_copy(res)
for i=1 to length(sets) do
res[i] = sets[i][res[i]]
end for
printf(1,"success: %v\n",{res})
end procedure
function pythagorean(sequence /*sets*/, sequence res, integer idx)
-- (note that res[idx]==sets[idx][res[idx]] in all cases)
integer {x,y,z} = res
return idx<3 or (x*x+y*y=z*z)
end function
procedure pythag_show(sequence /*sets*/, sequence res)
printf(1,"success: %v\n",{res})
end procedure
-- see http://www.randomhacks.net/articles/2005/10/11/amb-operator
function not8(sequence sets, sequence res, integer idx)
-- (note that idx==2 in all cases)
-- (at the last moment, I flipped the test, after realising that
-- someone had completely misunderstood the original article...
-- return sets[1][res[1]]*sets[idx][res[idx]]!=8
return sets[1][res[1]]*sets[idx][res[idx]]=8
end function
procedure not8_show(sequence sets, sequence res)
puts(1,"success: ")
?{sets[1][res[1]],sets[2][res[2]]}
end procedure
sequence sets = {{"the","that","a"},
{"frog","elephant","thing"},
{"walked","treaded","grows"},
{"slowly","quickly"}}
sequence sets2 = repeat(tagset(11),3)
sequence sets3 = {{1, 2, 3}, {4, 5, 6}}
puts(1,"\nThe original:\n")
{} = amb(sets,pairable,AMB_Show)
puts(1,"\nSmall Pythagorean triples problem:\n")
{} = amb(sets2,pythagorean,pythag_show)
puts(1,"\nSome strange not 8 problem:\n") -- (now fixed)
{} = amb(sets3,not8,not8_show)