Courses/CS 460/Fall 2005/Homework/Josh Cain/Oct 29

From CSWiki

[edit] Oct 29 Homework, Josh Cain

Arbor Day (http://pages.prodigy.net/spencejk/solvelps.html)

declare
   % Every member of Xs has a value from Values.
   % Instantiates those that don't.
   proc {AllInstantiated Xs Values}
      {ForAll Xs proc {$ X} {IsIn X Values} end}
   end
   proc {Append ?Xs ?Ys ?Zs}
      choice
         Xs = nil 
         Ys = Zs
      [] X Xr in
         Xs = X | Xr
         Zs = X | {Append Xr Ys}
      end
   end
   % Creates a list of the values for Field in the elements
   % of Elts. Assumes Elts is a homgeneous list whose 
   % members are records with a field named Field.
   fun {GetFields Field Elts}
      {Map Elts fun {$ Elt} Elt.Field end}
   end
   % Returns the first index of X in Xs.  X and Xs must be
   % instantiated or will suspend until they are.
   % Fails if X is not in Xs.
   fun {IndexOf X Xs}
      fun {IndexOf3 X Xs N}
         case Xs of
            nil then fail
         [] Y | Rest then
            if X == Y then N else {IndexOf3 X Rest N+1} end
         end
      end
   in
     {IndexOf3 X Xs 1}
   end
   proc {IsIn ?X Xs} {Append _ X|_ Xs} end
   proc {IsAnElt ?X Elts} {IsIn X {Record.toList Elts}} end
   %% Constraints
   % Generate thread bombs that ensure that all the members
   % of List are distinct.
   proc {AllDistinct List}
      L = {Length List} in
      for I in 1; I =< L-1; I+1 do
         for J in I+1; J =< L; J+1 do
            {NotEqual {Nth List I} {Nth List J}}
         end
      end
   end
   % Plant a thread bomb that goes off if X and Y become
   % instantiated to the same value.
   proc {NotEqual X Y} thread X == Y = false end end
   % A thread bomb that ensures that X1 precedes X2 in Xs. 
   proc {Precedes ?X1 ?X2 Xs}
      thread {IndexOf X1 Xs} < {IndexOf X2 Xs} = true end
   end
   %% Propagator utilitiess
   % If the fields common to R1 and R2 are all instantiated, returns 
   % true/false depending on whether they are all equal (==).
   % Suspends until fields become instantiated.
   fun {Match R1 R2}
      {Record.all
       {Record.zip R1 R2 fun {$ A B} A == B end}
       fun {$ X} X == true end}
   end
   % If {Match Condition R} then {UnifyRecs Result R}.
   % Does this in a thread to avoid blocking the main thread.
   % Also acts as a constraint in case the unification fails.
   proc {Propagate Condition Result R}
      thread if {Match Condition R} then {UnifyRecs Result R} end end    
   end
   % Propagates Condition -> Result to all the fields in the record Rec.
   % Each field is done in its own thread.  See Propagate.
   proc {PropagateAll Condition Result Rec}
      {Record.forAll Rec proc {$ R} {Propagate Condition Result R} end}
   end
   % Unifies the values of the fields common to R1 and R2
   proc {UnifyRecs R1 R2}
      {Record.zip R1 R2 fun {$ A B} A = B end _}
   end
local
   Trees = [ash cedar maple sycamore]
   Surnames = [becker clary delgado erichsen]
   proc {Clue1 Elts}
      % George is not surnamed Mr. Clary or Mr. Becker 
      {NotEqual Elts.george.surname clary}
      {NotEqual Elts.george.surname becker}
   end
   proc {Clue2 Elts}
      Tree
   in
      % Mr. Clary
      {IsAnElt properties(tree:Tree surname:clary) Elts}
      % planted neither the cedar tree nor the maple tree
      {NotEqual Tree cedar}
      {NotEqual Tree maple}
   end 
   proc {Clue3 Elts}
      % Harvey is not surnamed Mr. Clary
      {NotEqual Elts.harvey.surname clary}
   end
   proc {Clue4 Elts}
      % Neither John nor Ivan planted the ash tree
      {NotEqual Elts.john.tree ash}
      {NotEqual Elts.ivan.tree ash}
   end
   proc {Clue5 Elts}
      % George did not plant the maple tree
      {NotEqual Elts.george.tree maple}
      % George is not surnamed Delgado
      {NotEqual Elts.george.surname delgado}
   end
   proc {Clue6 Elts}
      Tree
   in
      % Mr. Erichsen
      {IsAnElt properties(tree:Tree surname:erichsen) Elts}
      % did not plant the ash tree
      {NotEqual Tree ash}
   end 
   proc {Clue7 Elts}
      % John did not plant the sycamore tree
      {NotEqual Elts.john.tree sycamore}
      % John is not surnamed Becker
      {NotEqual Elts.john.surname becker}
   end
   fun {ArborDay}
      Elts = {MakeRecord men [george harvey ivan john]}
      Ts
      Ss
      Men = {Record.toList Elts}
   in
      % Create property records for each man
      {Record.forAll Elts proc {$ S} S = {Record.make properties [tree surname]} end}
      % Get the list of Tree and Surname variables.
      % Constrain them to be distinct.
      Ts = {GetFields tree Men}
      {AllDistinct Ts}
      Ss = {GetFields surname Men}
      {AllDistinct Ss}
      % Run the clues
      {Clue1 Elts}
      {Clue2 Elts}
      {Clue3 Elts}
      {Clue4 Elts}
      {Clue5 Elts}
      {Clue6 Elts}
      {Clue7 Elts}
      % Ensure that every tree and surname.
      {AllInstantiated Ts Trees}
      {AllInstantiated Ss Surnames}
      % Return Elts as the answer
      Elts
   end
in
   {Browse {SearchAll ArborDay}}
end

Masquerading for the Gentry (http://pages.prodigy.net/spencejk/jan2000.html)

declare
   % Every member of Xs has a value from Values.
   % Instantiates those that don't.
   proc {AllInstantiated Xs Values}
      {ForAll Xs proc {$ X} {IsIn X Values} end}
   end
   proc {Append ?Xs ?Ys ?Zs}
      choice
         Xs = nil 
         Ys = Zs
      [] X Xr in
         Xs = X | Xr
         Zs = X | {Append Xr Ys}
      end
   end
   % Creates a list of the values for Field in the elements
   % of Elts. Assumes Elts is a homgeneous list whose 
   % members are records with a field named Field.
   fun {GetFields Field Elts}
      {Map Elts fun {$ Elt} Elt.Field end}
   end
   % Returns the first index of X in Xs.  X and Xs must be
   % instantiated or will suspend until they are.
   % Fails if X is not in Xs.
   fun {IndexOf X Xs}
      fun {IndexOf3 X Xs N}
         case Xs of
            nil then fail
         [] Y | Rest then
            if X == Y then N else {IndexOf3 X Rest N+1} end
         end
      end
   in
     {IndexOf3 X Xs 1}
   end
   proc {IsIn ?X Xs} {Append _ X|_ Xs} end
   proc {IsAnElt ?X Elts} {IsIn X {Record.toList Elts}} end
   %% Constraints
   % Generate thread bombs that ensure that all the members
   % of List are distinct.
   proc {AllDistinct List}
      L = {Length List} in
      for I in 1; I =< L-1; I+1 do
         for J in I+1; J =< L; J+1 do
            {NotEqual {Nth List I} {Nth List J}}
         end
      end
   end
   % Plant a thread bomb that goes off if X and Y become
   % instantiated to the same value.
   proc {NotEqual X Y} thread X == Y = false end end
   proc {Equal X Y} thread X == Y = true end end
   % A thread bomb that ensures that X1 precedes X2 in Xs. 
   proc {Precedes ?X1 ?X2 Xs}
      thread {IndexOf X1 Xs} < {IndexOf X2 Xs} = true end
   end
   %% Propagator utilitiess
   % If the fields common to R1 and R2 are all instantiated, returns 
   % true/false depending on whether they are all equal (==).
   % Suspends until fields become instantiated.
   fun {Match R1 R2}
      {Record.all
       {Record.zip R1 R2 fun {$ A B} A == B end}
       fun {$ X} X == true end}
   end
   % If {Match Condition R} then {UnifyRecs Result R}.
   % Does this in a thread to avoid blocking the main thread.
   % Also acts as a constraint in case the unification fails.
   proc {Propagate Condition Result R}
      thread if {Match Condition R} then {UnifyRecs Result R} end end    
   end
   % Propagates Condition -> Result to all the fields in the record Rec.
   % Each field is done in its own thread.  See Propagate.
   proc {PropagateAll Condition Result Rec}
      {Record.forAll Rec proc {$ R} {Propagate Condition Result R} end}
   end
   % Unifies the values of the fields common to R1 and R2
   proc {UnifyRecs R1 R2}
      {Record.zip R1 R2 fun {$ A B} A = B end _}
   end
local
   Carcolors = [blue green purple red white]
   Positions = [butler chauffeur cook maid gardener]
   proc {Clue1 Elts}
      %No suspect drove a car color that is associated with his or her name
      {NotEqual Elts.green.carcolor green}
      {NotEqual Elts.scarlet.carcolor red}
      {NotEqual Elts.peacock.carcolor blue}
      {NotEqual Elts.white.carcolor white}
      {NotEqual Elts.plum.carcolor purple}
   end
   proc {Clue2 Elts}
      % plum did not drive the red car
      {NotEqual Elts.plum.carcolor red}
   end
   proc {Clue3 Elts}
      % green played the part of the cook
      Elts.green.position = cook
   end
   proc {Clue4 Elts}
      % peacock arrived in the green car
      Elts.peacock.carcolor = green
      % peacock did not play the gardener
      {NotEqual Elts.peacock.position gardener}
   end
   proc {Clue5 Elts}
      % white did not drive the purple car
      {NotEqual Elts.white.carcolor purple}
      % white impersonated the chauffeur
      Elts.white.position = chauffeur
   end
   proc {Clue6 Elts}
      Position
   in
      % The person who arrived in the white car played the part of the butler
      {PropagateAll properties(carcolor:white) properties(position:butler) Elts}
      % And they weren't plum
      {NotEqual Elts.plum.carcolor white}
   end 
   fun {Masquerading}
      Elts = {MakeRecord suspects [green scarlet peacock white plum]}
      Cs
      Ps
      Suspects = {Record.toList Elts}
   in
      % Create property records for each man
      {Record.forAll Elts proc {$ S} S = {Record.make properties [carcolor position]} end}
      % Get the list of Carcolor and Position variables.
      % Constrain them to be distinct.
      Cs = {GetFields carcolor Suspects}
      {AllDistinct Cs}
      Ps = {GetFields position Suspects}
      {AllDistinct Ps}
      % Run the clues
      {Clue1 Elts}
      {Clue2 Elts}
      {Clue3 Elts}
      {Clue4 Elts}
      {Clue5 Elts}
      {Clue6 Elts}
      % Ensure that every tree and surname.
      {AllInstantiated Cs Carcolors}
      {AllInstantiated Ps Positions}
      % Return Elts as the answer
      Elts
   end
in
   {Browse {SearchAll Masquerading}}
end

Feeding Time (http://www.puzzlersparadise.com/puzzles/feedingtime.html)

declare
   % Every member of Xs has a value from Values.
   % Instantiates those that don't.
   proc {AllInstantiated Xs Values}
      {ForAll Xs proc {$ X} {IsIn X Values} end}
   end
   proc {Append ?Xs ?Ys ?Zs}
      choice
         Xs = nil 
         Ys = Zs
      [] X Xr in
         Xs = X | Xr
         Zs = X | {Append Xr Ys}
      end
   end
   % Creates a list of the values for Field in the elements
   % of Elts. Assumes Elts is a homgeneous list whose 
   % members are records with a field named Field.
   fun {GetFields Field Elts}
      {Map Elts fun {$ Elt} Elt.Field end}
   end
   % Returns the first index of X in Xs.  X and Xs must be
   % instantiated or will suspend until they are.
   % Fails if X is not in Xs.
   fun {IndexOf X Xs}
      fun {IndexOf3 X Xs N}
         case Xs of
            nil then fail
         [] Y | Rest then
            if X == Y then N else {IndexOf3 X Rest N+1} end
         end
      end
   in
     {IndexOf3 X Xs 1}
   end
   proc {IsIn ?X Xs} {Append _ X|_ Xs} end
   proc {IsAnElt ?X Elts} {IsIn X {Record.toList Elts}} end
   %% Constraints
   % Generate thread bombs that ensure that all the members
   % of List are distinct.
   proc {AllDistinct List}
      L = {Length List} in
      for I in 1; I =< L-1; I+1 do
         for J in I+1; J =< L; J+1 do
            {NotEqual {Nth List I} {Nth List J}}
         end
      end
   end
   % Plant a thread bomb that goes off if X and Y become
   % instantiated to the same value.
   proc {NotEqual X Y} thread X == Y = false end end
   % A thread bomb that ensures that X1 precedes X2 in Xs. 
   proc {Precedes ?X1 ?X2 Xs}
      thread {IndexOf X1 Xs} < {IndexOf X2 Xs} = true end
   end
   % Added GreaterThan thread bomb
   proc {GreaterThan X Y}
      thread X > Y = true end
   end
   % Added LessThan thread bomb
   proc {LessThan X Y}
      thread X < Y = true end
   end
   %added PlusEquals thread bomb plant
   proc {PlusEquals Base Additional Result} thread (Base + Additional) == Result = true end end
   %% Propagator utilitiess
   % If the fields common to R1 and R2 are all instantiated, returns 
   % true/false depending on whether they are all equal (==).
   % Suspends until fields become instantiated.
   fun {Match R1 R2}
      {Record.all
       {Record.zip R1 R2 fun {$ A B} A == B end}
       fun {$ X} X == true end}
   end
   % If {Match Condition R} then {UnifyRecs Result R}.
   % Does this in a thread to avoid blocking the main thread.
   % Also acts as a constraint in case the unification fails.
   proc {Propagate Condition Result R}
      thread if {Match Condition R} then {UnifyRecs Result R} end end    
   end
   % Propagates Condition -> Result to all the fields in the record Rec.
   % Each field is done in its own thread.  See Propagate.
   proc {PropagateAll Condition Result Rec}
      {Record.forAll Rec proc {$ R} {Propagate Condition Result R} end}
   end
   % Unifies the values of the fields common to R1 and R2
   proc {UnifyRecs R1 R2}
      {Record.zip R1 R2 fun {$ A B} A = B end _}
   end
local
   Feedingtimes = [630 645 700 715 730]
   proc {Clue1 Elts}
      % The giraffes were fed before the zebras
      {LessThan Elts.giraffes.feedingtime Elts.zebras.feedingtime}
      % but after the monkeys
      {GreaterThan Elts.giraffes.feedingtime Elts.monkeys.feedingtime}
   end
   proc {Clue2 Elts}
      %The bears were fed 15 minutes after the monkeys
      {PlusEquals Elts.monkeys.feedingtime 15 Elts.bears.feedingtime}
   end 
   proc {Clue3 Elts}
      % The lions were fed after the zebras
      {GreaterThan Elts.lions.feedingtime Elts.zebras.feedingtime}
   end
   fun {FeedingTime}
      Elts = {MakeRecord animals [bears giraffes lions monkeys zebras]}
      Fs
      Animals = {Record.toList Elts}
   in
      % Create property records for each man
      {Record.forAll Elts proc {$ S} S = {Record.make properties [feedingtime]} end}
      % Get the list of feeding time variables.
      % Constrain them to be distinct.
      Fs = {GetFields feedingtime Animals}
      {AllDistinct Fs}
      % Run the clues
      {Clue1 Elts}
      {Clue2 Elts}
      {Clue3 Elts}
      % Ensure that every feeding time is filled
      {AllInstantiated Fs Trees}
      % Return Elts as the answer
      Elts
   end
in
   {Browse {SearchAll FeedingTime}}
end