Task
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?

invocable all
global nameL, nameT, rules
 
procedure main() # Dinesman
 
nameT := table()
nameL := ["Baker", "Cooper", "Fletcher", "Miller", "Smith"]
rules := [ [ distinct ],
           [ "~=",        "Baker",    top()      ],
           [ "~=",        "Cooper",   bottom()   ],
           [ "~=",        "Fletcher", top()      ],  
           [ "~=",        "Fletcher", bottom()   ],
           [ ">",         "Miller",   "Cooper"   ],
           [ notadjacent, "Smith",    "Fletcher" ],
           [ notadjacent, "Fletcher", "Cooper"   ],
           [ showsolution ],
           [ stop ] ]
 
if not solve(1) then 
   write("No solution found.")   
end
 
procedure dontstop()           # use if you want to search for all solutions
end
 
procedure showsolution()       # show the soluton
   write("The solution is:")
   every write("   ",n := !nameL, " lives in ", nameT[n])
   return
end 
 
procedure eval(n)              # evaluate a rule
   r := copy(rules[n-top()])
   every r[i := 2 to *r] := rv(r[i])
   if get(r)!r then suspend
end
 
procedure rv(x)                # return referenced value if it exists
return \nameT[x] | x
end
 
procedure solve(n)             # recursive solver
   if n > top() then {         # apply rules
      if n <= top() + *rules then 
         ( eval(n) & solve(n+1) ) | fail   
      }
   else                        # setup locations
      (( nameT[nameL[n]] := bottom() to top() ) & solve(n + 1)) | fail
   return
end
 
procedure distinct(a,b)        # ensure each name is distinct
   if nameT[n := !nameL] = nameT[n ~== key(nameT)] then fail
   suspend
end
 
procedure notadjacent(n1,n2)   # ensure n1,2 are not adjacent
   if not adjacent(n1,n2) then suspend
end
 
procedure adjacent(n1,n2)      # ensure n1,2 are adjacent
   if abs(n1 - n2) = 1 then suspend
end
 
procedure bottom()             # return bottom 
   return if *nameL > 0 then 1 else 0
end
 
procedure top()                # return top
   return *nameL
end