{- Spatial Reference Frames An executable model producing valid descriptions from situations, discourse roles, and reference frame types. Design decisions: - entities have a position and a footprint in a situation; they can have a heading (h) and/or motion (m) - box, room, wall, town, country, place: -h -m - chair, queue, river: +h -m - ball, wheel: -h +m - person, mouse, car: +h +m - two kinds of cognitive roles, filled by entities (or their properties) in a situation: - spatial roles: locatum, relatum and (optional) vantage - discourse roles (both optional): speaker, addressee - participants are all entities not assigned a speaker or addressee role - three types of reference frames: intrinsic, relative or absolute - with a directional system (i.e., an ordered list of direction names) - always anchored in the relatum - oriented through a perspective (c) Werner Kuhn Last modified: 23 Jun 2011 (WK) -} module SpatialReference where import Maybe -- for optional roles -- positions are individual raster cells type Position = (Int, Int) -- footprints are sets of positions type Footprint = [Position] -- directions are free unit vectors type Direction = (Int, Int) quadrant (0,1) = 0 quadrant (1,0) = 1 quadrant (0,-1) = 2 quadrant (-1,0) = 3 -- the direction from one position to another (as a unit vector) fromTo :: Position -> Position -> Direction fromTo p1 p2 = (signum (fst p2 - fst p1), signum (snd p2 - snd p1)) -- rotate the first direction into the system of the second (if any) rotate :: Direction -> Direction -> Direction rotate d1 d2 = if d2 == (0,0) then d1 else (snd d2 * fst d1 - fst d2 * snd d1, fst d2 * fst d1 + snd d2 * snd d1) -- direction names type DirectionalSystem = [String] projective, inverse, compass :: DirectionalSystem projective = ["front", "right", "back", "left"] inverse = ["back", "right", "front", "left"] compass = ["north", "east", "south", "west"] ---------------------------------------------------------------------- -- entities -- entities only exist in situations, therefore no operations are defined on them -- position, footprint, heading, and motion use the situation coordinate system data Entity = Entity { noun :: String, position :: Position, footprint :: Footprint, -- centered on the position! heading :: Direction, motion :: Direction} deriving (Eq, Show) ---------------------------------------------------------------------- -- reference frames -- a frame type and directional system -- so far, each type has its own directional system, but this may be different for other languages -- also, absolute frames could use other than compass directions data Frame = Intrinsic DirectionalSystem | Relative DirectionalSystem | Absolute DirectionalSystem ---------------------------------------------------------------------- -- situations -- assigning spatial roles to entities data Situation = Situation Locatum Relatum (Maybe Vantage) deriving Show type Locatum = Entity type Relatum = Entity type Vantage = Entity -- is the locatum inside the relatum? internal (Situation locatum relatum vantage) = (position locatum) `elem` (footprint relatum) -- the direction from relatum to locatum relatum2locatum (Situation locatum relatum vantage) = fromTo (position relatum) (position locatum) -- the perspective -- defines the direction of the first element of the directional system -- taken from the heading or motion of the relatum or vantage perspective (Situation locatum relatum Nothing) = if (motion relatum) == (0,0) then heading relatum else motion relatum perspective (Situation locatum relatum (Just vantage)) = if (motion vantage) == (0,0) then heading vantage else motion vantage -- the direction from relatum to locatum seen from the perspective direction situation = rotate (relatum2locatum situation) (perspective situation) ---------------------------------------------------------------------- -- discourse roles -- assigning discourse roles to entities data DiscourseRoles = DiscourseRoles (Maybe Speaker) (Maybe Addressee) deriving Show type Speaker = Entity type Addressee = Entity -- the view taken of a situation data View = Field | Object deriving Eq --------------------------------------------------------------------- -- sentences -- generating English sentences from situations, discourse roles, and reference frames description :: Situation -> DiscourseRoles -> Frame -> View -> String description situation discourse frame view = (subjectVerb situation discourse view) ++ (preposition situation frame) ++ (object situation discourse) -- subject and verb -- in field or object view subjectVerb (Situation locatum relatum vantage) (DiscourseRoles speaker addressee) view | speaker == (Just locatum) = if view == Object then "I am " else "There is me " -- unnatural, but correct | addressee == (Just locatum) = if view == Object then "You are " else "There is you " -- unnatural, but correct | otherwise = if view == Object then "The " ++ noun locatum ++ "is " else "There is a " ++ noun locatum -- preposition preposition situation frame = if internal situation then case frame of (Absolute directionalSystem) -> "in the " ++ directionalSystem !! (quadrant (direction situation)) ++ " of " (Intrinsic directionalSystem) -> case fst (direction situation) of 0 -> "in the " ++ directionalSystem !! (quadrant (direction situation)) ++ " of " 1 -> "on the " ++ directionalSystem !! (quadrant (direction situation)) ++ " side of " (Relative directionalSystem) -> case fst (direction situation) of 0 -> "in the " ++ directionalSystem !! (quadrant (direction situation)) ++ " of " 1 -> "on the " ++ directionalSystem !! (quadrant (direction situation)) ++ " side of " else case frame of (Absolute directionalSystem) -> directionalSystem !! (quadrant (direction situation)) ++ " of " (Intrinsic directionalSystem) -> case (direction situation) of (0,1) -> "in " ++ directionalSystem !! (quadrant (direction situation)) ++ " of " (1,0) -> "to the " ++ directionalSystem !! (quadrant (direction situation)) ++ " of " (0,-1) -> "behind " ++ directionalSystem !! (quadrant (direction situation)) (-1,0) -> "to the " ++ directionalSystem !! (quadrant (direction situation)) ++ " of " (Relative directionalSystem) -> case (direction situation) of (0,1) -> "behind " (1,0) -> "to the " ++ directionalSystem !! (quadrant (direction situation)) ++ " of " (0,-1) -> "in " ++ directionalSystem !! (quadrant (direction situation)) ++ " of " (-1,0) -> "to the " ++ directionalSystem !! (quadrant (direction situation)) ++ " of " -- object object (Situation locatum relatum vantage) (DiscourseRoles speaker addressee) | speaker == (Just relatum) = "me " | addressee == (Just relatum) = "you " | otherwise = "the " ++ noun relatum -- Test Data ------------ -- entities box75 = Entity {noun = "box ", position = (7,5), footprint = [(7,5)], heading = (0,0), motion = (0,0)} box73 = Entity {noun = "box ", position = (7,3), footprint = [(7,3)], heading = (0,0), motion = (0,0)} box65 = Entity {noun = "box ", position = (6,5), footprint = [(6,5)], heading = (0,0), motion = (0,0)} box95 = Entity {noun = "box ", position = (9,5), footprint = [(9,5)], heading = (0,0), motion = (0,0)} person55 = Entity {noun = "person ", position = (5,5), footprint = [(5,5)], heading = (1,0), motion = (0,0)} person75 = Entity {noun = "person ", position = (7,5), footprint = [(7,5)], heading = (1,0), motion = (0,0)} person73 = Entity {noun = "person ", position = (7,3), footprint = [(7,3)], heading = (1,0), motion = (0,0)} chair = Entity {noun = "chair ", position = (5,5), footprint = [(5,5)], heading = (1,0), motion = (0,0)} ball = Entity {noun = "ball ", position = (7,5), footprint = [(7,5)], heading = (0,0), motion = (0,0)} rollingBall = Entity {noun = "a ball ", position = (7,5), footprint = [(7,5)], heading = (0,0), motion = (1,0)} mouse = Entity {noun = "mouse ", position = (9,5), footprint = [(9,5)], heading = (1,0), motion = (1,0)} car = Entity {noun = "car ", position = (5,5), footprint = [(4,5), (5,5), (6,5)], heading = (1,0), motion = (0,0)} room = Entity {noun = "room ", position = (6,5), footprint = [(5,5), (6,5), (7,5)], heading = (0,0), motion = (0,0)} country = Entity {noun = "country ", position = (6,5), footprint = [(5,5), (6,5), (7,5)], heading = (0,0), motion = (0,0)} town = Entity {noun = "town ", position = (7,5), footprint = [(7,5)], heading = (0,0), motion = (0,0)} wheel = Entity {noun = "wheel ", position = (9,3), footprint = [(9,3)], heading = (0,1), motion = (0,1)} river = Entity {noun = "river ", position = (8,5), footprint = [(7,5),(8,5),(9,5)], heading = (1,0), motion = (1,0)} floatingBox = Entity {noun = "box ", position = (9,5), footprint = [(9,5)], heading = (0,0), motion = (1,0)} floatingBall = Entity {noun = "ball ", position = (7,5), footprint = [(7,5)], heading = (0,0), motion = (1,0)} peter = Entity {noun = "person called Peter ", position = (9,5), footprint = [(9,5)], heading = (0,1), motion = (1,0)} -- "person called" avoids requiring names in addition to nouns mary = Entity {noun = "person called Mary ", position = (7,5), footprint = [(7,5)], heading = (0,1), motion = (1,0)} queue = Entity {noun = "queue ", position = (8,5), footprint = [(7,5),(8,5),(9,5)], heading = (1,0), motion = (0,0)} movingBox = Entity {noun = "box ", position = (9,5), footprint = [(9,5)], heading = (0,0), motion = (1,0)} -- situations s1 = Situation box75 person55 Nothing s2 = s1 s3 = Situation box75 chair Nothing s4 = Situation person75 person55 Nothing s5 = s4 s6 = Situation box73 ball (Just person55) s7 = s6 s8 = Situation box73 ball (Just chair) s9 = Situation person73 ball (Just person55) s10 = s9 s11 = Situation box73 person75 (Just person55) s12 = s11 s13a = Situation box65 ball (Just person55) s13b = Situation box95 ball (Just person55) s14 = Situation box95 ball Nothing s15 = Situation box75 car Nothing s16 = Situation box65 car Nothing s17 = Situation box75 room (Just person55) s19 = Situation town country Nothing s20 = Situation mouse rollingBall Nothing s21 = Situation box95 ball (Just wheel) s22 = Situation floatingBox floatingBall Nothing s23 = Situation peter mary Nothing s24 = Situation movingBox person75 Nothing -- etc. ad libitum (25 to 43 do not add anything new) -- DiscourseRoles d1 = DiscourseRoles (Just person55) Nothing d2 = DiscourseRoles Nothing (Just person55) d3 = DiscourseRoles Nothing Nothing d4 = DiscourseRoles (Just person75) (Just person55) d5 = DiscourseRoles (Just person55) (Just person75) d6 = DiscourseRoles (Just person55) Nothing d7 = DiscourseRoles Nothing (Just person55) d8 = DiscourseRoles Nothing Nothing d9 = DiscourseRoles (Just person73) (Just person55) d10 = DiscourseRoles (Just person55) (Just person73) d11 = DiscourseRoles (Just person75) (Just person55) d12 = DiscourseRoles (Just person55) (Just person75) d13a = DiscourseRoles (Just person55) Nothing d13b = DiscourseRoles (Just person55) Nothing d14 = DiscourseRoles Nothing Nothing d15 = DiscourseRoles Nothing Nothing d16 = DiscourseRoles Nothing Nothing d17 = DiscourseRoles Nothing Nothing d19 = DiscourseRoles Nothing Nothing d20 = DiscourseRoles Nothing Nothing d21 = DiscourseRoles Nothing Nothing d22 = DiscourseRoles Nothing Nothing d23 = DiscourseRoles Nothing Nothing d24 = DiscourseRoles (Just person75) Nothing -- sentences t1 = description s1 d1 (Intrinsic projective) Field t2 = description s2 d2 (Intrinsic projective) Field t3 = description s3 d3 (Intrinsic projective) Field t4 = description s4 d4 (Intrinsic projective) Object t5 = description s5 d5 (Intrinsic projective) Object t6 = description s6 d6 (Relative inverse) Field t7 = description s7 d7 (Relative inverse) Field t8 = description s8 d8 (Relative inverse) Field t9 = description s9 d9 (Relative inverse) Object t10 = description s10 d10 (Relative inverse) Object t11 = description s11 d11 (Relative inverse) Field t12 = description s12 d12 (Relative inverse) Field t13a = description s13a d13a (Relative inverse) Field t13b = description s13b d13b (Relative inverse) Field t14 = description s14 d14 (Absolute compass) Field t15 = description s15 d15 (Intrinsic projective) Object t16 = description s16 d16 (Intrinsic projective) Object t17 = description s17 d17 (Relative inverse) Object t19 = description s19 d19 (Absolute compass) Object t20 = description s20 d20 (Intrinsic projective) Object t21 = description s21 d21 (Relative inverse) Object t22 = description s22 d22 (Intrinsic projective) Object t23 = description s23 d23 (Intrinsic projective) Object t24 = description s24 d24 (Intrinsic projective) Object