--* From postmaster%watson.vnet.ibm.com@yktvmv.watson.ibm.com Fri May 21 11:51:53 1993 --* Received: from yktvmv2.watson.ibm.com by radical.watson.ibm.com (AIX 3.2/UCB 5.64/900524) --* id AA11121; Fri, 21 May 1993 11:51:53 -0400 --* X-External-Networks: yes --* Received: from watson.vnet.ibm.com by yktvmv.watson.ibm.com (IBM VM SMTP V2R3) --* with BSMTP id 9359; Fri, 21 May 93 11:52:25 EDT --* Received: from YKTVMV by watson.vnet.ibm.com with "VAGENT.V1.0" --* id --* for asbugs@watson; Fri, 21 May 93 11:52:25 -0400 --* Received: from bernina.ethz.ch by watson.ibm.com (IBM VM SMTP V2R3) with TCP; --* Fri, 21 May 93 11:52:22 EDT --* Received: from neptune by bernina.ethz.ch with SMTP inbound id <12932-0@bernina.ethz.ch>; Fri, 21 May 1993 17:52:13 +0200 --* From: Philip Santas --* Received: from rutishauser.inf.ethz.ch (rutishauser-gw.inf.ethz.ch) by neptune id AA00550; Fri, 21 May 93 17:52:00 +0200 --* Date: Fri, 21 May 93 17:51:58 +0200 --* Message-Id: <9305211551.AA15193@rutishauser.inf.ethz.ch> --* Received: from ru7.inf.ethz.ch.rutishauser by rutishauser.inf.ethz.ch id AA15193; Fri, 21 May 93 17:51:58 +0200 --* To: jenks@watson.ibm.com, smwatt@watson.ibm.com, asbugs@watson.ibm.com --* Subject: missionaries.as --* Cc: bronstein --@ Fixed by: SSD Wed Dec 08 10:15:43 1993 --@ Tested by: none --@ Summary: See bug277.as. --missionaries.as +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ++ Author: Philip S. Santas ++ Date Created: 21 May 1939 ++ Date Last Updated: 21 May 1990 ++ Basic Operations: buffers, state-spaces, search-algorithms implemented as types (!), ++ modelling of situations, specifications. ++ The problem of missionaries ++ ++ Related Constructors: ++ Also See: queens.as, functional.as ++ AMS Classifications: ++ Keywords: parametric polymorphism, backtracking, typing ++ References: ++ Description: Breadth-dirst and depth-first algorithms are implemented ++ as data-types. Searh spaces have been parameterized. ++ Non-prolog solution to a prolog problem. ++ Compiler-Errors: It type-checks, but it does not compile. ++ Problems with the macros, do not allow me to define ++ differnt Buffers. Search-spaces do not compile either. ++ Problems with records, forced me to use additional ++ data-structures within MissionAndCanab (example: Situation). +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -- #include "aslib.as" #include "list.as" #include "functional.as" B ==> Bit SI ==> SingleInteger Agr ==> (S: with Object) -> with ListCategory S import B import SI BufferCategory S ==> empty: % exceptionEmpty: () -> (S, %) get : % -> (S, %) put : (S,%) -> % STATE ==> initial: % goal : % -> B moves: % -> List % -- SEARCH(S: with State) ==> -- search: S -> () SEARCH S ==> search: S -> () -- SearchCategory ==> (S: with STATE) -> with SEARCH S -- this is equivalent to SEARCH(S: with State) Search(States: with STATE, Buf: with BufferCategory(States)): with SEARCH(States) == add Rep ==> String import Buf import States -- tr(pen: Buf):() == -- import Fold(States,Buf) -- local cp:(States,Buf) == get pen -- goal (Kf cp) => () -- tr((foldright put)(moves (Kf cp), Ks cp)) -- search(state: States):() == tr(put(state, empty)) search(state: States):() == () BreadthFirst(S: with Object, Ag: Agr): with BufferCategory S == add Rep ==> Record(first: Ag S, second: Ag S) import Rep import Ag S empty: % == per [nil, nil] first(x:%):(Ag S) == rep (x).first second(x:%):(Ag S) == rep (x).second firstEmpty?(x:%):B == empty?(first x) secondEmpty?(x:%):B == empty?(rep (x).second) exceptionEmpty():(S,%) == (first nil, empty) -- HA-HA-HA get(f: Ag S, s: Ag S):(S, %) == empty? f => if empty? s then exceptionEmpty() else get (reverse s, nil) (first f, per [rest f, s]) get(x:%):(S, %) == get(first x, second x) put(x:S, y:%):% == per [first y, cons(x, second y)] -- DepthFirst(S: with Object, Ag: Agr): with -- BufferCategory S -- == add -- Rep ==> Record(first: Ag(S)) -- import Rep -- import Ag S -- -- empty: % == per [nil] -- first(x:%):(Ag S) == rep (x).first -- firstEmpty?(x:%):B == empty?(first x) -- -- exceptionEmpty():(S,%) == (first nil, empty) -- HA-HA-HA -- -- -- get(f: Ag S):(S, %) == -- empty? f => exceptionEmpty() -- (first f, per [rest f]) -- -- get(x:%):(S, %) == get(first x) -- -- put(x:S, y:%):% == per [cons(x, first y)] import String MissionAndCanab: with STATE == add Location: with LEFT: % RIGHT: % cross: %->% value: %->String apply: (Outport,%)->Outport == add Rep ==> Record(value: String) import Rep LEFT: % == per ["LEFT"] RIGHT: % == per ["RIGHT"] value(x:%):String == rep (x).value cross(x:%):% == value(x) = "LEFT" => RIGHT LEFT apply(pr:Outport, y:%):Outport == pr(rep y) import Location -- Situation ==> Record(mis: SI, can: SI, boat: Location) Situation: with Object mis: %->SI can: %->SI boat: %->Location mcb: (SI,SI,Location)->% apply:(Outport,%)->Outport == add Rep ==> Record(mis: SI, can: SI, boat: Location) import Rep import String mis(x:%):SI == rep(x).mis can(x:%):SI == rep(x).can boat(x:%):Location == rep(x).boat mcb(m:SI,c:SI,b:Location):% == per [m,c,b] apply(pr:Outport,x:%):Outport == pr("{ ")(mis x)(" ")(can x)(" ")(boat x)(" }") import Situation import List Situation -- Configuration ==> Record(mis: SI, can: SI) Configuration: with mis: %->SI can: %->SI mc: (SI,SI)->% == add Rep ==> Record(mis: SI, can: SI) import Rep mis(x:%):SI == rep(x).mis can(x:%):SI == rep(x).can mc(m:SI,c:SI):% == per [m,c] import Configuration -- passengers: List Configuration == [[2,0],[1,1],[0,2],[1,0],[0,1]] passengers: List Configuration == [mc(2,0),mc(1,1),mc(0,2),mc(1,0),mc(0,1)] Rep ==> List Situation import Rep -- safe(x:List Situation):B == -- local m: SI := (first x).mis -- local c: SI := (first x).can -- if (m=0) or ((m>=c) and ((3-m=0) or (3-m>=3-c))) -- then not(member?(first x, rest x)) -- else false safe(x:List Situation):B == local m: SI := mis (first x) local c: SI := can (first x) if (m=0) or ((m>=c) and ((3-m=0) or (3-m>=3-c))) then not(member?(first x, rest x)) else false -- move(x:List Configuration)(s: List Situation):(List List Situation) == -- empty? x => nil -- local xx: Configuration := first x -- local ss: Situation := first s -- if ss.mis >= xx.mis and ss.can >= xx.can -- then cons( -- cons([3-ss.mis+xx.mis, 3-ss.can+xx.can, cross(ss.boat)], s), -- (move (rest x)) s) -- else (move (rest x)) s move(x:List Configuration)(s:%):(List %) == empty? x => nil local xx: Configuration := first x local ss: Situation := first (rep s) if (mis ss) >= (mis xx) and (can ss) >= (can xx) then cons( per (cons(mcb(3-(mis ss)+(mis xx), 3-(can ss)+(can xx), cross(boat ss)), rep s)), (move (rest x)) s) else (move (rest x)) s -- import List % foo(pas:%, ll:List %):(List %) == safe (rep pas) => cons(pas,ll) ll moves(s:%): (List %) == import Fold(%,List %) (foldright foo)((move passengers) s, nil) initial:% == per [mcb(3,3,LEFT)] goal(x:%):B == import Fold(Situation,B) (map ((sit:Situation):B +-> (print(sit); true)))(reverse (rep x)) true import MissionAndCanab import BreadthFirst(SI,List) SolveBF ==> Search(MissionAndCanab, BreadthFirst(SI,List)) import SolveBF runWithBreadth():() == search initial