1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
|
----------------------------------------------------------------------
-- |
-- Module : TreeSelections
-- Maintainer : AR
-- Stability : (stable)
-- Portability : (portable)
--
-- choose shallowest trees, and remove an overload resolution prefix
-----------------------------------------------------------------------------
module GF.UseGrammar.TreeSelections (
getOverloadResults, smallestTrs, sizeTr, depthTr
) where
import GF.Grammar.Abstract
import GF.Grammar.Macros
import GF.Data.Operations
import GF.Data.Zipper
import Data.List
-- AR 2/7/2007
-- The top-level function takes a set of trees (typically parses)
-- and returns the list of those trees that have the minimum size.
-- In addition, the overload prefix "ovrld123_", is removed
-- from each constructor in which it appears. This is used for
-- showing the library API constructors in a parsable grammar.
-- TODO: access the generic functions smallestTrs, sizeTr, depthTr from shell
getOverloadResults :: [Tree] -> [Tree]
getOverloadResults = smallestTrs sizeTr . map (mkOverload "ovrld")
-- NB: this does not always give the desired result, since
-- some genuine alternatives may be deeper: now we will exclude the
-- latter of
--
-- mkCl this_NP love_V2 (mkNP that_NP here_Adv)
-- mkCl this_NP (mkVP (mkVP love_V2 that_NP) here_Adv)
--
-- A perfect method would know the definitional equivalences of constructors.
--
-- Notice also that size is a better measure than depth, because:
-- 1. Global depth does not exclude the latter of
--
-- mkCl (mkNP he_Pron) love_V2 that_NP
-- mkCl (mkNP he_Pron) (mkVP love_V2 that_NP)
--
-- 2. Length is needed to exclude the latter of
--
-- mkS (mkCl (mkNP he_Pron) love_V2 that_NP)
-- mkS presentTense (mkCl (mkNP he_Pron) love_V2 that_NP)
--
smallestTrs :: (Tr a -> Int) -> [Tr a] -> [Tr a]
smallestTrs size ts = map fst $ filter ((==mx) . snd) tds where
tds = [(t, size t) | t <- ts]
mx = minimum $ map snd tds
depthTr :: Tr a -> Int
depthTr (Tr (_, ts)) = case ts of
[] -> 1
_ -> 1 + (maximum $ map depthTr ts)
sizeTr :: Tr a -> Int
sizeTr (Tr (_, ts)) = 1 + sum (map sizeTr ts)
-- remove from each constant a prefix starting with "pref", up to first "_"
-- example format: ovrld123_mkNP
mkOverload :: String -> Tree -> Tree
mkOverload pref = mapTr (changeAtom overAtom) where
overAtom a = case a of
AtC (m, IC f) | isPrefixOf pref f ->
AtC (m, IC (tail (dropWhile (/='_') f)))
_ -> a
|
