(phixonline)-->
with javascript_semantics
requires("1.0.2")
function partitions(sequence s)
integer l = length(s), N = sum(s)
sequence pset = {}, -- eg s==={2,0,2} -> {1,1,3,3}
rn = repeat(0,l) -- "" -> {{0,0},{},{0,0}}
for i=1 to l do
pset &= repeat(i,s[i])
rn[i] = repeat(0,s[i])
end for
if pset={} then return {rn} end if -- edge case
sequence res = permutes(pset,0)
-- eg {1,1,3,3} means put 1,2 in [1], 3,4 in [3]
-- .. {3,3,1,1} means put 1,2 in [3], 3,4 in [1]
for i=1 to length(res) do
sequence ri = res[i], -- a "flat" permute
rdii = repeat(1,l) -- where per set
integer rii = 0
for j=1 to length(ri) do
integer rdx = ri[j], -- which set
rnx = rdii[rdx] -- wherein""
rii += 1
rn[rdx][rnx] = rii -- plant 1..N
rdii[rdx] = rnx+1
end for
assert(rii=N)
res[i] = deep_copy(rn)
end for
return res
end function
procedure test(sequence p)
sequence q = partitions(p)
string {ia,s} = iff(length(q)=1?{"is",""}:{"are","s"})
printf(1,"There %s %,d ordered partion%s for %v:\n{%s}\n",
{ia,length(q),s,p,join(shorten(q,"",5,"%v"),"\n ")})
end procedure
papply({{2,0,2},{1,1,1},{1,2,0,1},{1,2,3,4},{},{0,0,0}},test)