-- -*- Mode: Sather; -*- -- File: ocean.sa -- Author: Chu-Cheow Lim (clim@ICSI.Berkeley.EDU) -- Copyright (C) International Computer Science Institute, 1993 -- -- COPYRIGHT NOTICE: This code is provided "AS IS" WITHOUT ANY WARRANTY -- and is subject to the terms of the SATHER LIBRARY GENERAL PUBLIC -- LICENSE contained in the file: "sather/doc/license.txt" of the Sather -- distribution. The license is also available from ICSI, 1947 Center -- St., Suite 600, Berkeley CA 94704, USA. --*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --* FUNCTION: --* --* CLASSES: --* --* REQUIRED FILES: --* --* RELATED FILES: --* --* HISTORY: --* Last edited: Jun 2 17:34 1993 (clim) --* Created: Mon May 24 18:53:37 1993 (clim) --*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ class OCEAN{T} is -- The container for creature of type `T' in a toroidal ocean. -- Maps (x,y) to one creature; or void reference. Since the size -- of the ocean is fixed, there is a unique mapping from (x,y) to N, -- and we use the value from N as the key instead. -- * The y co-ordinate increases from bottom to top of 2-D toroidal grid. -- * The x co-ordinate increases from left to right of 2-D toroidal grid. -- * Direction of movement is: 0=R, 1=U, 2=L, 3=D, -1=No-Move -- * Positions of creature : x is in [0, ocean_width-1] -- y is in [0, ocean_height-1] -- * The sharks move together; then the fish move together -- (unlike the Matlab example: -- for each subset -- sharks move; fish move -- ) -- Inherit abstract classes first, because of overwrite rule in -- inheritance. ABSTRACT_OCEAN{T}; PSATHER_INT_HASH_MAP{T}; height, width:INT; alias old_create create; alias old_get get; alias old_insert insert; alias old_delete delete; create(h,w:INT):SELF_TYPE is res := old_create; res.height := h; res.width := w; end; -- create private map_unique_key(x,y:INT):INT is res := x*height+y; end; -- map_unique_key get(x,y:INT):T is res := old_get(map_unique_key(x,y)); end; -- get test(x,y:INT):BOOL is -- Returns `true' when there is a creature at (x,y); `false' otherwise. res := (get(x,y) /= void); end; -- test insert(x,y:INT; e:T) is old_insert(map_unique_key(x,y), e); end; -- insert delete(x,y:INT) is old_delete(map_unique_key(x,y)); end; -- delete cursor:OCEAN_CURSOR{T} is -- A cursor into the ocean of creatures. res := OCEAN_CURSOR{T}::create(self); end; -- cursor difference_with(x:SELF_TYPE):SELF_TYPE is res := self; c:OCEAN_CURSOR{T} := x.cursor; until c.is_done loop if (res.get(c.key_x,c.key_y) = c.item) then res.delete(c.key_x,c.key_y); end; -- if c.next; end; -- loop end; -- difference_with union_with(x:SELF_TYPE):SELF_TYPE is res := self; c:OCEAN_CURSOR{T} := x.cursor; until c.is_done loop res.insert(c.key_x,c.key_y,c.item); c.next; end; -- loop end; -- union_with constant DirUp:INT := 1; constant DirDown:INT := 3; constant DirLeft:INT := 2; constant DirRight:INT := 0; constant DirNone:INT := -1; discrete_dir(c:COMPLEX):INT is -- Convert to one of four discrete directions: DirUp, DirDown, -- DirLeft, DirRight. res := (c.theta*2.0/MATH::pi).round; if (res < 0) then res := res + 4 end; end; -- discrete_dir update_x_dir(pos:INT; dir:INT):INT is -- Update the new X-position after moving along given direction. if (dir = DirLeft) then res := pos-1; if (res = -1) then res:=width-1 end; elsif (dir = DirRight) then res := pos+1; if (res = width) then res:=0 end; else res := pos; end; -- if end; -- update_x_dir update_y_dir(pos:INT; dir:INT):INT is -- Update the new Y-position after moving along given direction. if (dir = DirDown) then res := pos-1; if (res = -1) then res:=height-1 end; elsif (dir = DirUp) then res := pos+1; if (res = height) then res:=0 end; else res := pos; end; -- if end; -- update_y_dir up_of(y_pos:INT):INT is res := y_pos+1; if (res = height) then res:=0 end; end; -- up_of down_of(y_pos:INT):INT is res := y_pos-1; if (res = -1) then res:=height-1 end; end; -- down_of left_of(x_pos:INT):INT is res := x_pos-1; if (res = -1) then res:=width-1 end; end; -- left_of right_of(x_pos:INT):INT is res := x_pos+1; if (res = width) then res:=0 end; end; -- right_of dirname(dir:INT):STR is switch (dir) when DirUp then res:="UP"; when DirDown then res:="DOWN"; when DirLeft then res:="LEFT"; when DirRight then res:="RIGHT"; when DirNone then res:="NONE"; else res:="UNKNOWN"; end; -- switch end; -- dirname end; -- class OCEAN{T} --~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ class OCEAN_CURSOR{T} is -- The cursor into the ocean can inherit implementation from -- "PSATHER_INT_HASH_MAP_CURSOR{T}". PSATHER_INT_HASH_MAP_CURSOR{T}; tbl:$OCEAN{T}; alias old_key key; create(t:$OCEAN{T}):SELF_TYPE is res := OCEAN_CURSOR{T}::new; res.tbl := t; res.first; end; -- create key_x:INT is res := key/tbl.height; end; -- key_x key_y:INT is res := key.u_mod(tbl.height); end; -- key_y end; -- class OCEAN_CURSOR{T} --~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ class OCEAN_OF_PREDATORS is -- This class also encapsulates the attraction of predators to different -- types of prey. ABSTRACT_OCEAN_OF_PREDATORS; -- Type inheritance OCEAN{$ABSTRACT_CREATURE}; -- Code inheritance -- Where the creatures in this set are located. shared_grounds:$ABSTRACT_OCEAN{$ABSTRACT_CREATURE}; -- Predators' random direction generator. predator_dir_gen:RANDOM; -- When more than one prey is present, use a random generator to select -- one of them. select_prey_gen:RANDOM; -- For use during computation. dead_predators:OCEAN_OF_PREDATORS; baby_predators:OCEAN_OF_PREDATORS; from_set:OCEAN_OF_PREDATORS; to_set:OCEAN_OF_PREDATORS; non_recurs_create(ht,width:INT):SELF_TYPE is res := old_create; res.height := ht; res.width := width; res.predator_dir_gen := RANDOM::create; res.select_prey_gen := RANDOM::create; res.predator_dir_gen.init(999); res.select_prey_gen.init(888); end; -- non_recurs_create create(ht,width:INT):SELF_TYPE is res := old_create; res.height := ht; res.width := width; res.predator_dir_gen := RANDOM::create; res.select_prey_gen := RANDOM::create; res.dead_predators := non_recurs_create(ht,width); res.baby_predators := non_recurs_create(ht,width); res.from_set := non_recurs_create(ht,width); res.to_set := non_recurs_create(ht,width); res.predator_dir_gen.init(999); res.select_prey_gen.init(888); end; -- create init_shared_grounds(sg:$ABSTRACT_OCEAN{$ABSTRACT_CREATURE}) is shared_grounds := sg; end; -- init_shared_grounds -- Prey's repulsion from predator. shared repel_scale:DOUBLE := -1.0; repel_prey(prey_pos_x,prey_pos_y:DOUBLE):COMPLEX is one:COMPLEX := COMPLEX::create(1.0, 0.0); repel:COMPLEX := COMPLEX::create(0.0, 0.0); predators_cursor:OCEAN_CURSOR{$ABSTRACT_CREATURE} := cursor; ith_predator_pos:COMPLEX := COMPLEX::create(0.0, 0.0); with self, one, repel, predators_cursor, ith_predator_pos near until (predators_cursor.is_done) loop ith_predator:$ABSTRACT_PREDATOR := predators_cursor.item; ith_predator_pos.x := ith_predator.pos_x.to_d; ith_predator_pos.y := ith_predator.pos_y.to_d; repel := repel.plus(one.divide(ith_predator_pos .to_minus(prey_pos_x,prey_pos_y).conj)); predators_cursor.next; end; -- loop res := repel.multiply_by_scalar(repel_scale); end; end; -- repel_prey help_eat_and_move(prey:$ABSTRACT_OCEAN_OF_PREY; -- The next 4 parameters must all be of same concrete -- type during execution, so that we can call -- "result.difference_with(dead_predators)....". dead_predators, baby_predators, from_set, to_set:$ABSTRACT_OCEAN_OF_PREDATORS) is -- Update the predators, eg breeding, increment age etc. -- Note: This version would be cleaner with an iterator generating -- set elements: -- loop -- ith_predator:$ABSTRACT_PREDATOR := o.elem; -- ... -- end; -- predators_cursor:OCEAN_CURSOR{$ABSTRACT_CREATURE} := cursor; scaled_attract, move_dir:COMPLEX; with self, predators_cursor near until (predators_cursor.is_done) loop ith_predator:$ABSTRACT_PREDATOR := predators_cursor.item; x_pos:INT := ith_predator.pos_x; y_pos:INT := ith_predator.pos_y; preyU:BOOL := prey.test(x_pos,shared_grounds.up_of(y_pos)); preyD:BOOL := prey.test(x_pos,shared_grounds.down_of(y_pos)); preyL:BOOL := prey.test(shared_grounds.left_of(x_pos),y_pos); preyR:BOOL := prey.test(shared_grounds.right_of(x_pos),y_pos); -- There is no routine to convert BOOL to INT; otherwise it -- would be simpler to have: -- preyAny:INT := preyU.to_i + preyD.to_i + preyL.to_i + preyR.to_i; preyAny:INT; if (preyU) then preyAny:=preyAny+1 end; if (preyD) then preyAny:=preyAny+1 end; if (preyL) then preyAny:=preyAny+1 end; if (preyR) then preyAny:=preyAny+1 end; -- Whenever there are two or more prey in the neighborhood, -- the predator always eats one of the prey, and hence there is -- at least one possible fixed destination, so that "direction" -- cannot take on value "DirNone". -- (Inferred from the Matlab example). direction:INT; eat:BOOL; if (preyAny = 1) then if (preyU) then direction:=DirUp; elsif (preyD) then direction:=DirDown; elsif (preyL) then direction:=DirLeft; else direction:=DirRight; end; -- if eat:=true; elsif (preyAny > 1) then -- Only when there are two or more prey do we use the random -- number generator, since this costs more than the simple case -- of exactly 1 prey. select_i:INT := select_prey_gen.int_range(1,preyAny); eat:=true; direction:=DirNone; -- Select the ith direction which has a prey. i:INT; if (preyU) then i:=i+1; if (i=select_i) then direction:=DirUp end; end; -- if if (preyD) then i:=i+1; if (i=select_i) then direction:=DirDown end; end; -- if if (preyL) then i:=i+1; if (i=select_i) then direction:=DirLeft end; end; -- if if (preyR) then i:=i+1; if (i=select_i) then direction:=DirRight end; end; -- if assert (post) (direction /= DirNone) end; else random_dir:COMPLEX := COMPLEX::create( predator_dir_gen.standard_normal, predator_dir_gen.standard_normal); scaled_attract := prey.attract_predator(x_pos.to_d,y_pos.to_d); move_dir := random_dir.plus(scaled_attract); direction := discrete_dir(move_dir); -- We know there's no prey, but still have to check whether we -- would bump into another predator. if (direction = DirUp) then if (shared_grounds.test(x_pos,shared_grounds.up_of(y_pos))) then direction:=DirNone end; elsif (direction = DirDown) then if (shared_grounds.test(x_pos,shared_grounds.down_of(y_pos))) then direction:=DirNone end; elsif (direction = DirLeft) then if (shared_grounds.test(shared_grounds.left_of(x_pos),y_pos)) then direction:=DirNone end; elsif (direction = DirRight) then if (shared_grounds.test(shared_grounds.right_of(x_pos),y_pos)) then direction:=DirNone end; end; -- if end; -- if -- Treat different predators differently. In 1.0, we will use -- a typecase statement here. if (ith_predator.type = SHARK::type)then ith_shark:SHARK := ith_predator; ith_shark.age := ith_shark.age + 1; new_x:INT := shared_grounds.update_x_dir(x_pos, direction); new_y:INT := shared_grounds.update_y_dir(y_pos, direction); dead:BOOL; if (not eat) then -- This predator cannot eat (if it can eat, the direction is -- guaranteed to not be "DirNone"), neither can it move. We -- check how long it has been starving. Note that the predator -- does not breed as long as it does not move. if (ith_shark.starve_age <= SHARK::starve_time) then ith_shark.starve_age := ith_shark.starve_age + 1; else -- Mark this shark as dead. -- NOTE: We cannot call "delete(x_pos,y_pos)" because the -- cursor is currently iterating over the set. The same remark -- applies even when we have an iterator. So mark the -- dead predator position with a corpse instead. dead_predators.insert(x_pos,y_pos,ith_shark); -- It's ok to delete the creature from the shared grounds. shared_grounds.delete(x_pos,y_pos); dead := true; end; -- if else -- When the shark gets to eat, we reset the starving time. -- Mark the shark grid at the current shark position, and -- delete the prey at the same position (when eating). ith_shark.starve_age := 0; prey.delete(new_x,new_y); shared_grounds.delete(new_x,new_y); end; -- if if (direction /= DirNone) and (not dead) then -- When we have PAIR, this is simpler: -- (new_x,new_y)::=update_dir(x_pos,y_pos,direction); -- shark.update_pos(new_x,new_y); -- ith_shark.update_pos(new_x,new_y); shared_grounds.insert(new_x,new_y,ith_shark); from_set.insert(x_pos,y_pos,ith_shark); to_set.insert(new_x,new_y,ith_shark); -- Delete the shark from the grounds only when there is no -- baby; otherwise it'll simply get overwritten. if (ith_shark.age > SHARK::breed_age) then -- Create a new shark and insert into "baby_predators"; leave -- the grid marked. Note the re-assignment. baby:SHARK := SHARK::create(x_pos,y_pos) @ shared_grounds.cluster_id_of(x_pos,y_pos); baby_predators.insert(x_pos,y_pos,baby); -- Simply insert "baby" into current position; will overwrite -- current creature. shared_grounds.insert(x_pos,y_pos,baby); else shared_grounds.delete(x_pos,y_pos); end; -- if end; -- if end; -- if -- * GC: Deallocate the complex numbers created. if (scaled_attract /= void) then scaled_attract.invalidate end; if (move_dir /= void) then move_dir.invalidate end; predators_cursor.next; end; -- loop end; -- near -- * GC: Deallocate cursor object. predators_cursor.invalidate; end; -- help_eat_and_move eat_and_move(prey:$ABSTRACT_OCEAN_OF_PREY) is -- Call the helper routine. dead_predators.clear; baby_predators.clear; from_set.clear; to_set.clear; help_eat_and_move(prey, dead_predators, baby_predators, from_set, to_set); -- Remove the dead predators and add the baby predators. difference_with(dead_predators) .difference_with(from_set) .union_with(baby_predators) .union_with(to_set); end; -- eat_and_move end; -- class OCEAN_OF_PREDATORS --~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ class OCEAN_OF_PREY is -- Inherit abstract classes first, because of overwrite rule in -- inheritance. ABSTRACT_OCEAN_OF_PREY; -- Type inheritance. OCEAN{$ABSTRACT_CREATURE}; -- Code inheritance. -- Where the creatures in this set are located. shared_grounds:$ABSTRACT_OCEAN{$ABSTRACT_CREATURE}; -- Preys' random direction generator. prey_dir_gen:RANDOM; -- For use during the "move_from" computation. baby_prey:OCEAN_OF_PREY; from_set:OCEAN_OF_PREY; to_set:OCEAN_OF_PREY; non_recurs_create(ht,width:INT):SELF_TYPE is res := old_create; res.height := ht; res.width := width; res.prey_dir_gen := RANDOM::create; res.prey_dir_gen.init(333); end; -- non_recurs_create create(ht,width:INT):SELF_TYPE is res := old_create; res.height := ht; res.width := width; res.prey_dir_gen := RANDOM::create; res.baby_prey := non_recurs_create(ht,width); res.from_set := non_recurs_create(ht,width); res.to_set := non_recurs_create(ht,width); res.prey_dir_gen.init(333); end; -- create init_shared_grounds(sg:$ABSTRACT_OCEAN{$ABSTRACT_CREATURE}) is shared_grounds := sg; end; -- init_shared_grounds -- Predators' attraction to prey. shared attract_scale:DOUBLE := 100.0; attract_predator(predator_pos_x,predator_pos_y:DOUBLE):COMPLEX is one:COMPLEX := COMPLEX::create(1.0, 0.0); attract:COMPLEX := COMPLEX::create(0.0, 0.0); prey_cursor:OCEAN_CURSOR{$ABSTRACT_CREATURE} := cursor; ith_prey_pos:COMPLEX := COMPLEX::create(0.0, 0.0); with self, one, attract, prey_cursor, ith_prey_pos near until (prey_cursor.is_done) loop ith_prey:$ABSTRACT_PREY := prey_cursor.item; ith_prey_pos.x := ith_prey.pos_x.to_d; ith_prey_pos.y := ith_prey.pos_y.to_d; attract := attract.plus(one.divide(ith_prey_pos .to_minus(predator_pos_x,predator_pos_y).conj)); prey_cursor.next; end; -- loop res := attract.multiply_by_scalar(attract_scale); end; end; -- attract_predator help_move_from(predators:$ABSTRACT_OCEAN_OF_PREDATORS; -- The next 3 parameters must all have the same concrete type -- during execution, so that we can call -- "result.difference_with(from_set)....". baby_prey, from_set, to_set:$ABSTRACT_OCEAN_OF_PREY) is -- Update the prey, eg breeding, increment age, move etc. prey_cursor:OCEAN_CURSOR{$ABSTRACT_CREATURE} := cursor; with self, prey_cursor near until (prey_cursor.is_done) loop ith_prey:$ABSTRACT_PREY := prey_cursor.item; x_pos:INT := ith_prey.pos_x; y_pos:INT := ith_prey.pos_y; random_dir:COMPLEX := COMPLEX::create(prey_dir_gen.standard_normal, prey_dir_gen.standard_normal); scaled_repel:COMPLEX := predators.repel_prey(x_pos.to_d, y_pos.to_d); move_dir:COMPLEX := random_dir.plus(scaled_repel); direction:INT := discrete_dir(move_dir); -- Check whether we would bump into another shark or fish. -- Note that "shared_grounds" allow us to do one test, instead of -- testing at (x,y) for either prey/predator. if (direction = DirUp) then if (shared_grounds.test(x_pos,shared_grounds.up_of(y_pos))) then direction:=DirNone end; elsif (direction = DirDown) then if (shared_grounds.test(x_pos,shared_grounds.down_of(y_pos))) then direction:=DirNone end; elsif (direction = DirLeft) then if (shared_grounds.test(shared_grounds.left_of(x_pos),y_pos)) then direction:=DirNone end; elsif (direction = DirRight) then if (shared_grounds.test(shared_grounds.right_of(x_pos),y_pos)) then direction:=DirNone end; elsif (direction /= DirNone) then ERR::s("Error in direction computation = ").i(direction).nl; end; -- if if (ith_prey.type = FISH::type) then ith_fish:FISH := ith_prey; ith_fish.age := ith_fish.age+1; if (direction /= DirNone) then new_x:INT := shared_grounds.update_x_dir(x_pos, direction); new_y:INT := shared_grounds.update_y_dir(y_pos, direction); ith_fish.update_pos(new_x,new_y); shared_grounds.insert(new_x,new_y,ith_fish); from_set.insert(x_pos,y_pos,ith_fish); to_set.insert(new_x,new_y,ith_fish); -- The fish moves, so we check the breeding age. if (ith_fish.age > FISH::breed_age) then f:FISH := FISH::create(x_pos,y_pos) @ shared_grounds.cluster_id_of(x_pos,y_pos); baby_prey.insert(x_pos,y_pos,f); shared_grounds.insert(x_pos,y_pos,f); else shared_grounds.delete(x_pos,y_pos); end; -- if end; -- if end; -- if -- * GC: Deallocate the complex numbers created. if (scaled_repel /= void) then scaled_repel.invalidate end; if (move_dir /= void) then move_dir.invalidate end; prey_cursor.next; end; -- loop end; -- near -- * GC: Deallocate cursor object. prey_cursor.invalidate; end; -- help_move_from move_from(predators:$ABSTRACT_OCEAN_OF_PREDATORS) is baby_prey.clear; from_set.clear; to_set.clear; help_move_from(predators, baby_prey, from_set, to_set); difference_with(from_set).union_with(to_set).union_with(baby_prey); end; -- move_from end; -- class OCEAN_OF_PREY --~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~