CoCalc -- Syntax2.hs

Logic of "all" + verbs + relative clauses, for a class at Indiana University
Views: ⁶⁸⁷¹
1
module Syntax2 where
2
import Data.List
3
import Data.Maybe
4

5
class Syn a where
6
   negation  :: a -> a
7
   subterms :: a -> [Term]
8
   cnsIn :: a -> [CN]
9
   verbsIn :: a -> [V]  
10
   buildTermSub :: a -> a -> Maybe [(Term,Term)]
11
   buildPVSub :: a -> a -> Maybe [(PV,PV)]
12
   spellOut :: a -> [(Term, Term)] -> [(PV, PV)] -> a
13
   hasNegativeMarker :: a-> Bool
14
   inARC :: a -> Maybe Bool
15
  
16
-- I DON'T THINK WE NEED hasNegativeMarker
17

18
xAsDefaultTerm :: Maybe Term -> Term
19
xAsDefaultTerm = fromMaybe (CNasTerm $ PCN Pos X)
20
     
21
rAsDefaultPV :: Maybe PV -> PV
22
rAsDefaultPV = fromMaybe (PV Pos R)
23
    
24
plusStrict :: (Eq a) => Maybe [a] -> Maybe [a] -> Maybe [a]
25
plusStrict a b = a >>= \x -> b >>= \y -> return $ nub $ x ++ y
26

27
hunt :: (Eq a) => a ->  Maybe [(a,a)] -> Maybe a
28

29
hunt t Nothing = Nothing
30
hunt t (Just [])  = Nothing
31
hunt t (Just ((uu,vv):rest)) 
32
  | (t==uu)  =  (Just vv)
33
  | otherwise = hunt t (Just rest)
34
  
35
moveAhead  ::  (Eq a) =>  Maybe [(a,a)]  ->  Maybe [(a,a)]  -> Bool
36
moveAhead Nothing  xx = False
37
moveAhead  xx Nothing = False
38
moveAhead (Just []) xx = True
39
moveAhead (Just ((uu,vv):rest))  xx 
40
        | value == (Just vv)  =  (moveAhead (Just rest) xx)
41
        | value == Nothing  =    (moveAhead (Just rest) xx)
42
        | otherwise  = False
43
   where  value = hunt uu xx
44
   
45
combineStructures xx yy =
46
    if moveAhead xx yy == True then (plusStrict xx yy) else Nothing
47

48
-- I THINK WE SHOULD DROP THESE  
49
--polarizedCNNegation (PCN Pos cn) = (PCN Neg cn)
50
--polarizedCNNegation (PCN Neg cn) = (PCN Pos cn)
51

52
-- the definition of  pCNsIn is needed in Sdagleq.hs, but not elsewhere
53
pCNsIn (CNasTerm (PCN Pos cn))  = (PCN Pos cn)
54
pCNsIn (CNasTerm (PCN Neg cn))  = (PCN Neg cn)
55
pCNsIn (TermMaker (PV Pos v) (TermNP All n))  =  pCNsIn n
56
pCNsIn (TermMaker (PV Pos v) (TermNP Some n))  =  pCNsIn n
57
pCNsIn (TermMaker (PV Neg v) (TermNP All n))  =  pCNsIn n
58
pCNsIn (TermMaker (PV Neg v) (TermNP Some n))  =  pCNsIn n 
59

60
{-
61
instance Syn [Char] where
62
   cnsIn x = cnsIn (readS x)
63
-}
64

65
instance Syn PolCN where
66
   negation (PCN Pos cn) = (PCN Neg cn)
67
   negation (PCN Neg cn) = (PCN Pos cn)
68
   subterms cn = []
69
   cnsIn (PCN p cn)  = [cn]
70
   verbsIn (PCN p cn)  = [ ]
71
   buildTermSub (PCN p cn) (PCN p' cn') = Just [] 
72
   buildPVSub (PCN p cn) (PCN p' cn') = Just []
73
   spellOut (PCN p cn) k k' = (PCN p cn)   --- THIS LINE IS QUESTIONABLE.  IT'S NOT NEEDED
74
   hasNegativeMarker (PCN Pos cn) = False
75
   hasNegativeMarker (PCN Neg cn) = True
76
   inARC (PCN Pos cn) = Just True
77
   inARC (PCN Neg cn) = Just False
78
   
79
instance Syn Term where
80
   negation (CNasTerm (PCN Pos cn))  = (CNasTerm (PCN Neg cn))
81
   negation (CNasTerm (PCN Neg cn))  = (CNasTerm (PCN Pos cn))
82
   negation (TermMaker (PV Pos v) (TermNP All n))  =  TermMaker (PV Neg v) (TermNP Some n) 
83
   negation (TermMaker (PV Pos v) (TermNP Some n))  =  TermMaker (PV Neg v) (TermNP All n) 
84
   negation (TermMaker (PV Neg v) (TermNP All n))  =  TermMaker (PV Pos v) (TermNP Some n) 
85
   negation (TermMaker (PV Neg v) (TermNP Some n))  =  TermMaker (PV Pos v) (TermNP All n) 
86
   subterms (CNasTerm ter) =  [(CNasTerm ter)]
87
   subterms (TermMaker pv (TermNP d ter)) = (TermMaker pv (TermNP d ter)):subterms ter
88
   cnsIn Ter1 = []
89
   cnsIn Ter2 = []
90
   cnsIn Ter3 = []
91
   cnsIn Ter1bar = []
92
   cnsIn Ter2bar = []
93
   cnsIn Ter3bar = []
94
   cnsIn (CNasTerm (PCN p cn)) = [cn]
95
   cnsIn (TermMaker t n) =    (cnsIn n) 
96
   hasNegativeMarker   (CNasTerm (PCN Pos cn)) = False
97
   hasNegativeMarker (CNasTerm (PCN Neg cn))  =  True
98
   hasNegativeMarker (TermMaker (PV Pos v) (TermNP All n))  =  hasNegativeMarker n
99
   hasNegativeMarker (TermMaker (PV Pos v) (TermNP Some n))  =  hasNegativeMarker n 
100
   hasNegativeMarker (TermMaker (PV Neg v) (TermNP All n))  =  hasNegativeMarker n 
101
   hasNegativeMarker (TermMaker (PV Neg v) (TermNP Some n))  =  hasNegativeMarker n 
102
   inARC   (CNasTerm (PCN Pos cn)) = Just True
103
   inARC (CNasTerm (PCN Neg cn))  =  Just False
104
   inARC (TermMaker (PV Pos v) (TermNP All n))  =  Just $ not $ hasNegativeMarker n
105
   inARC (TermMaker (PV Pos v) (TermNP Some n))  =  Just False
106
   inARC (TermMaker (PV Neg v) (TermNP All n))  =  Just False 
107
   inARC (TermMaker (PV Neg v) (TermNP Some n))  =  Just False   
108
   inARC x = Nothing  
109
   verbsIn (TermMaker (PV pol ver) np) =  [ver] ++  (verbsIn np)    
110
   verbsIn _                                            = []
111
   buildTermSub (TermMaker x y) (CNasTerm z) = Nothing
112
   buildTermSub (CNasTerm (PCN Pos cn))  (CNasTerm dn) = Just [(CNasTerm (PCN Pos cn), CNasTerm dn)]  
113
   buildTermSub (CNasTerm (PCN Neg cn))  (CNasTerm (PCN Pos dn)) = Just [(CNasTerm (PCN Pos cn), CNasTerm (PCN Neg dn))]  
114
   buildTermSub (CNasTerm (PCN Neg cn))  (CNasTerm (PCN Neg dn)) = Just [(CNasTerm (PCN Pos cn), CNasTerm (PCN Pos dn))]  
115
   buildTermSub (CNasTerm zz)(TermMaker xx yy)  = Nothing
116
   buildTermSub (TermMaker v np1) (TermMaker w np2)  =  buildTermSub np1 np2
117
   buildTermSub Ter1 t = Just [(Ter1, t)]  
118
   buildTermSub Ter2 t = Just [(Ter2, t)]
119
   buildTermSub Ter3 t = Just [(Ter3, t)]
120
   buildTermSub Ter1bar t = Just [(Ter1, negation t)]  
121
   buildTermSub Ter2bar t = Just [(Ter2, negation t)]
122
   buildTermSub Ter3bar t = Just [(Ter3, negation t)]
123
   buildPVSub (TermMaker xx yy) (CNasTerm zz) = Nothing
124
   buildPVSub (CNasTerm xx) ter = Just []
125
   buildPVSub (TermMaker vv (TermNP d t)) (TermMaker ww (TermNP e u))  =  
126
      if (d == e) then Just [(vv,ww)] else Nothing
127
   buildPVSub Ter1 t = Just []
128
   buildPVSub Ter2 t = Just []
129
   buildPVSub Ter3 t = Just []
130
   buildPVSub Ter1bar t = Just []
131
   buildPVSub Ter2bar t = Just []
132
   buildPVSub Ter3bar t = Just []  
133
   spellOut (CNasTerm (PCN Pos cn)) list1 list2 = xAsDefaultTerm  $ lookup (CNasTerm (PCN Pos cn)) list1
134
   spellOut (CNasTerm (PCN Neg cn)) list1 list2 = negation $ xAsDefaultTerm  $ lookup (CNasTerm (PCN Pos cn)) list1
135
   spellOut (TermMaker t n) list1 list2   =   (TermMaker (rAsDefaultPV $ lookup t list2)   (spellOut n list1 list2))
136
   spellOut  Ter1 list1 list2 =  xAsDefaultTerm  $ lookup  Ter1 list1
137
   spellOut  Ter2 list1 list2 =  xAsDefaultTerm  $ lookup  Ter2 list1
138
   spellOut  Ter3 list1 list2 =  xAsDefaultTerm  $ lookup  Ter3 list1
139
   spellOut  Ter1bar list1 list2 =  negation $ spellOut  Ter1 list1 list2
140
   spellOut  Ter2bar list1 list2 =  negation $ spellOut  Ter2 list1 list2
141
   spellOut  Ter3bar list1 list2 =  negation $ spellOut  Ter3 list1 list2
142
   
143
instance Syn NP where
144
   negation  (TermNP All t)  =  TermNP Some (negation t)  
145
   negation  (TermNP Some t)  =  TermNP All (negation t) 
146
   --negation (TermNP Atleast t) = TermNP More (negation t)
147
   --negation (TermNP More t) = TermNP Atleast (negation t)    
148
   subterms (TermNP All t)  = subterms t
149
   cnsIn Everyone = []
150
   cnsIn Someone = []
151
   cnsIn (TermNP d t) = cnsIn t
152
   verbsIn Everyone = []
153
   verbsIn Someone = []
154
   verbsIn (TermNP d t) =  verbsIn t 
155
   buildTermSub (TermNP d t)  (TermNP e u)    = 
156
      if (d == e) 
157
      then (buildTermSub t u) 
158
      else Nothing
159
   buildPVSub xx yy = Just []   
160
   spellOut (TermNP d t) list1 list2 =  (TermNP d (spellOut t list1 list2)) 
161
   hasNegativeMarker (TermNP All t) =  hasNegativeMarker t
162
   hasNegativeMarker (TermNP Some t) =  hasNegativeMarker t
163
   hasNegativeMarker (TermNP Atleast t) =  hasNegativeMarker t
164
   hasNegativeMarker (TermNP More t) =  hasNegativeMarker t
165
   inARC (TermNP All t) = inARC t
166
   inARC (TermNP Some t) =  Just False
167
   inARC (TermNP Atleast t) =  Just False
168
   inARC (TermNP More t) =  Just False 
169
   inARC x = Nothing
170
   
171
instance Syn Sent where
172
   negation (Sent All t u) = (Sent Some t (negation u)) 
173
   negation (Sent Some t u) = (Sent All t (negation u)) 
174
   negation (Sent Atleast t u) = (Sent More u t)
175
   negation (Sent More t u) = (Sent Atleast u t)  
176
   subterms (Sent d t u) =   (subterms t) ++ (subterms u)   -- I dropped   at the front    [t,u] ++
177
   subterms (Sent2 d t u t2 u2) =   (subterms t) ++ (subterms u) ++ (subterms t2) ++ (subterms u2)   -- I dropped [t,u,t2,u2] ++ 
178
   cnsIn (Sent d t u) = (cnsIn t)  ++  (cnsIn u)    
179
   cnsIn (Sent2 d t u t2 u2) =    (cnsIn t)  ++  (cnsIn u)  ++ (cnsIn t2)  ++  (cnsIn u2)  
180
   verbsIn (Sent d t u) = (verbsIn t)  ++  (verbsIn u)
181
   verbsIn (Sent2 d t u t2 u2) = (verbsIn t)  ++  (verbsIn u) ++(verbsIn t2)  ++  (verbsIn u2)
182
   buildTermSub (Sent d tt uu) (Sent e vv ww) =
183
      if (d == e) then (combineStructures (buildTermSub tt vv)  (buildTermSub uu ww)) else Nothing  
184
   buildTermSub (Sent2 d tt uu tt2 uu2) (Sent2 e vv ww vv2 ww2) =
185
      if (d == e) 
186
      then foldl1 combineStructures [(buildTermSub tt vv),  (buildTermSub uu ww),(buildTermSub tt2 vv2),  (buildTermSub uu2 ww2)]
187
      else Nothing
188
   buildPVSub (Sent d t uu) (Sent e vv ww) =
189
      if (d == e) then (plusStrict (buildPVSub t vv)  (buildPVSub uu ww)) else Nothing  
190
   buildPVSub (Sent2 d tt uu tt2 uu2) (Sent2 e vv ww vv2 ww2)  =
191
      if (d == e) 
192
      then foldl1 plusStrict [(buildPVSub tt vv),  (buildPVSub uu ww),(buildPVSub tt2 vv2),  (buildPVSub uu2 ww2)]
193
      else Nothing
194
   spellOut (Sent d t u)  list1 list2  =  (Sent d (spellOut t list1 list2)  (spellOut u list1 list2)) 
195
   spellOut (Sent2 d t u t2 u2)  list1 list2  =  (Sent2 d (spellOut t list1 list2)  (spellOut u list1 list2) (spellOut t2 list1 list2)  (spellOut u2 list1 list2)) 
196
   hasNegativeMarker (Sent All t u)  =  or [hasNegativeMarker t,  hasNegativeMarker u ]
197
   hasNegativeMarker (Sent Some t u)  =  or [hasNegativeMarker t , hasNegativeMarker u ]
198
   hasNegativeMarker (Sent Atleast t u)  =  or [hasNegativeMarker t, hasNegativeMarker u ]
199
   hasNegativeMarker (Sent More t u)  =  or [hasNegativeMarker t, hasNegativeMarker u ]
200
   inARC (Sent All t u)  =
201
       case (inARC t) of
202
       Just True -> (inARC u)
203
       Just False -> case (inARC u) of
204
                         Nothing -> Nothing
205
                         _ -> Just False
206
       Nothing -> Nothing
207
   inARC (Sent Some t u)  =  Just False
208
   inARC (Sent Atleast t u)  =  Just False
209
   inARC (Sent More t u)  =  Just False
210
   inARC x = Nothing           
211
data Sent = None | Sent Det Term Term | Sent2 Det Term Term Term Term    
212
                   deriving (Ord,Eq) 
213
                   
214
instance Show Sent where
215
         -- show (Sent d t u)  =  show (d)  ++ " " ++ show(t) ++ " " ++ show(u)  
216
          show (Sent  d (TermMaker x y) (TermMaker z w) )  =  show (d)  ++ " who " ++ show((TermMaker x y)) ++ " also " ++ show((TermMaker z w))                   
217
          show (Sent d (TermMaker x y) (CNasTerm pcn) )  =  show (d)  ++ " who " ++ show((TermMaker x y)) ++ " are " ++ show((CNasTerm pcn))  
218
          show (Sent d (CNasTerm pcn)  (TermMaker x y))  =  show (d)  ++ " " ++ show((CNasTerm pcn)) ++ " " ++ show((TermMaker x y)) 
219
          show (Sent d (CNasTerm pcn)  (CNasTerm pcn2))  =  show (d)  ++ " " ++ show((CNasTerm pcn)) ++ " are " ++ show((CNasTerm pcn2)) 
220
          show (Sent2 d x y u v)  =  show (d)  ++ " " ++ show(x) ++ " which are " ++ show(y) ++ " are also " ++  show(u) ++ " which are " ++ show(v) 
221
          
222
principalDet (Sent d t t') = d
223
converse s@(Sent All t u) = (Sent All u t)
224
           
225
data NP   =   Everyone | Someone | TermNP Det Term | IntTermNP Det IntersectionTerm
226
          deriving (Ord,Eq)
227
          
228
instance Show NP where
229
     show (TermNP d t) =  show(d) ++ " " ++ show(t) 
230
     show (IntTermNP d t) =  show(d) ++ " " ++ show(t) 
231

232
data Det  =  All | Some | No | Most | Atleast | More | Contradiction
233
          deriving  (Ord,Eq)
234
  
235
instance Show Det where
236
     show All = "all"
237
     show Some = "some"
238
     show No = "no"
239
     show Most = "most"
240
     show Atleast = "at least"
241
     show More = "more"
242
     show Contradiction = "contradiction"
243
                    
244
  
245
          
246
data CN   =  Girls   
247
                 | Boys 
248
                 | Dogs | Cats | Skunks | Sneetches | Mammals | Chordates | Animals | Birds | X | Y | Z | W | P | Q | N  --Var CNvariable
249
          deriving (Eq,Ord) 
250
          
251
instance Show CN where
252
    show Girls = "girls"
253
    show Boys = "boys"
254
    show Dogs = "dogs"
255
    show Cats = "cats"
256
    show Skunks = "skunks"
257
    show Sneetches = "sneetches"
258
    show Mammals = "mammals"
259
    show Chordates = "chordates"
260
    show Animals = "animals"
261
    show Birds = "birds"
262
    show X = "x"
263
    show Y = "y"
264
    show Z = "z"
265
    show W = "w"
266
    show P = "p"
267
    show Q = "q"  
268
    show N = "n"         
269

270
data Polarity =  Pos | Neg
271
   deriving (Ord, Eq)
272
   
273
instance Show Polarity where
274
   show Pos = ""
275
   show Neg = "non-"      
276

277
data PolCN =  PCN Polarity CN
278
      deriving (Eq,Ord)
279
instance Show PolCN   where
280
    show (PCN a b)  = (show a)++(show b)
281
                       
282
cnvariables = [X, Y, Z, W, P, Q, N]          
283
          
284
data Term =   CNasTerm PolCN
285
                   |  TermMaker PV NP    
286
                   |  Ter1 | Ter2  | Ter3  |  Ter1bar | Ter2bar  | Ter3bar                
287
                       deriving (Ord,Eq)
288
instance Show Term where
289
  show (CNasTerm px) = show px
290
  show (TermMaker t (TermNP d (TermMaker pv np)))  = show(t) ++ " " ++ show(d) ++ " who " ++ show(TermMaker pv np)
291
  --  show (TermMaker t (TermNP d (TermMaker pv np)))  = show(t) ++ " " ++ show(d) ++ " who " ++ show(pv) ++  " " ++ show(np)
292
  show (TermMaker t (TermNP d  (CNasTerm px))) = show(t)  ++ " " ++ show(d) ++  " " ++ show(px)
293
  --show (TermMaker t n) = "(" ++  show(t) ++ " " ++ show(n)++")"  -- this was it!!!
294
  show Ter1 = "Ter1"
295
  show Ter2 = "Ter2"
296
  show Ter3 = "Ter3"
297
  show Ter1bar = "Ter1-bar"
298
  show Ter2bar = "Ter2-bar"
299
  show Ter3bar = "Ter3-bar"  
300
  
301
data PV =  PV Polarity V
302
      deriving (Eq,Ord)
303
instance Show PV   where
304
    show (PV a b)  = (show a)++(show b)  
305

306
data V   = Loves   | Admires | Helps | Sees | Hates | R | S
307
          deriving (Eq,Ord) 
308
          
309
instance Show V where
310
    show Loves = "love"
311
    show Admires = "admire"
312
    show Helps = "help"
313
    show Sees = "see"
314
    show Hates = "hate"
315
    show R = "r"
316
    show S = "s"
317

318
r = PV Pos R
319
x = PCN Pos X
320
y = PCN Pos Y
321
z = PCN Pos Z
322
p = PCN Pos P
323
q = PCN Pos Q
324
n = PCN Pos N
325
w = PCN Pos W
326
non_x = PCN Neg X
327
non_y = PCN Neg Y
328
non_z = PCN Neg Z
329
non_w = PCN Neg W
330
non_p = PCN Neg P
331
non_q = PCN Neg Q
332
non_n = PCN Neg N
333
skunks = PCN Pos Skunks
334
mammals = PCN Pos Mammals
335
animals = PCN Pos Animals
336
sneetches = PCN Pos Sneetches
337
dogs = PCN Pos Dogs
338
birds = PCN Pos Birds
339
chordates = PCN Pos Chordates
340
boys = PCN Pos Boys
341
girls = PCN Pos Girls
342
cats = PCN Pos Cats
343
non_skunks = PCN Neg Skunks
344
non_mammals = PCN Neg Mammals
345
non_animals = PCN Neg Animals
346
non_sneetches = PCN Neg Sneetches
347
non_dogs = PCN Neg Dogs
348
non_birds = PCN Neg Birds
349
non_chordates = PCN Neg Chordates
350
non_boys = PCN Neg Boys
351
non_girls = PCN Neg Girls
352
non_cats = PCN Neg Cats
353
loves = PV Pos Loves
354
admires = PV Pos Admires
355
helps = PV Pos Helps
356
sees = PV Pos Sees
357
hates = PV Pos Hates
358
not_loves = PV Neg Loves
359
not_admires = PV Neg Admires
360
not_helps = PV Neg Helps
361
not_sees = PV Neg Sees
362
not_hates = PV Neg Hates
363

364

365
data IntersectionTerm =   IntersectionTerm PolCN Term  
366
                   |  IntTer1 | IntTer2  | IntTer3  |  IntTer1bar | IntTer2bar  | IntTer3bar                
367
                       deriving (Ord,Eq)
368
instance Show IntersectionTerm where
369
  show (IntersectionTerm p t) = show(p)  ++ " who " ++ show(t)
370
  show IntTer1 = "IntTer1"
371
  show IntTer2 = "IntTer2"
372
  show IntTer3 = "IntTer3"
373
  show IntTer1bar = "IntTer1-bar"
374
  show IntTer2bar = "IntTer2-bar"
375
  show IntTer3bar = "IntTer3-bar"  
376

377

378