#!/usr/bin/env setl
--
-- Dinesman's multiple-dwelling problem in SETL
--
-- From
-- http://rosettacode.org/wiki/Dinesman%27s_multiple-dwelling_problem
-- """
-- The task is to solve Dinesman's multiple dwelling problem but in a way that most
-- naturally follows the problem statement given below. Solutions are allowed (but
-- not required) to parse and interpret the problem text, but should remain flexible
-- and should state what changes to the problem text are allowed. Flexibility and
-- ease of expression are valued.
--
-- Examples may be be split into "setup", "problem statement", and "output" sections
-- where the ease and naturalness of stating the problem and getting an answer,
-- as well as the ease and flexibility of modifying the problem are the primary concerns.
--
-- Example output should be shown here, as well as any comments on the examples flexibility.
--
-- The problem
-- Baker, Cooper, Fletcher, Miller, and Smith live on different floors of an
-- apartment house that contains only five floors. Baker does not live on the
-- top floor. Cooper does not live on the bottom floor. Fletcher does not live
-- on either the top or the bottom floor. Miller lives on a higher floor than
-- does Cooper. Smith does not live on a floor adjacent to Fletcher's. Fletcher
-- does not live on a floor adjacent to Cooper's. Where does everyone live?
-- """
--
-- This SETL program was created by Hakan Kjellerstrand (hakank@bonetmail.com)
-- Also see my SETL page: http://www.hakank.org/setl/
--
dinesman1();
dinesman2();
--
-- Output:
--
-- dinesman1:
-- Baker: 3 Cooper: 2 Fletcher: 4 Miller: 5 Smith: 1
--
-- dinesman2:
-- Baker: 3 Cooper: 2 Fletcher: 4 Miller: 5 Smith: 1
--
--
-- Comments about the generality:
--
-- The two approaches are both fairly general, at least if there
-- are just constraints that can be translated to numerical
-- or array/set operations.
--
-- Performance: 5 different elements is no problem for either
-- approaches, however for say 9 or 10 it takes
-- much longer.
--
-- The constraints
--
-- floors: 1: bottom .. 5: top floor
--
proc constraints(b,c,f,m,s);
return
alldifferent([b,c,f,m,s]) -- all live on different floors
and b /= 5 -- Baker not top floor
and c /= 1 -- Cooper not bottom floor
and f /= 1 and f /= 5 -- Fletcher not botton nor top floor
and m > c -- Miller higher floor than Cooper
and not(s adjacent f) -- Smith and Fletcher not adjacent
and not(f adjacent c) -- Fletcher and Cooper not adjacent
;
end proc;
--
-- Using permutations
--
proc dinesman1();
print("\ndinesman1:");
for [b,c,f,m,s] in perms2([1..5]) | constraints(b,c,f,m,s) loop
print("Baker:", b,"Cooper:", c,"Fletcher:",f,"Miller:", m,"Smith:", s);
end loop;
end proc;
--
-- Using domains and "alldifferent"
--
proc dinesman2();
print("\ndinesman2:");
T := {1..5};
for b in T, c in T, f in T, m in T, s in T | constraints(b,c,f,m,s) loop
print("Baker:", b,"Cooper:", c,"Fletcher:",f,"Miller:", m,"Smith:", s);
end loop;
end proc;
--
-- All permutations of array S
--
procedure perms2(S);
if S = [] then
return [[]];
else
return [ [a]+b : a in S, b in perms2([ p in S | p /= a]) ];
end if;
end perms2;
--
-- a is adjacent with b
--
op adjacent(a,b);
return abs(a-b) = 1;
end op;
--
-- ensure alldifferent of element in list x
--
-- (count the number of distinct values)
--
proc alldifferent(x);
return #x = #{i : i in x};
end proc;
--
-- ensure that all elements are different
--
-- (there is just one element with value x)
--
proc alldifferent2(A);
return forall x in A | 1 = #[1 : i in A | i = x];
end proc;