2011-09-01T00:00:00+02:00
2011-09-02T10:49:46.0687511+02:00
<TEI>
{
for $search in //eTree[tb:HasLabel(@Label, $_matrixIP)]
(: Only take into account clauses with a licit subject :)
let $sbjAll := tb:SomeChildNo($search, $_subject, $_nosubject)
(: Exclude starred elements and take the first one remaining :)
let $sbj := $sbjAll[not(child::eLeaf/@Type = 'Star')][1]
(: Get the finite verb :)
let $Vfin := ru:one($search, 'FirstChild', $_finiteverb)
(: Get the first constituent, skipping over stuff we don't need :)
let $first := $search/child::eTree[not(tb:Like(@Label, $_ignore_nodes_conj))][1]
(: See if this first constituent is a PP or not :)
let $pp := $first[tb:Like(@Label, $_anypp)]
(: Prepare a message to be shown in the output :)
let $msg := concat('First PP = [', tb:Syntax($pp), ']')
(: Stipulate our limitations here :)
where (
exists($Vfin) and
exists($sbj) and
exists($pp)
)
(: Output providing a message in $msg :)
return tb:MyForestMsg($search, $msg)
}
</TEI>
<TEI>
{
for $search in //eTree[tb:HasLabel(@Label, $_matrixIP)]
(: Only take into account clauses with a licit subject :)
let $sbjAll := tb:SomeChildNo($search, $_subject, $_nosubject)
(: Exclude starred elements and take the first one remaining :)
let $sbj := $sbjAll[not(child::eLeaf/@Type = 'Star')][1]
(: Get the finite verb :)
let $Vfin := ru:one($search, 'FirstChild', $_finiteverb)
(: Get the first constituent, skipping over stuff we don't need :)
let $first := $search/child::eTree[not(tb:Like(@Label, $_ignore_nodes_conj))][1]
(: See if this first constituent is a PP or not :)
let $pp := $first[tb:Like(@Label, $_anypp)]
(: Get the NP within the PP, if it exists :)
let $np := tb:SomeChild($pp, $_anynp)
(: Prepare subcategorisation on NPtype :)
let $cat := tb:Feature($np, 'NPtype')
(: Prepare a message to be shown in the output :)
let $msg := concat('First PP with NP = [', tb:Syntax($pp), ']')
(: Stipulate our limitations here :)
where (
exists($Vfin) and
exists($sbj) and
exists($pp) and
exists($np)
)
(: Output providing a message in $msg :)
return tb:MyForestCatMsg($search, $cat, $msg)
}
</TEI>
declare namespace functx = "http://www.functx.com";
declare namespace tb = "http://www.let.ru.nl/e.komen/corpusstudio/treebank";
(: ---------------------------------------------------------------------------
Definitions of different IP/CP categories
--------------------------------------------------------------------------- :)
declare variable $_finiteIP as xs:string := "IP-MAT*|IP-SUB*";
declare variable $_matrixIP as xs:string := "IP-MAT*";
declare variable $_subIP as xs:string := "IP-SUB*";
declare variable $_anyCP as xs:string := "CP|CP-*";
declare variable $_anyCLF as xs:string := "CP-CLF*";
declare variable $_anyCLFx as xs:string := "CP-THT-x";
declare variable $_cleftCP as xs:string := "CP|CP-CLF*";
declare variable $_frlCP as xs:string := "CP-FRL*";
declare variable $_thatCP as xs:string := "CP-THT*";
declare variable $_anyClause as xs:string := "IP-*|CP-*";
declare variable $_anyLFD as xs:string := "*LFD*";
declare variable $_anyXP as xs:string := "*P*";
declare variable $_anyIP as xs:string := "IP|IP-*";
declare variable $_neg as xs:string := "NEG";
declare variable $_wh as xs:string := "WADV*|*QUE*";
declare variable $_advp as xs:string := "ADVP*";
declare variable $_advptime as xs:string := "ADV*-TMP";
declare variable $_anyadv as xs:string := "ADV|ADV-*|ADV+*|ADV^*|ADV#*";
declare variable $_anyadvadj as xs:string:= "ADV*|ADJ*";
declare variable $_conj as xs:string := "CONJ|CONJP*";
(: ---------------------------------------------------------------------------
Definitions of referential categories
--------------------------------------------------------------------------- :)
declare variable $_IsRefer as xs:string := "Identity|Inferred|CrossSpeech";
declare variable $_IsAnyRefer as xs:string := "Identity|Inferred|CrossSpeech|Assumed";
declare variable $_NoRefer as xs:string := "New|NewVar|Inert";
declare variable $_World as xs:string := "Assumed";
(: ---------------------------------------------------------------------------
Definitions of focus-like categories
--------------------------------------------------------------------------- :)
declare variable $_IsFP as xs:string := "FP*";
declare variable $_IsFocAdv as xs:string := "ADV|ADV-*|ADV^*";
declare variable $_FocOrAdv as xs:string := "FP|FP-*|ADV|ADV-*|ADV^*";
declare variable $_LocAdv as xs:string := "e*s[td]*n|nor*[td]*n|wes*[dt]*n|su*[dt]*n";
(: ---------------------------------------------------------------------------
Definitions of verbal categories
--------------------------------------------------------------------------- :)
declare variable $_anyverb as xs:string := "VB*|BE*|HV*|AX*|MD*|DO*|*+VB*|*+BE*|*+HV*|*+AX*|*+MD*|*+DO*";
declare variable $_finiteaux as xs:string := "BEI|BEP*|BED*|UTP|*HVI|*HVP*|*HVD*|*AXI|*AXP*|*AXD*|*MD|*DOI|*DOP*|*DOD*|NEG+BEI|NEG+BEP*|NEG+BED*|NEG+AXI|NEG+*AXP*|NEG+*AXD*|NEG+*MD";
declare variable $_nonfiniteverb as xs:string := "*BE|*BAG*|*BEN*|*HV|*HVG*|*HVN*|*AX|*AXG*|*AXN*|*VB|*VAG*|*VAN*|VBN*|VBG*|HAN*|HAG*";
declare variable $_unonfiniteverb as xs:string := "BE|BAG*|BEN*|U-BE|U-BAG*|U-BEN*|U-VB|U-VAG*|U-VAN*|U-VBN*|U-VBG*";
declare variable $_NoImvFinVb as xs:string := "BEP*|BED*|UTP|*HVP*|*HVD*|*AXP*|*AXD*|*MD|*VBP*|*VBD*|*DOP*|*DOD*|NEG+BEP*|NEG+BED*|NEG+*AXP*|NEG+*AXD*|NEG+*MD|NEG+*VBP*|NEG+*VBD";
declare variable $_finiteverb as xs:string := "BEI|BEP*|BED*|UTP|*HVI|*HVP*|*HVD*|*AXI|*AXP*|*AXD*|*MD|VBI|*VBP*|*VBD*|*DOI|*DOP*|*DOD*|NEG+BEI|NEG+BEP*|NEG+BED*|NEG+AXI|NEG+*AXP*|NEG+*AXD*|NEG+*MD|NEG+VBI|NEG+*VBP*|NEG+*VBD";
declare variable $_finitenegverb as xs:string := "NEG+BEI|NEG+BEP*|NEG+BED*|NEG+AXI|NEG+*AXP*|NEG+*AXD*|NEG+*MD|NEG+VBI|NEG+*VBP*|NEG+*VBD";
declare variable $_ufiniteverb as xs:string := "BEI|BEP*|BED*|U-BEI|U-BEP*|U-BED*|U-VBI*|U-VBP*|U-VBD*|NEG+BEI|NEG+BEP*|NEG+BED*";
declare variable $_accfiniteverb as xs:string := "UTP|*HVI|*HVP*|*HVD*|*AXI|*AXP*|*AXD*|*MD|VBI|*VBP*|*VBD*|*DOI|*DOP*|*DOD*|NEG+AXI|NEG+*AXP*|NEG+*AXD*|NEG+*MD|NEG+VBI|NEG+*VBP*|NEG+*VBD";
declare variable $_unaccfiniteverb as xs:string := "BEI|BEP*|BED*|NEG+BEI|NEG+BEP*|NEG+BED*";
declare variable $_finite_BE as xs:string := "BEP*|BED*|NEG+BEP*|NEG+BED*";
declare variable $_any_BE as xs:string := "BE*";
declare variable $_progressive as xs:string := "*ing*|*yng*";
(: ---------------------------------------------------------------------------
Definitions of different AP categories
--------------------------------------------------------------------------- :)
declare variable $_anypp as xs:string := "PP|PP-*";
declare variable $_anynporpp as xs:string := "PP|PP-*|NP|NP-*";
declare variable $_discardnp as xs:string := "NP*PRN*|NP*RFL*|NP*VOC*|NP*MSR*|NP*ADV*|NP*PRD*";
declare variable $_discardObj as xs:string := "NP*PRN*|NP*RFL*|NP*VOC*|NP*MSR*|NP*ADV*|NP*PRD*|NP*LFD*";
declare variable $_someap as xs:string := "ADVP-*|ADJP*";
declare variable $_timeap as xs:string := "ADVP-TMP*";
declare variable $_timeNPorPP as xs:string := "PP-*TMP|PP-*TMP-*|NP-*TMP|NP-*TMP-*";
declare variable $_timeNP as xs:string := "NP*TMP*";
declare variable $_then_word as xs:string := "then|+ten|+ta|+tonne|than";
declare variable $_anyth as xs:string := "th*|Th*|+t*|+T*|+d*|+D*|forth*|forTh*|for+t*|for+T*|for+d*|for+D*";
declare variable $_anyfalseth as xs:string := "forth|forthw*|for+d|for+der";
declare variable $_then_there as xs:string := "[Tt]h*n|[Tt]h*ne|+[Tt]a|[Tt]h*r|[Tt]h*re|+[tT]*r|+[tT]*re";
declare variable $_when_word as xs:string := "[Ww]hen|[Ww]han|*[Hh]wen|*[Hh]wenne";
declare variable $_anyAdjunct as xs:string := "ADVP*|PP|PP-*";
(: ---------------------------------------------------------------------------
Definitions of different NP categories
--------------------------------------------------------------------------- :)
(: OLD: declare variable $_subjectoe as xs:string := "NP-NOM|NP-NOM-#|NP-NOM-RSP"; :)
declare variable $_subjectoe as xs:string := "NP-NOM|NP-NOM-*";
declare variable $_subject as xs:string := concat($_subjectoe,"|NP-SBJ*");
declare variable $_badsubject as xs:string := "EX";
declare variable $_nosubject as xs:string := "*PRD*|*LFD*|*VOC*|*MSR*";
declare variable $_noobject as xs:string := "*PRD*|*VOC*|*MSR*|*ADV*";
declare variable $_timenp as xs:string := "NP*TMP";
declare variable $_anynp as xs:string := "NP|NP-*";
declare variable $_leftdisnp as xs:string := "NP-*LFD*";
declare variable $_resumpnp as xs:string := "NP-*RSP*";
declare variable $_proper as xs:string := "NPR|NPR^*|NPRS|NPRS^*";
declare variable $_anyNpLfd as xs:string := "NP*LFD*";
declare variable $_anyNpRsp as xs:string := "NP*RSP*";
(: ---------------------------------------------------------------------------
The following definition of an object NP excludes e.g. NP-DAT-TMP, NP-GEN-TMP from the list
--------------------------------------------------------------------------- :)
declare variable $_objNP as xs:string :=
"NP-OB*|NP-DAT|NP-DAT-[A-SU-Z]*|NP-GEN|NP-GEN-[A-SU-Z]*|NP-ACC|NP-ACC-[A-SU-Z]*";
declare variable $_object as xs:string := concat($_objNP, '|', $_subject, '|', $_timenp);
declare variable $_argNP as xs:string := concat($_objNP, '|', $_subject);
declare variable $_objectnotime as xs:string := concat($_objNP, '|', $_subject);
declare variable $_objectorpp as xs:string := concat($_object, $_anypp);
declare variable $_objNPorPP as xs:string := concat($_objNP, '|', $_anypp);
(: ---------------------------------------------------------------------------
Definitions of contents of NPs
--------------------------------------------------------------------------- :)
declare variable $_noun as xs:string := "N-*|NR*|FW|*Q*|D*";
declare variable $_dem as xs:string := "D|D-*|D^*|DPRO*";
declare variable $_pronoun as xs:string := "PRO^N|PRO^A|PRO^G|PRO^D|PRO|DPRO^N|DPRO^A|DPRO^G|DPRO^D|PRO$";
declare variable $_nonpronominal as xs:string := "D*|ADJ*|N*|*Q*|NUM*|FP|FW|CP*|PTP*|V*|RP+V*|CONJ*";
(: --------------------------------------------
// pronoun_2p_ME=+ge|+gee|+geu|+gew||gho|+gie;
// pronoun_2s_ME=+de|+die|+du;
// pronoun_3s_ME=+git|+gitt;
// pronoun_2c_ME=+gou|+goug|+gow;
-------------------------------------------- :)
(: ---------------------------------------------------------------------------
Third person singular, masculine
N.B: [him] can be both 3p as well as OE 3ms
--------------------------------------------------------------------------- :)
declare variable $_pronoun_3ms as xs:string := "ha|ham|he|hee|hy\~|hym|hyne|hine|him|ham-seolf|ham-seolfen|ham-seolue|ham-seoluen|him-seolf|him-seoluen|hymself|hymselfe";
(: ---------------------------------------------------------------------------
Third person singular, feminine
--------------------------------------------------------------------------- :)
declare variable $_pronoun_3fs as xs:string := "heo|hir|sche|she|her|hi|hie|hire|hig|hio|hiere|hyre|hier-seolf|hier-seoluen";
(: ---------------------------------------------------------------------------
Third person singular, neuter
--------------------------------------------------------------------------- :)
declare variable $_pronoun_3ns as xs:string := "[Yy]t|[Yy]=t=|[Yy]tt|[Ii]t|$[Ii]t|[Ii]d|[Ii]tt|'[tT]|$'[tT]|[Hh]it|[Hh]yt|[Hh]ytt|[Hh]vt";
(: ---------------------------------------------------------------------------
Third person $plural
N.B: [him] can be both 3p as well as OE 3ms
--------------------------------------------------------------------------- :)
declare variable $_pronoun_3p as xs:string := "hem|tey|+tei|thei|them|they|+tey|+tey+g|+theym|heom|him|themselfe|hemself";
(: ---------------------------------------------------------------------------
Combine all different 3rd person pronouns into one category
--------------------------------------------------------------------------- :)
declare variable $_pronoun_3 as xs:string :=
concat($_pronoun_3ms, '|',$_pronoun_3fs, '|', $_pronoun_3ns, '|', $_pronoun_3p);
(: ---------------------------------------------------------------------------
Define pronouns that are very unlikely to be referential: it, hit
--------------------------------------------------------------------------- :)
declare variable $_pronoun_it as xs:string := "[Yy]t|[Yy]=t=|[Yy]tt|[Ii]t|$[Ii]t|[Ii]d|[Ii]tt|'[tT]|$'[tT]|[Hh]it|[Hh]yt|[Hh]ytt|[Hh]vt";
declare variable $_pronoun_that as xs:string := "that|tht|+tat|+tt|$that";
declare variable $_dem_that as xs:string := "[Tt]h*t|+[TtDd]*t|$[Tt]h*t";
declare variable $_dem_dist as xs:string := "[Tt]h*t|+[TtDd]*t|$[Tt]h*t|[tdTD]hos*|[$+][tdTD]os*";
declare variable $_dem_near as xs:string := "[tdTD]*s*|[$+][tdTD]*s*";
declare variable $_dem_any as xs:string := concat($_dem_that, '|', $_dem_near);
declare variable $_dem_word as xs:string := "*[TDtd]*[tds]*";
(: ---------------------------------------------------------------------------
Definitions of conjunction types
--------------------------------------------------------------------------- :)
declare variable $_contrast as xs:string := "but|ac";
(: ---------------------------------------------------------------------------
Definitions of other lexical types
--------------------------------------------------------------------------- :)
declare variable $_because as xs:string := "[Bb]ecause";
declare variable $_why as xs:string := "[Ww]hy";
declare variable $_therefore as xs:string := "[Tt]*r*f*r*";
(: ---------------------------------------------------------------------------
Default values for ignore_nodes and ignore_words
--------------------------------------------------------------------------- :)
declare variable $_ignore_nodes as xs:string := "COMMENT|CODE|ID|LB|'|""|,|E_S|.|/|RMV:*";
declare variable $_ignore_nodes_conj as xs:string := concat($_ignore_nodes, "|CONJ*");
declare variable $_ignore_words as xs:string := "COMMENT|CODE|ID|LB|'|""|,|E_S|.|/|RMV:*|0|\**";
(: ---------------------------------------------------------------------------
Chechen definitions
--------------------------------------------------------------------------- :)
declare variable $_RcAuxNom as xs:string := "[vjbd]olu";
declare variable $_RcAuxObl as xs:string := "[vjbd]olchu";
declare variable $_EndPunct as xs:string := ".|;|!|[?]";
declare variable $_AuxRcNom as xs:string := "* [vjbd]olu[.;!]*";
(: ----------------------------------------------------------------
Name : tb:split
Goal : split one string into an array (=list) of strings
The dividing character is the |
Note : inspired by functx:lines on http://www.xqueryfunctions.com/xq/functx_lines.html
History:
15-02-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:split($arg as xs:string?) as xs:string*
{ tokenize($arg, "\|")
} ;
(: ----------------------------------------------------------------
Name : tb:MainLabel
Goal : Derive the main part of a label
History:
23-12-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:MainLabel($arg as xs:string?) as xs:string?
{
(: return the RU function's result :)
ru:MainLabel(string($arg))
};
(: ----------------------------------------------------------------
Name : tb:copy-attributes
Goal : Copy the attributes from one node to another
Note : inspired by functx:copy-attributes on
http://www.xqueryfunctions.com/xq/functx_copy-attributes.html
History:
26-05-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:copy-attributes($copyTo as element(), $copyFrom as element() ) as element()
{ element { node-name($copyTo)}
{ $copyTo/@*[not(node-name(.) = $copyFrom/@*/node-name(.))],
$copyFrom/@*, $copyTo/node() }
};
(: ----------------------------------------------------------------
Name : tb:MyForest
Goal : The standard <forest...> return values for a function
History:
26-05-2010 ERK Created
18-10-2010 ERK Added the "TreeId" attribute
---------------------------------------------------------------- :)
declare function tb:MyForest($ndThis as element()?) as element()
{
(: Fix the [$src] <forest> element of which we are part :)
let $src := $ndThis/ancestor-or-self::forest
(:
let $id := $ndThis/@Id
:)
(: ====== DEBUG =========== :)
let $id := if (tb:Like($src/@Location, ".130")) then
ru:Message("MyForest doing fine at .130")
else
$ndThis/@Id
(: Copy the attributes to a new forest element :)
return element forest {
attribute TreeId {$id},
$src/@*,
$src/node()
}
};
(: ----------------------------------------------------------------
Name : tb:MyForestMsg
Goal : The standard <forest...> return values for a function
History:
18-10-2010 ERK Derived from tb:MyForest
---------------------------------------------------------------- :)
declare function tb:MyForestMsg($ndThis as element()?, $strMsg as xs:string?) as element()
{
(: Fix the [$src] <forest> element of which we are part :)
let $src := $ndThis/ancestor::forest
let $id := $ndThis/@Id
(: Copy the attributes to a new forest element :)
return element forest {
attribute TreeId {$id},
attribute Msg {$strMsg},
$src/@*,
$src/node()
}
};
(: ----------------------------------------------------------------
Name : tb:MyForestCat
Goal : The standard <forest...> return values for a function
But now supplemented with subordering categories
History:
30-11-2010 ERK Derived from tb:MyForestMsg
---------------------------------------------------------------- :)
declare function tb:MyForestCat($ndThis as element()?, $strCat as xs:string?) as element()
{
(: Fix the [$src] <forest> element of which we are part :)
let $src := $ndThis/ancestor::forest
let $id := $ndThis/@Id
(: Copy the attributes to a new forest element :)
return element forest {
attribute TreeId {$id},
attribute Cat {$strCat},
$src/@*,
$src/node()
}
};
(: ----------------------------------------------------------------
Name : tb:MyForestCatMsg
Goal : The standard <forest...> return values for a function
But now supplemented with subordering categories
And also containing a message
History:
03-12-2010 ERK Derived from tb:MyForestCat and tb:MyForestCatMsg
---------------------------------------------------------------- :)
declare function tb:MyForestCatMsg($ndThis as element()?, $strCat as xs:string?, $strMsg as xs:string?) as element()
{
(: Fix the [$src] <forest> element of which we are part :)
let $src := $ndThis/ancestor::forest
let $id := $ndThis/@Id
(: Copy the attributes to a new forest element :)
return element forest {
attribute TreeId {$id},
attribute Cat {$strCat},
attribute Msg {$strMsg},
$src/@*,
$src/node()
}
};
(: ----------------------------------------------------------------
Name : tb:HasLabel
Goal : Is the given string a label fulfilling the criteria in the list?
History:
15-02-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:HasLabel($strIn as xs:string?, $strLabel as xs:string?) as xs:boolean
{
ru:DoLike($strIn, $strLabel)
};
(: ----------------------------------------------------------------
Name : tb:Like
Goal : Is the given string a label fulfilling the criteria in the list?
History:
15-02-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:Like($strIn as xs:string?, $strLabel as xs:string?) as xs:boolean
{
(: Handle empty strings :)
if (empty($strIn)) then
false()
else
ru:DoLike($strIn, $strLabel)
};
(: ----------------------------------------------------------------
Name : tb:Location
Goal : Get a description of the location of this node within an IP
Note : [strLocType] can have the following values:
detailed - all constituents are named
selected - only a subsection are named
finverb - finite verb and myself are named, rest "x"
History:
03-12-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:Location($ndThis as node()?, $strLocType as xs:string?) as xs:string
{
ru:Location($ndThis, $strLocType)
};
(: ----------------------------------------------------------------
Name : tb:Label
Goal : Does the [$node] have a label fulfilling the criteria in the list?
History:
11-09-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:Label($this as node()?, $strLabel as xs:string?) as xs:boolean
{
(: First check the existence of the node :)
if (exists($this)) then
(: tb:string-test($this/@Label, tb:split($strLabel)) :)
ru:DoLike($this/@Label, $strLabel)
else
false()
};
(: ----------------------------------------------------------------
Name : tb:Contains
Goal : Check whether the given node [$this] contains a child node
with a label as in [$node].
This child node should contain an eLeaf
with vernacular text [$leaf]
History:
16-02-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:Contains($this as node(), $node as xs:string?, $leaf as xs:string?) as xs:boolean
{
some $child in $this/eTree satisfies
( tb:Like($child/@Label, $node)
and tb:Like($child/eLeaf/@Text, $leaf)
)
};
(: ----------------------------------------------------------------
Name : tb:ChildLabel
Goal : Check whether the given node [$this] contains a child node
with a label as in [$cat].
History:
17-02-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:ChildLabel($this as node()?, $cat as xs:string?) as xs:boolean
{
some $ch in $this/child::eTree satisfies
tb:Like($ch/@Label, $cat)
};
(: ----------------------------------------------------------------
Name : tb:HasChild
Goal : Check whether the given node [$this] contains a child node
with a label as in [$cat].
History:
17-02-2010 ERK Created
12-03-2020 ERK Copied from tb:ChildLabel, but renamed
---------------------------------------------------------------- :)
declare function tb:HasChild($this as node()?, $cat as xs:string?) as xs:boolean
{
some $ch in $this/child::eTree satisfies
tb:Like($ch/@Label, $cat)
};
(: ----------------------------------------------------------------
Name : tb:HasDescendant
Goal : Check whether the given node [$this] contains a descendant node
with a label as in [$cat].
History:
20-07-2020 ERK Derived from tb:HasChild
---------------------------------------------------------------- :)
declare function tb:HasDescendant($this as node()?, $cat as xs:string?) as xs:boolean
{
some $ch in $this/descendant::eTree satisfies
tb:Like($ch/@Label, $cat)
};
(: ----------------------------------------------------------------
Name : tb:HasDescOrSelf
Goal : Check whether the given node [$this] contains a descendant node
with a label as in [$cat].
History:
20-07-2020 ERK Derived from tb:HasChild
---------------------------------------------------------------- :)
declare function tb:HasDescOrSelf($this as node()?, $cat as xs:string?) as xs:boolean
{
some $ch in $this/descendant-or-self::eTree satisfies
tb:Like($ch/@Label, $cat)
};
(: ----------------------------------------------------------------
Name : tb:HasOnlyChild
Goal : Check whether the given node [$this] contains a child node
with a label as in [$cat].
This should be the "only" child, excluding those that
don't count, such as CODE etc ($ignore_node)
History:
17-02-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:HasOnlyChild($this as node(), $cat as xs:string?, $skip as xs:string?) as xs:boolean
{
(: Get ALL the children of this node :)
let $all := $this/child::eTree
(: Select those that do NOT have a label that should be skipped :)
let $ok := $all[not(tb:Like(self::eTree/@Label, $skip))]
(: Check the number of children :)
return
if (fn:count($ok)=1)
then tb:Like($ok/@Label, $cat)
else false()
};
(: ----------------------------------------------------------------
Name : tb:HasFeature
Goal : Check whether the given node [$this] contains a feature [$f]
And this feature has the value [$value]
History:
10-09-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:HasFeature($this as node(), $f as xs:string?, $val as xs:string?) as xs:boolean
{
(: Get ALL the feature structure nodes :)
let $all := $this/child::fs/child::f[@name = $f]
(: Get the feature of the correct type :)
let $ok := $all[@value = $val]
(: Check the number of children :)
return
if (fn:count($ok)>0)
then true()
else false()
};
(: ----------------------------------------------------------------
Name : tb:Feature
Goal : Get feature [$f] of node [$this]
History:
02-11-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:Feature($this as node()?, $f as xs:string?) as xs:string
{
(: Get ALL the feature structure nodes :)
let $all := $this/child::fs/child::f[@name = $f]
let $myfs := $this/child::fs[1]
let $myf := $myfs/child::f[1]
(: ============ DEBUGGING ===========
let $tr := if ( (tb:Like($this/@Label, $_FocOrAdv)) and (exists($myf)))
then ru:Message(concat('Feature/this=', $this/@Label, ' id=', $this/@Id,
' fs=', $myfs/@type, ' f=', $myf/@name))
else true()
================================== :)
(: Return the value, if it exists :)
return
if (exists($all)) then
$all/@value
else
''
};
(: ----------------------------------------------------------------
Name : tb:HasFP
Goal : Determine if this is a PP or NP having a focus particle
History:
07-12-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:HasFP($this as node()?, $strFocus as xs:string?) as xs:boolean
{
(: Check if this is empty :)
if (exists($this)) then
(: Check if this is a PP or NP :)
if (tb:Like($this/@Label, 'PP*|NP*|IP*')) then
(: Return the existence of an FP child :)
exists($this/child::eTree[tb:Like(@Label, $strFocus)])
else
false()
else
false()
};
(: ----------------------------------------------------------------
Name : tb:HasAdvType
Goal : Determine if this is a PP or NP having the indicated adverb type
History:
07-12-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:HasAdvType($this as node()?, $strType as xs:string?) as xs:boolean
{
(: Check if this is empty :)
if (exists($this)) then
(: Try to get the ADV or FP node :)
let $adv := if (tb:Like($this/@Label, 'PP*|NP*|IP*'))
then $this/child::eTree[tb:Like(@Label, $_FocOrAdv)]
else if (tb:Like($this/@Label, $_FocOrAdv)) then $this
else ()
(: ==================
let $tr := if (tb:HasFeature($adv[1], 'AdvType', $strType))
then ru:Message(concat('HasAdvType/Adverb=', tb:Labelled($adv[1]),
' Label=', $adv[1]/@Label,
' Feature=', tb:Feature($adv[1],'AdvType'),
' Type=', $strType ))
else true()
let $tr := ru:Message(concat('HasAdvType/Adverb=', tb:Labelled($adv[1]),
' Label=', $adv[1]/@Label,
' Feature=', tb:Feature($adv[1],'AdvType'),
' Type=', $strType ))
================== :)
(: Return depends on the type of the adverb :)
return
if (exists($adv[1]))
then tb:HasFeature($adv[1], 'AdvType', $strType)
else false()
else
false()
};
(: ----------------------------------------------------------------
Name : tb:AdvType
Goal : Retrieve the adverb type of the PP or NP
History:
21-06-2011 ERK Created
---------------------------------------------------------------- :)
declare function tb:AdvType($this as node()?) as xs:string
{
(: Check if this is empty :)
if (exists($this)) then
(: Try to get the ADV or FP node :)
let $adv := if (tb:Like($this/@Label, 'PP*|NP*|IP*'))
then $this/child::eTree[tb:Like(@Label, $_FocOrAdv)]
else if (tb:Like($this/@Label, $_FocOrAdv)) then $this
else ()
(: Return depends on the type of the adverb :)
return
if (exists($adv[1]))
then tb:Feature($adv[1], 'AdvType')
else 'none'
else
'none'
};
(: ----------------------------------------------------------------
Name : tb:GetAdvType
Goal : Get the first constituent that has an adverb of [$strType]
History:
07-12-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:GetAdvType($this as node()*, $strType as xs:string?) as node()?
{
(: Visit all the constituents :)
let $fp :=
for $ch in $this
where (tb:HasAdvType($ch, $strType))
return $ch
(: Return the first constituent :)
return $fp[1]
};
(: ----------------------------------------------------------------
Name : tb:GetFP
Goal : Get the first constituent that has a focus particle
History:
07-12-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:GetFP($this as node()*, $strFocus as xs:string?) as node()?
{
(: Visit all the constituents :)
let $fp :=
for $ch in $this
where (tb:HasFP($ch, $strFocus))
return $ch
(: Return the first constituent :)
return $fp[1]
};
(: ----------------------------------------------------------------
Name : tb:GetFPno
Goal : Get the first constituent that has a focus particle
Exclude those with [$strNo] leafs
History:
07-12-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:GetFPno($this as node()*, $strFocus as xs:string?, $strNo as xs:string?) as node()?
{
(: Visit all the constituents :)
let $fp :=
for $ch in $this
where (tb:HasFP($ch, $strFocus) and not(tb:HasLeaf($ch, $strNo)) )
return $ch
(: Return the first constituent :)
return $fp[1]
};
(: ----------------------------------------------------------------
Name : tb:FinVerbLoc
Goal : Determine the position of [$this] with respect to the finite verb
History:
03-12-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:FinVerbLoc($this as node()?) as xs:string
{
(: Get the first child of my parent :)
let $all := $this/parent::eTree/child::eTree[not(tb:Like(@Label, $_ignore_nodes_conj))]
(: Get all the following nodes :)
let $foll := $this/following-sibling::eTree[tb:Like(@Label, $_finiteverb)]
(: Get all the preceding nodes :)
let $prec := $this/preceding-sibling::eTree[tb:Like(@Label, $_finiteverb)]
(: Return value depends on where the finite verb is :)
return
if ($all[1]/@Id = $this/@Id) then
(: We are clause-initial :)
'1.Initial'
else if (exists($foll)) then
(: the finite verb follows me :)
'2.PreVf'
else if ($all[last()]/@Id = $this/@Id) then
(: This is clause-final :)
'4.Final'
else if (exists($prec)) then
(: the finite verb precedes me :)
'3.PostVf'
else
(: No finite verb found :)
'5.NoVf'
};
(: ----------------------------------------------------------------
Name : tb:Following
Goal : Return all following-siblings if exists, otherwise empty
History:
23-02-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:Following($this as node(), $skip as xs:string?) as node()*
{ (: Get ALL the following siblings :)
let $all := $this/following-sibling::eTree
(: Select those that do NOT have a label that should be skipped :)
let $ok := $all[not(tb:Like(self::eTree/@Label, $skip))]
(: Select those that are not empty :)
let $nstar := $ok[not(child::eLeaf/@Type = 'Star')]
return
if (empty($nstar))
then ()
else $nstar
} ;
(: ----------------------------------------------------------------
Name : tb:FollWithLabel
Goal : Return all following-siblings with the specified if exists, otherwise empty
History:
06-03-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:FollWithLabel($this as node(), $strLabel as xs:string?) as node()*
{ (: Get ALL the following siblings :)
let $all := $this/following-sibling::eTree
(: Select those that do have the correct label :)
let $ok := $all[tb:Like(self::eTree/@Label, $strLabel)]
(: Select those that are not empty :)
let $nstar := $ok[not(child::eLeaf/@Type = 'Star')]
return
if (empty($nstar))
then ()
else $nstar
} ;
(: ----------------------------------------------------------------
Name : tb:FirstChildLabel
Goal : Return the first child (1), skipping over [$skip]
Return the child if it has $strLabel, otherwise return empty
History:
20-05-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:FirstChildLabel($this as node()?, $skip as xs:string?, $strLabel as xs:string?) as node()?
{ (: Get ALL the children:)
let $all := $this/child::eTree
(: Select those that do NOT have a label that should be skipped :)
let $ok := $all[not(tb:Like(self::eTree/@Label, $skip))]
(: If the first element of $ok has the correct label, then return it :)
return
if (tb:Like($ok[1]/@Label, $strLabel))
then $ok[1]
else ()
} ;
(: ----------------------------------------------------------------
Name : tb:NextSibling
Goal : Return the next following-sibling (1) with the specified
$strLabel, if exists, otherwise empty
History:
26-03-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:NextSibling($this as node()?, $strLabel as xs:string?) as node()?
{ (: Get ALL the following siblings :)
let $all := $this/following-sibling::eTree
(: Select those that do have the correct label :)
let $ok := $all[tb:Like(self::eTree/@Label, $strLabel)]
(: Select those that are not empty :)
let $nstar := $ok[not(child::eLeaf/@Type = 'Star')]
return
if (empty($nstar))
then ()
else $nstar[1]
} ;
(: ----------------------------------------------------------------
Name : tb:iNextSibling
Goal : Return the immediately following-sibling (1) with the specified
$strLabel, if exists, otherwise empty
Ignore labels in $strSkip
History:
14-12-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:iNextSibling($this as node()?, $strLabel as xs:string?, $strSkip as xs:string?) as node()?
{ (: Get ALL the following siblings :)
let $all := $this/following-sibling::eTree
(: Ignore what user has specified :)
let $ok := $all[not(tb:Like(self::eTree/@Label, $strSkip))]
(: Get the immediately following one :)
let $fol := $ok[1]
(: Return the result by checking its label :)
return
if (exists($fol)) then
if (tb:Like($fol/@Label, $strLabel)) then $fol else ()
else
()
} ;
(: ----------------------------------------------------------------
Name : tb:NextSiblings
Goal : Return the next following-siblings (more than 1) with the specified
$strLabel, if exists, otherwise empty
History:
26-03-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:NextSiblings($this as node()?, $strLabel as xs:string?) as node()*
{ (: Get ALL the following siblings :)
let $all := $this/following-sibling::eTree
(: Select those that do have the correct label :)
let $ok := $all[tb:Like(self::eTree/@Label, $strLabel)]
(: Select those that are not empty :)
let $nstar := $ok[not(child::eLeaf/@Type = 'Star')]
return
if (empty($nstar))
then ()
else $nstar
} ;
(: ----------------------------------------------------------------
Name : tb:iFollowing
Goal : Return the following-sibling[1] if exists, otherwise empty
History:
15-02-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:iFollowing($this as node()?, $skip as xs:string?) as node()?
{ (: Get ALL the following siblings :)
let $all := $this/following-sibling::eTree
(: Select those that do NOT have a label that should be skipped :)
let $ok := $all[not(tb:Like(self::eTree/@Label, $skip))]
(: Select those that are not empty :)
let $nstar := $ok[not(child::eLeaf/@Type = 'Star')]
return
if (empty($nstar))
then ()
else $nstar[1]
} ;
(: ----------------------------------------------------------------
Name : tb:iPreceding
Goal : Return the preceding-sibling[1] if exists, otherwise empty
History:
15-02-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:iPreceding($this as node(), $skip as xs:string?) as node()?
{ (: Get ALL the preceding siblings :)
let $all := $this/preceding-sibling::eTree
(: Select those that do NOT have a label that should be skipped :)
let $ok := $all[not(tb:Like(self::eTree/@Label, $skip))]
(: Select those that are not empty :)
let $nstar := $ok[not(child::eLeaf/@Type = 'Star')]
return
if (empty($nstar))
then ()
else $nstar[last()]
} ;
(: ----------------------------------------------------------------
Name : tb:ChildWithLabel
Goal : Return the first child node of the given one
having a label like $strLabel
Skip over the nodes defined by $skip
History:
24-02-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:ChildWithLabel($this as node(), $skip as xs:string?, $strLabel as xs:string?) as node()?
{ (: Get ALL the children of me :)
let $all := $this/child::eTree
(: Select those that do NOT have a label that should be skipped :)
let $ok := $all[not(tb:Like(self::eTree/@Label, $skip))]
(: Select those that are not empty :)
let $nstar := $ok[not(child::eLeaf/@Type = 'Star')]
(: Select those that have the indicated label :)
let $ok := $nstar[tb:Like(@Label, $strLabel)]
return
if (empty($ok))
then ()
else $ok[1]
} ;
(: ----------------------------------------------------------------
Name : tb:InfoNP
Goal : Return the node if it is an NP, and it fulfills the conditions:
a - label does not belong to $_noobject
b - RefType is not 'Inert' or 'NewVar'
c - it is not starred
History:
06-12-2010 ERK Created for the NewInfo-Xquery_V3 project
---------------------------------------------------------------- :)
declare function tb:InfoNP($this as node()*) as node()*
{
for $cns in $this
(: Check the different conditions :)
let $ok := if (empty($cns)) then
false()
else if ( tb:IsStarred($cns) or
tb:Like($cns/@Label, $_ignore_nodes_conj) or
tb:Like($cns/@Label, $_noobject) or
tb:Coref($cns, 'Inert|NewVar')) then
false()
else
true()
where ($ok = true())
return $cns
};
(: ----------------------------------------------------------------
Name : tb:IsNew
Goal : Check whether the given node [$this] is an NP or
an NP object of a PP containing "new" information
History:
06-12-2010 ERK Created for the NewInfo-Xquery_V3 project
---------------------------------------------------------------- :)
declare function tb:IsNew($this as node()?) as xs:boolean?
{
(: Get the NP object of a PP, if this is a PP :)
let $cns := if (tb:Like($this/@Label, "PP*")) then
$this/child::eTree[tb:Like(@Label, "NP*")][1]
else
$this[tb:Like(@Label, "NP*")]
(: Get the 'New' NPs, but exclude some categories :)
let $new := if (empty($cns)) then
()
(: exclude empty categories, wrong coreference types and wrong NP types :)
else if ( tb:IsStarred($cns) or
tb:Like($cns/@Label, $_noobject)) then
()
else
tb:Coref($cns, 'New')
(: Filter out anchored ones :)
let $noanc := tb:NoAnchor($new)
(: Return the result :)
return exists($noanc)
};
(: ----------------------------------------------------------------
Name : tb:InfoCat
Goal : Return the information category, which can be:
OneNew - there is only one NP/PP, and it is discourse-new
OneRef - There is only one NP/PP and it is referential
AllNew - all the NPs and PPs are discourse-new
AllRef - all the NPs and PPs are referential
Mixed - there are more NPs and PPs, and some are discourse-new, some referential
History:
06-12-2010 ERK Created for the NewInfo-Xquery_V3 project
---------------------------------------------------------------- :)
declare function tb:InfoCat($this as node()?) as xs:string?
{
(: Get all the NP's and the PP objects :)
let $all := tb:SelfOrPPobjectList($this/child::eTree)
let $np := $all[tb:Like(@Label, $_anynp)]
(: Get rid of several NP types we should not be looking at :)
let $ok := tb:InfoNP($np)
(: Count the total number of NPs :)
let $intTotal := count($ok)
(: Get all the NEW NPs that are not anchored and count them :)
let $new := tb:Coref($ok, 'New')
let $noanc := tb:NoAnchor($new)
let $intNew := count($noanc)
(: Calculate the result :)
let $strType := if ($intTotal = 0) then '(none)'
else if ($intTotal=1) then
if ($intNew=1) then 'OneNew' else 'OneRef'
else if ($intTotal = $intNew) then 'AllNew'
else if ($intNew = 0) then 'AllRef'
else 'Mixed'
(: Debugging :)
(: ==============
let $trc := concat('InfoCat Id=', $this/@Id, ' total/new=', $intTotal, '/', $intNew, ' Type=', $strType,
' ', tb:IdList($ok), '\n')
================ :)
(: Return the result :)
(: return if (ru:Message($trc)) then $strType else $strType :)
return $strType
};
(: ----------------------------------------------------------------
Name : tb:InfoOrder
Goal : Return the information ordering of S,O (or P) and f(=finite verb)
No two items of Or or On are repeated!
History:
06-12-2010 ERK Created for the NewInfo-Xquery_V3 project
---------------------------------------------------------------- :)
declare function tb:InfoOrder($this as node()?) as xs:string?
{
(: The result is a concatenation of individual elements :)
let $strAll := string-join(
(: Look at all the children of [$this] in order :)
for $anych in $this/child::eTree
(: If this is a PP, then take the PP's NP child :)
let $cnst := tb:SelfOrPPobject($anych)
(: Make sure we exclude certain NP types :)
let $thisch := $cnst[not(tb:Like($cnst/@Label, $_noobject))]
(: Determine constituent type :)
let $strType := tb:ConstType($thisch)
(: Possibly get a focus particle presence :)
let $strFp := if (tb:HasFP($anych, $_IsFP)) then 'f'
else if (tb:HasFP($anych, $_IsFocAdv)) then 'a'
else ''
(: Determine the information type :)
let $strInfo := tb:InfoType($thisch)
(: Combine the two into a unit :)
let $strUnit := concat($strType, $strFp, $strInfo)
(: Only allow those to pass, where there is a clear const and info type :)
where (not($strType='' or $strInfo='') or ($strType='F'))
(: Return a nicely constructed result :)
return $strUnit
, '-')
(: Replace doubles with a single one :)
let $strCmb := ru:Combine($strAll, '-')
(: DEBUG :)
(: let $strMsg := concat('InfoOrder Id=', $this/@Id, ' Order=', $strCmb, '\n') :)
(: Return the result :)
return $strCmb
};
(: ----------------------------------------------------------------
Name : tb:ConstType
Goal : Return the constituent type:
L = left dislocation
S = subject
O = object or PP argument
F = finite verb
(nothing) = any other type
A constituent gets a small case "f" added if it has a focus particle
History:
06-12-2010 ERK Created for the NewInfo-Xquery_V3 project
---------------------------------------------------------------- :)
declare function tb:ConstType($this as node()?) as xs:string?
{
(: Get the correct node, depending on whether I am a PP :)
let $cnst := if (tb:Like($this/@Label, 'PP*')) then
(: This is a PP, so get the label of the first NP child :)
$this/child::eTree[tb:Like(@Label, 'NP*')][1]
else
$this
(: Get the label of this node as well as the grammatical role :)
let $strLabel := $cnst/@Label
let $strGrRole := tb:Feature($cnst, 'GrRole')
(: Construct the correct letter, or nothing :)
let $strLetter :=
(: 1 - Check if this is a verb of some kind :)
if (tb:Like($strLabel, $_anyverb)) then
(: Check if this is a finite verb :)
if (tb:Like($strLabel, $_finiteverb)) then 'F' else ''
else if (tb:Like($strLabel, 'NP*LFD*')) then 'L'
else if ($strGrRole = 'Subject') then 'S'
else if ($strGrRole = 'Argument') then 'O'
else if ($strGrRole = 'PPobject') then 'O'
else ''
(: Return the correct letter, or nothing :)
return $strLetter
};
(: ----------------------------------------------------------------
Name : tb:InfoType
Goal : Return New or Referential or nothing
History:
06-12-2010 ERK Created for the NewInfo-Xquery_V3 project
---------------------------------------------------------------- :)
declare function tb:InfoType($this as node()?) as xs:string?
{
(: Get either myself or my anchor :)
let $me := tb:SelfOrAnchor($this)
(: Determine what coreference type this constituent has :)
let $strType := tb:Feature($me, 'RefType')
(: Check out what we want to return :)
return
if ($strType = 'New') then 'n'
else if (tb:Like($strType, $_IsAnyRefer)) then 'r'
else ''
};
(: ----------------------------------------------------------------
Name : tb:SelfOrAnchor
Goal : If I am 'New', and I have an anchor, return it.
Otherwise return myself.
History:
06-12-2010 ERK Created for the NewInfo-Xquery_V3 project
---------------------------------------------------------------- :)
declare function tb:SelfOrAnchor($this as node()?) as node()?
{
(: Get my referential type :)
let $strRefType := tb:Feature($this, 'RefType')
(: Get the anchor, if it exists :)
let $anc := tb:Anchor($this)
(: ===== DEBUG ====== :)
(: let $msg := concat('SelfOrAnchor: Id=', $this/@Id, '\n') :)
(: Return the result :)
return if (($strRefType = 'New') and exists($anc)) then
$anc
else
$this
};
(: ----------------------------------------------------------------
Name : tb:PPobjectOrNP
Goal : Return the NP object of the PP or else the NP itself
History:
18-10-2010 ERK Created for the NewInfo-Xquery_V1 project
29-10-2010 ERK Added second NP condition
---------------------------------------------------------------- :)
declare function tb:PPobjectOrNP($this as node()?) as node()?
{
if (tb:Like($this/@Label, "PP*")) then
(: Get the preposition :)
let $pre := $this/child::eTree[tb:Like(@Label, "P*")]
(: Get the first NP sibling following the preposition :)
return $pre/following-sibling::eTree[tb:Like(@Label, "NP*")][1]
else
$this[tb:Like(@Label, "NP*")]
};
(: ----------------------------------------------------------------
Name : tb:AllNPobjects
Goal : Return all the argument NPs and the NP objects of PPs
History:
04-02-2011 ERK Created for NewInfo-Xquery_V6 project
---------------------------------------------------------------- :)
declare function tb:AllNPobjects($this as node()?, $strDiscard) as node()*
{
(: Check all NP non-subject arguments and all PPs :)
for $cns in $this/child::eTree[tb:Like(@Label, $_objNPorPP)]
(: Get the NP arguments of the PP :)
let $obj := tb:PPobjectOrNP($cns)
where (exists($obj) and not(tb:IsStarred($obj)) and not(tb:Like($obj/@Label, $strDiscard)) )
return $obj
};
(: ----------------------------------------------------------------
Name : tb:Drelative
Goal : Return the node if it is a D-relative
History:
14-12-2010 ERK Created for the D-Relative-Xquery_V1 project
---------------------------------------------------------------- :)
declare function tb:Drelative($this as node()*, $strType as xs:string?) as node()*
{
for $cns in $this
where (tb:IsDrel($cns, $strType))
return $cns
};
(: ----------------------------------------------------------------
Name : tb:IsDrel
Goal : Check if this is a D-relative
History:
14-12-2010 ERK Created for the D-Relative-Xquery_V1 project
---------------------------------------------------------------- :)
declare function tb:IsDrel($this as node()?, $strType as xs:string?) as xs:boolean?
{
(: Get the first child, excluding ignore ones :)
let $first := tb:FirstChild($this, $_ignore_nodes_conj)
(: Get the first child that looks like a demonstrative :)
let $det := $first[tb:Like(@Label, $_dem)]
(: Define the relative clause :)
let $rel := "CP-REL*|CP-FRL*"
(: Get the next <eTree> if it is a CP-REL :)
let $next := if($strType = 'strict') then
tb:iNextSibling($det, $rel, $_ignore_nodes_conj)
else
tb:NextSibling($det, $rel)
(: Return the result :)
return (exists($det) and tb:HasLeaf($det, $_dem_word) and exists($next))
};
(: ----------------------------------------------------------------
Name : tb:SelfOrPPobject
Goal : Return the NP object of the PP or else just myself
History:
06-12-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:SelfOrPPobject($this as node()?) as node()?
{
if (tb:Like($this/@Label, "PP*")) then
$this/child::eTree[tb:Like(@Label, "NP*")][1]
else
$this
};
(: ----------------------------------------------------------------
Name : tb:SelfOrPPobjectList
Goal : Return the NP object of the PP or else just myself
History:
06-12-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:SelfOrPPobjectList($this as node()*) as node()*
{
for $cns in $this
let $ok := if (tb:Like($cns/@Label, "PP*")) then
$cns/child::eTree[tb:Like(@Label, "NP*")][1]
else
$cns
where (exists($ok))
return $ok
};
declare function tb:IdList($this as node()*) as xs:string?
{
string-join(
for $cns in $this
return $cns/@Id,
'-')
};
(: ----------------------------------------------------------------
Name : tb:SomeNPargPPobj
Goal : Consider all the NP arguments and NP objects of PPs
Give the first one that has
(1) for an NP argument: $strNParg label
(2) for a PP object: $strPPobj label
History:
18-10-2010 ERK Created for the NewInfo-Xquery_V1 project
---------------------------------------------------------------- :)
declare function tb:SomeNPargPPobj($this as node()?, $strNParg as xs:string?,
$strPPobj as xs:string?, $strNoGo as xs:string?) as node()?
{
(: Get all the NP arguments that have no Inert coref :)
let $npArg := $this/child::eTree[tb:Like(@Label, $strNParg) and (not(tb:Like(@Label, $strNoGo)))]
let $npArg2 := tb:NoCoref($npArg, 'Inert')
(: Get all the PP objects that have no Inert coref :)
let $ppObj := $this/eTree[starts-with(@Label, "PP")]/eTree[tb:Like(@Label, $strPPobj)]
let $ppObj2 := tb:NoCoref($ppObj, 'Inert')
(: Try return an NP argument :)
return
if (exists($npArg2)) then
$npArg2[1]
else
(: Return the first PPobject's PP parent :)
$ppObj2[1]/parent::eTree
};
(: ----------------------------------------------------------------
Name : tb:FirstCorefNPargPPobj
Goal : Consider all the NP arguments and NP objects of PPs
Give the first one that has
(1) for an NP argument: $strNParg label
(2) for a PP object: $strPPobj label
(3) Referential type as $strRefType
History:
03-12-2010 ERK Created for the NewInfo-Xquery_V3 project
---------------------------------------------------------------- :)
declare function tb:FirstCorefNPargPPobj($this as node()?, $strNParg as xs:string?,
$strPPobj as xs:string?, $strNoGo as xs:string?,
$strRefType as xs:string?) as node()?
{
(: Get all the NP arguments that have no Inert coref :)
let $npArg := $this/child::eTree[tb:Like(@Label, $strNParg) and
(not(tb:Like(@Label, $strNoGo)))]
let $npArg2 := tb:Coref($npArg, $strRefType)
(: Get all the PP objects that have no Inert coref :)
let $ppObj := $this/eTree[starts-with(@Label, "PP")]/eTree[tb:Like(@Label, $strPPobj)]
let $ppObj2 := tb:Coref($ppObj, $strRefType)
(: Try return an NP argument :)
return
if (exists($npArg2)) then
$npArg2[1]
else
(: Return the first PPobject's PP parent :)
$ppObj2[1]/parent::eTree
};
(: ----------------------------------------------------------------
Name : tb:Follows
Goal : Check whether $arg2 follows upon $arg1
History:
18-10-2010 ERK Created for the NewInfo-Xquery_V1 project
---------------------------------------------------------------- :)
declare function tb:Follows($arg1 as node()?, $arg2 as node()?) as xs:boolean
{
(: Get ALL the following siblings :)
let $all := $arg1/following::eTree
(: Check if [$arg2] is part of this set :)
return
some $nd in $all satisfies $nd/@Id = $arg2/@Id
};
(: ----------------------------------------------------------------
Name : tb:Precedes
Goal : Check whether $arg2 precedes before $arg1
History:
18-10-2010 ERK Created for the NewInfo-Xquery_V1 project
---------------------------------------------------------------- :)
declare function tb:Precedes($arg1 as node()?, $arg2 as node()?) as xs:boolean
{
(: Get ALL the following siblings :)
let $all := $arg1/preceding::eTree
(: Check if [$arg2] is part of this set :)
return
some $nd in $all satisfies $nd/@Id = $arg2/@Id
};
(: ----------------------------------------------------------------
Name : tb:SiblingFollows
Goal : Check whether $arg2 follows upon $arg1
They must be SIBLINGS!!
History:
18-10-2010 ERK Created for the NewInfo-Xquery_V1 project
---------------------------------------------------------------- :)
declare function tb:SiblingFollows($arg1 as node()?, $arg2 as node()?) as xs:boolean
{
(: Get ALL the following siblings :)
let $all := $arg1/following-sibling::eTree
(: Check if [$arg2] is part of this set :)
return
some $nd in $all satisfies $nd/@Id = $arg2/@Id
};
(: ----------------------------------------------------------------
Name : tb:SiblingPrecedes
Goal : Check whether $arg2 precedes before $arg1
They must be SIBLINGS!!
History:
18-10-2010 ERK Created for the NewInfo-Xquery_V1 project
---------------------------------------------------------------- :)
declare function tb:SiblingPrecedes($arg1 as node()?, $arg2 as node()?) as xs:boolean
{
(: Get ALL the following siblings :)
let $all := $arg1/preceding-sibling::eTree
(: Check if [$arg2] is part of this set :)
return
some $nd in $all satisfies $nd/@Id = $arg2/@Id
};
(: ----------------------------------------------------------------
Name : tb:iFollows
Goal : Check whether $arg2 immediately follows upon $arg1
They must be SIBLINGS!!
Nodes of type $skip are skipped
History:
18-10-2010 ERK Created for the NewInfo-Xquery_V1 project
---------------------------------------------------------------- :)
declare function tb:iFollows($arg1 as node()?, $arg2 as node()?, $skip as xs:string?) as xs:boolean
{
(: Get ALL the following siblings :)
let $all := $arg1/following-sibling::eTree
(: Delete those that should be skipped :)
let $ok := $all[not(tb:Like(@Label, $skip))]
(: Check if [$arg2] is the first one :)
return
$ok[1]/@Id = $arg2/@Id
};
(: ----------------------------------------------------------------
Name : tb:iPrecedes
Goal : Check whether $arg2 immediately precedes $arg1
They must be SIBLINGS!!
Nodes of type $skip are skipped
History:
18-10-2010 ERK Created for the NewInfo-Xquery_V1 project
---------------------------------------------------------------- :)
declare function tb:iPrecedes($arg1 as node()?, $arg2 as node()?, $skip as xs:string?) as xs:boolean
{
(: Get ALL the following siblings :)
let $all := $arg1/preceding-sibling::eTree
(: Delete those that should be skipped :)
let $ok := $all[not(tb:Like(@Label, $skip))]
(: Check if [$arg2] is the first one :)
return
$ok[1]/@Id = $arg2/@Id
};
(: ----------------------------------------------------------------
Name : tb:Coref
Goal : Return those elements where the Coreference is of type [strType]
History:
18-10-2010 ERK Created for the NewInfo-Xquery_V1 project
---------------------------------------------------------------- :)
declare function tb:Coref($this as node()*, $strType as xs:string?) as node()*
{
for $cns in $this
let $strRefType := tb:Feature($cns, 'RefType')
where tb:Like($strRefType, $strType)
return $cns
};
(: ----------------------------------------------------------------
Name : tb:CorefLink
Goal : Return those elements where the Coreference is of type [strType]
and where the IP distance fulfills the requirements
History:
18-10-2010 ERK Created for the NewInfo-Xquery_V1 project
---------------------------------------------------------------- :)
declare function tb:CorefLink($this as node()*, $strType as xs:string?,
$intDist as xs:integer) as node()*
{
for $cns in $this
let $strRefType := tb:Feature($cns, 'RefType')
let $intIpDist := tb:Feature($cns, 'IPdist') cast as xs:integer
where tb:Like($strRefType, $strType) and
( ($intDist=0) or ($intIpDist > $intDist))
return $cns
};
(: ----------------------------------------------------------------
Name : tb:HasNPtype
Goal : Return those elements having the indicated NPtype
History:
19-04-2011 ERK Created for the NewInfo-Xquery_V1 project
---------------------------------------------------------------- :)
declare function tb:HasNPtype($this as node()*, $strType as xs:string?) as node()*
{
for $cns in $this
let $strRefType := tb:Feature($cns, 'NPtype')
where tb:Like($strRefType, $strType)
return $cns
};
(: ----------------------------------------------------------------
Name : tb:HasNPtext
Goal : Return those elements having the indicated NPtype and text of NP
History:
19-04-2011 ERK Created for the NewInfo-Xquery_V1 project
---------------------------------------------------------------- :)
declare function tb:HasNPtext($this as node()*, $strType as xs:string?, $strText as xs:string?) as node()*
{
for $cns in $this
let $strRefType := tb:Feature($cns, 'NPtype')
let $strRefText := $cns/descendant::eLeaf[1]/@Text
where ( tb:Like($strRefType, $strType) and tb:Like($strRefText, $strText) )
return $cns
};
(: ----------------------------------------------------------------
Name : tb:NoCoref
Goal : Return those elements where the Coreference is of type [strType]
History:
18-10-2010 ERK Created for the NewInfo-Xquery_V1 project
---------------------------------------------------------------- :)
declare function tb:NoCoref($this as node()*, $strType as xs:string?) as node()*
{
for $cns in $this
let $strRefType := tb:Feature($cns, 'RefType')
where not(tb:Like($strRefType, $strType))
return $cns
};
(: ----------------------------------------------------------------
Name : tb:HasCoref
Goal : Return whether the given node has Coref type [strType]
History:
18-10-2010 ERK Created for the NewInfo-Xquery_V1 project
---------------------------------------------------------------- :)
declare function tb:HasCoref($this as node()?, $strType as xs:string?) as xs:boolean?
{
(: Get the coreference type :)
let $strRefType := tb:Feature($this, 'RefType')
(: Check this type :)
return
tb:Like($strRefType, $strType)
};
(: ----------------------------------------------------------------
Name : tb:SomeLinkNPorPP
Goal : Get the first NP or PP in a clause that links back
The linking distance should be larger than [$intShort]
But if $intShort is ZERO, then we don't look at it
History:
29-10-2010 ERK Created for the Linking-Xquery_V1 project
---------------------------------------------------------------- :)
declare function tb:SomeLinkNPorPP($this as node()?, $strRef as xs:string,
$intShort as xs:integer) as node()?
{
(: Define allowable NP arguments and PP objects :)
let $strNParg := $_argNP
let $strPPobj := $_anynp
(: Get all the NP arguments that are referential :)
let $npArg := $this/child::eTree[tb:Like(@Label, $strNParg)]
let $npArg2 := tb:CorefLink($npArg, $strRef, $intShort)
(: Get all the PP objects that are referential :)
let $ppObj := $this/eTree[starts-with(@Label, "PP")]/eTree[tb:Like(@Label, $strPPobj)]
let $ppObj2 := tb:CorefLink($npArg, $strRef, $intShort)
(: Try return the first NP argument that is linking :)
return
(: We don't take the distances into account :)
if (exists($npArg2)) then
$npArg2[1]
else
(: Return the first PPobject's PP parent :)
$ppObj2[1]/parent::eTree
};
(: ----------------------------------------------------------------
Name : tb:IsPronoun
Goal : Is this constituent a pronoun?
History:
08-11-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:IsPronoun($this as node()?) as xs:boolean
{
(: Get a list all children :)
let $all := $this/child::eTree
(: Get the first of valid children :)
let $ok := $all[not(tb:Like(@Label, $_ignore_nodes_conj))][1]
(: Check the kind of child :)
return
exists($ok[tb:Like(@Label, "PRO*")])
};
(: ----------------------------------------------------------------
Name : tb:IsLink
Goal : Is this constituent a linking one?
History:
28-10-2010 ERK Created for the Linking-Xquery_V1 project
---------------------------------------------------------------- :)
declare function tb:IsLink($this as node()?, $strRef as xs:string,
$intShort as xs:integer) as xs:boolean?
{
(: Get the coreference type and the IP distance :)
let $refType := tb:Feature($this, 'RefType')
let $intDist := tb:Feature($this, 'IPdist') cast as xs:integer
(: Check this type :)
return
if ((tb:Like($refType, $strRef)) and (tb:IsShort($intDist, $intShort))) then
true()
else if ($refType = 'Assumed') then
true()
else
false()
};
(: ----------------------------------------------------------------
Name : tb:IsShort
Goal : Is this distance regarded as "short"?
History:
28-10-2010 ERK Created for the Linking-Xquery_V1 project
---------------------------------------------------------------- :)
declare function tb:IsShort($intDist as xs:integer?, $intShort as xs:integer) as xs:boolean
{
if (exists($intDist)) then
if ($intShort = 0) then
true()
else
($intDist <= $intShort )
else
false()
};
(: ----------------------------------------------------------------
Name : tb:English
Goal : Get the English translation of the forest we belong to
History:
28-10-2010 ERK Created for the NewInfo-Xquery_V1 project
---------------------------------------------------------------- :)
declare function tb:English($this as node()?) as xs:string?
{
(: Get the forest :)
let $forThis := $this/ancestor-or-self::forest
(: Get the English information :)
return $forThis/child::div[@lang='eng']/seg
};
(: ----------------------------------------------------------------
Name : tb:HasEnglish
Goal : Check whether the forest we belong to has an english translation
History:
29-10-2010 ERK Created for the NewInfo-Xquery_V1 project
---------------------------------------------------------------- :)
declare function tb:HasEnglish($this as node()?) as xs:boolean?
{
(: Get the forest :)
let $forThis := $this/ancestor-or-self::forest
(: Get the English information :)
return (not($forThis/child::div[@lang='eng']/seg = ''))
};
(: ----------------------------------------------------------------
Name : tb:NewInfo
Goal : Give information about the selected node, being a new one
History:
18-10-2010 ERK Created for the NewInfo-Xquery_V1 project
---------------------------------------------------------------- :)
declare function tb:NewInfo($this as node()?) as xs:string?
{
(: Gather basic information :)
let $strRefType := tb:Feature($this, 'RefType')
let $strGrRole := tb:Feature($this, 'GrRole')
let $intIpDist := tb:Feature($this, 'IPdist')
let $basic := concat(
'NewInfo=', tb:Labelled($this),
' (RefType=', $strRefType, ')',
' (GrRole=', $strGrRole,
'[', tb:GrRole($strGrRole), ']', ')' ,
' (IPdist=', $intIpDist, ')' )
return
(: Do we have a translation? :)
if (tb:HasEnglish($this))
then
(: Return result including translation :)
concat('Translation=[', tb:English($this), ']', $basic)
else
(: Just give the basics :)
$basic
};
(: ----------------------------------------------------------------
Name : tb:ShowInfo
Goal : Give information about the selected node
History:
18-10-2010 ERK Created for the FocusAdvNonCesax-Xquery_V1 project
---------------------------------------------------------------- :)
declare function tb:ShowInfo($this as node()?, $strMsg as xs:string?) as xs:string?
{
(: Gather basic information :)
let $strGrRole := tb:Feature($this, 'GrRole')
let $intIpDist := tb:Feature($this, 'IPdist')
let $strRefType := tb:Feature($this, 'RefType')
let $basic := if ($strRefType = '') then
concat( $strMsg, '=', tb:Labelled($this),
' (GrRole=', $strGrRole, '[', tb:GrRole($strGrRole), '])')
else
concat(
$strMsg, '=', tb:Labelled($this),
' (RefType=', $strRefType, ')',
' (GrRole=', $strGrRole,
'[', tb:GrRole($strGrRole), ']', ')' ,
' (IPdist=', $intIpDist, ')' )
return
(: Do we have a translation? :)
if (tb:HasEnglish($this))
then
(: Return result including translation :)
concat('Translation=[', tb:English($this), ']', $basic)
else
(: Just give the basics :)
$basic
};
(: ----------------------------------------------------------------
Name : tb:Anchor
Goal : If [$this] is an NP, and it is "Anchored", then return
its anchor (e.g. the PRO$ or NPR$)
History:
01-11-2010 ERK Created for the NewInfo-Xquery_V2 project
---------------------------------------------------------------- :)
declare function tb:Anchor($this as node()*) as node()*
{
(: Check all individual elements of [$this] :)
for $ndThis in $this
(: Get the first child :)
let $ndAnchor := $ndThis/child::eTree[1]
let $strRefType := tb:Feature($ndAnchor, 'RefType')
where (
(: The node itself must be an NP :)
tb:Label($ndThis, "NP*") and
(: Its first child must be referential :)
tb:Like($strRefType, $_IsRefer)
)
return
$ndAnchor
};
(: ----------------------------------------------------------------
Name : tb:NoAnchor
Goal : Return all nodes that are not anchored
History:
01-11-2010 ERK Created for the NewInfo-Xquery_V2 project
---------------------------------------------------------------- :)
declare function tb:NoAnchor($this as node()*) as node()*
{
(: Check all individual elements of [$this] :)
for $ndThis in $this
(: Get the first child, which gives [his mother] for instance :)
let $ndAnchor := $ndThis/child::eTree[1]
let $strRefType := tb:Feature($ndAnchor, 'RefType')
(: Check if there is a PP, and then get the PPs NP child
This will get instances like [some of them] :)
let $ndPP := $ndThis/child::eTree[tb:Like(@Label, 'PP*')]
let $ndPPanch := $ndPP/child::eTree[tb:Like(@Label, 'NP*')]
let $strRefPP := tb:Feature($ndPPanch[1], 'RefType')
where (
(: Its first child must NOT be referential :)
not(tb:Like($strRefType, $_IsRefer)) and
(: It may not have a PP containing an anchor :)
not(tb:Like($strRefPP, $_IsRefer))
)
return
$ndThis
};
(: ----------------------------------------------------------------
Name : tb:Newest
Goal : Return the newest NP child or PP object of [$this]
History:
18-10-2010 ERK Created for the NewInfo-Xquery_V1 project
---------------------------------------------------------------- :)
declare function tb:Newest($this as node()?, $strLabel as xs:string?) as node()?
{ (: Get ALL the NP children of me :)
let $nparg := $this/child::eTree
(: Get all the PP children of me :)
let $pp := $this/child::eTree[tb:Like(@Label, "PP|PP-*")]
(: Get all the NP children of the PP children :)
let $ppobj := $pp/child::eTree[tb:Like(@Label, "NP|NP-*")]
(: Combine all the NPs :)
let $all := $nparg | $ppobj
(: Delete all the NP-PRN's, all NP-MSR's and all NP-ADV's as well as all reflexives :)
let $noprn := $all[not(tb:Like(@Label, "*PRN*|*MSR*|NP-ADV*"))]
(: Delete all the expletives -- they should have been marked 'Inert' :)
let $noexp := $noprn[not(tb:Like(child::eTree[1]/@Label, "EX|EX-*"))]
(: Delete all those having NewVar and Inert Coref types :)
let $clean := tb:NoCoref($noexp, 'NewVar|Inert')
(: Check the number of elements having "New" :)
let $tmp := tb:Coref($clean, 'New')
(: Split the new in real new and anchored ones :)
let $new := tb:NoAnchor($tmp)
let $anc := tb:Anchor($tmp)
(: Get the number of "Assumed" ones :)
let $ass := tb:Coref($clean, 'Assumed')
(: Get all the referential ones, as defined above - including anchors :)
let $ref := tb:Coref($clean, $_IsRefer) | $anc
(: Get ordered IP distances :)
let $ord := tb:OrderedIpDist($ref)
(: ========== DEBUG ============= :)
let $trc := tb:Ordered($ord)
(: ============================== :)
(: Get referential constituents that are cataphoric :)
let $ctp := tb:Cataphoric($ref)
(: Check if we have 1 (and no more than 1) of type "New" :)
return
if (count($new) = 1) then
(: We have found THE newest element - return it :)
$new
(: Check if there are more New elements :)
else if (count($new) >1) then
(: Pick the best ordered new one :)
tb:OrderedIpDist($new)[1]
(: Check if we are there now :)
else if (count($ass) = 1) then
(: Return the newest element: assumed :)
$ass
(: Check if there are more then 1 assumed constituents :)
else if (count($ass) >1) then
(: Pick the best ordered assumed one :)
tb:OrderedIpDist($ass)[1]
(: Do we have enough to work with anyway? :)
else if (count($ref) = 0) then
()
(: Perhaps there is only one referential constituent? :)
else if (count($ref) = 1) then
(: Return this one and only surviving candidate :)
$ref
(: =============== DEBUG ==============
else if (ru:Trace($trc)) then
$ord[1]
==================================== :)
(: Perhaps there are cataphores? :)
else if (count($ctp) >0) then
(: Return the grammatically newest cataphore :)
$ctp[1]
else
(: Return the first one with highest IPdist :)
$ord[1]
} ;
(: --------------------------------------------------------------------------
Name : tb:GetNum
Goal : Transform a string into a number, even if it is empty
History:
29-10-2010 ERK Created
-------------------------------------------------------------------------- :)
declare function tb:GetNum($strIn as xs:string?) as xs:integer
{
let $strThis := if (exists($strIn)) then $strIn else ''
let $strNum := if ($strThis = '') then '0' else $strThis
return $strNum cast as xs:integer
};
(: --------------------------------------------------------------------------
Name : tb:Ordered
Goal : Give a string of IP distances for the items in the given array
History:
02-11-2010 ERK Created
-------------------------------------------------------------------------- :)
declare function tb:Ordered($this as node()*) as xs:string
{
concat('Loc=', $this[1]/ancestor::forest/@Location, 'Order=',
string-join(
for $el in $this
let $intDist := tb:GetNum(tb:Feature($el, 'IPdist'))
return string($intDist)
, ';')
, '\n')
};
(: --------------------------------------------------------------------------
Name : tb:OrderedIpDist
Goal : Return a list of elements ordered according to these 2 features:
(1) their IPdist feature (descending: largest distance first)
(2) their grammatical role value (descending)
History:
18-10-2010 ERK Created for the NewInfo-Xquery_V1 project
-------------------------------------------------------------------------- :)
declare function tb:OrderedIpDist($this as node()*) as node()*
{
for $el in $this
let $intDist := tb:GetNum(tb:Feature($el, 'IPdist'))
let $intRole := tb:GrRole(tb:Feature($el, 'GrRole'))
order by $intDist descending, $intRole descending
return $el
};
(: --------------------------------------------------------------------------
Name : tb:Cataphoric
Goal : Return a list of cataphoric elements ordered according to
(1) their grammatical role value (descending)
History:
02-11-2010 ERK Created for the NewInfo-Xquery_V1 project
-------------------------------------------------------------------------- :)
declare function tb:Cataphoric($this as node()*) as node()*
{
for $el in $this
let $intDist := tb:GetNum(tb:Feature($el, 'IPdist'))
let $intRole := tb:GrRole(tb:Feature($el, 'GrRole'))
where ($intDist < 0)
order by $intRole descending
return $el
};
(: --------------------------------------------------------------------------
Name : tb:GrRole
Goal : Return a ranking number for the grammatical role
History:
18-10-2010 ERK Created for the NewInfo-Xquery_V1 project
-------------------------------------------------------------------------- :)
declare function tb:GrRole($strIn as xs:string?) as xs:integer
{
if ($strIn = "Subject") then
1
else if ($strIn = "Argument") then
2
else if ($strIn = "PossDet") then
3
else if ($strIn = "PPobject") then
4
else if ($strIn = "Oblique") then
5
else
6
(: =========== DOESN"T WORK =========
typeswitch($strIn)
case "Subject"
return 1
case "Argument"
return 2
case "PossDet"
return 3
case "PPobject"
return 4
case "Oblique"
return 5
default
return 6
================================== :)
};
(: ----------------------------------------------------------------
Name : tb:IsFiniteBe
Goal : Check whether indicated node is either:
(1) finite form of BE
(2) finite auxiliary + infinite BE
History:
16-09-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:IsFiniteBe($this as node()?) as xs:boolean
{
(: Get the parent just in case... :)
let $parent := $this/parent::eTree
(: First check if this is finite BE :)
return
if (tb:Label($this, $_finite_BE))
then true()
else
(: I must be a particular kind of infinite form of BE :)
tb:Label($this, "BE|BEN") and
(: And there must be another sibling with a finite auxiliary :)
tb:SomeChild($parent, $_finiteaux)
} ;
(: ----------------------------------------------------------------
Name : tb:RefState
Goal : Guess the referential state of the node based on the NPtype
and for DefNP and FullNP based on the daughters etc.
History:
18-01-2011 ERK Created
---------------------------------------------------------------- :)
declare function tb:RefState($this as node()?) as xs:string?
{
if (exists($this))
(: Make use of the built in RU function to do the hard work :)
then ru:RefState($this)
else ''
};
(: ----------------------------------------------------------------
Name : tb:SomeChild
Goal : Return the first child node of [$this]
having a label like $strLabel
History:
24-02-2010 ERK Created from "ChildWithLabel"
---------------------------------------------------------------- :)
declare function tb:SomeChild($this as node()*, $strLabel as xs:string?) as node()?
{ (: Get ALL the children of me :)
let $all := $this/child::eTree
(: Select those that have the indicated label :)
let $ok := $all[tb:Like(@Label, $strLabel)]
return
if (empty($ok))
then ()
else $ok[1]
} ;
(: ----------------------------------------------------------------
Name : tb:AllStarred
Goal : Return all child node of [$this]
that are either starred themselves, or have a starred child
History:
20-12-2010 ERK Created from "SomeChild"
---------------------------------------------------------------- :)
declare function tb:AllStarred($this as node()*) as node()*
{
(: Visit all the children :)
for $ch in $this/child::eTree
let $ok := $this[descendant::eLeaf/@Type = 'Star']
where (exists($ok))
return $ch
} ;
(: ----------------------------------------------------------------
Name : tb:SpecialChild
Goal : Return the first child node of [$this], where:
child <eTree> has a label like $strLabel
grandchild <eLeaf> has a label like $strGrand
History:
20-09-2010 ERK Created from "SomeChild"
---------------------------------------------------------------- :)
declare function tb:SpecialChild($this as node()?, $strLabel as xs:string?, $strGrand as xs:string?,
$strLeaf as xs:string?) as node()?
{
(: Get ALL the children of me :)
let $all := $this/child::eTree
(: Select those that have the indicated label :)
let $ch := $all[tb:Like(@Label, $strLabel)]
(: Get the grandchildren :)
let $gr := $ch/child::eTree
(: Select grandchildren with the correct label :)
let $grok := $gr[tb:Like(@Label, $strGrand)]
(: Select leaves of grandchildren :)
let $leaf := $grok/child::eLeaf
(: Check label of leaves :)
let $ok := $leaf[tb:Like(@Text, $strLeaf)]
return
if (empty($ok))
then ()
else $ok[1]/parent::eTree/parent::eTree
} ;
(: ----------------------------------------------------------------
Name : tb:AllChildren
Goal : Return all child nodes of [$this]
having a label like $strLabel
History:
20-09-2010 ERK Created from "ChildWithLabel"
---------------------------------------------------------------- :)
declare function tb:AllChildren($this as node()*, $strLabel as xs:string?) as node()*
{ (: Get ALL the children of me :)
let $all := $this/child::eTree
(: Select those that have the indicated label :)
let $ok := $all[tb:Like(@Label, $strLabel)]
return
if (empty($ok))
then ()
else $ok
} ;
(: ----------------------------------------------------------------
Name : tb:SomeChildNo
Goal : Return the first child node of [$this]
having a label like $strLabel
and NOT having a label like $strNogo
History:
24-02-2010 ERK Created from "SomeChild"
---------------------------------------------------------------- :)
declare function tb:SomeChildNo($this as node()?, $strLabel as xs:string?,
$strNogo as xs:string?) as node()?
{ (: Get ALL the children of me :)
let $all := $this/child::eTree
(: Select those that have the indicated label :)
let $ok1 := $all[tb:Like(@Label, $strLabel)]
(: Exclude those that have the NoGo label :)
let $ok := $ok1[not(tb:Like(@Label, $strNogo))]
return
if (empty($ok))
then ()
else $ok[1]
} ;
(: ----------------------------------------------------------------
Name : tb:SomeDescendant
Goal : Return the first descendant node of [$this]
having a label like $strLabel
History:
20-07-2010 ERK Created from "SomeChild"
---------------------------------------------------------------- :)
declare function tb:SomeDescendant($this as node()?, $strLabel as xs:string?) as node()?
{ (: Get ALL the descendants of me :)
let $all := $this/descendant::eTree
(: Select those that have the indicated label :)
let $ok := $all[tb:Like(@Label, $strLabel)]
return
if (empty($ok))
then ()
else $ok[1]
} ;
(: ----------------------------------------------------------------
Name : tb:HasPhrase
Goal : Find out if $this is of type $strLabel
If so, then see whether it has a (final) eLeaf
with lexeme $strLeaf
History:
15-03-2010 ERK Derived from tb:HasPhraseChild
---------------------------------------------------------------- :)
declare function tb:HasPhrase($this as node()?, $strLabel as xs:string?, $strLeaf as xs:string?) as xs:boolean
{
(: Get ALL the children of me :)
let $all := $this/child::eTree
(: Get the children with the correct label... :)
let $allok := $all[tb:Like(@Label, $strLabel)]
(: Select all descendant <eLeaf>s :)
let $leaf := $allok/descendant::eLeaf
(: Select those that have the indicated eLeaf SOMEWHERE down :)
let $ok := $leaf[tb:Like(@Text, $strLeaf)]
(: Check if the node is of the correct type :)
return not(empty($ok))
} ;
(: ----------------------------------------------------------------
Name : tb:HasLeaf
Goal : Find out whether $this it has a (final) eLeaf
with lexeme $strLeaf
History:
15-03-2010 ERK Derived from tb:HasPhraseChild
---------------------------------------------------------------- :)
declare function tb:HasLeaf($this as node()?, $strLeaf as xs:string?) as xs:boolean
{
(: Select those that have the indicated eLeaf SOMEWHERE down :)
some $leaf in $this/descendant::eLeaf satisfies
tb:Like($leaf/@Text, $strLeaf)
} ;
(: ----------------------------------------------------------------
Name : tb:HasPhraseChild
Goal : Find out if $this has a direct child of type $strLabel
If so, then see whether this child has a (final) eLeaf
with lexeme $strLeaf
History:
05-03-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:HasPhraseChild($this as node()?, $strLabel as xs:string?, $strLeaf as xs:string?) as xs:boolean
{ (: Get ALL the children of me :)
let $all := $this/child::eTree
(: Select those that HAVE a label of the specified type :)
let $have := $all[tb:Like(self::eTree/@Label, $strLabel)]
(: Select those that have the indicated eLeaf SOMEWHERE down :)
let $ok := $have[tb:Like(descendant::eLeaf/@Text, $strLeaf)]
return
if (empty($ok))
then false()
else true()
} ;
(: ----------------------------------------------------------------
Name : tb:FirstChild
Goal : Return the first child node of the given one
Skip over the nodes defined by $skip
Skip over empty nodes
History:
15-02-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:FirstChild($this as node()?, $skip as xs:string?) as node()?
{ (: Get ALL the children of me :)
let $all := $this/child::eTree
(: Select those that do NOT have a label that should be skipped :)
let $ok := $all[not(tb:Like(self::eTree/@Label, $skip))]
(: Select those that are not empty :)
let $nstar := $ok[not(child::eLeaf/@Type = 'Star')]
return
if (empty($nstar))
then ()
else $nstar[1]
} ;
(: ----------------------------------------------------------------
Name : tb:AnyFirstChild
Goal : Return the first child node of the given one
Skip over the nodes defined by $skip
Do NOT skip over empty nodes
History:
18-10-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:AnyFirstChild($this as node()?, $skip as xs:string?) as node()?
{ (: Get ALL the children of me :)
let $all := $this/child::eTree
(: Select those that do NOT have a label that should be skipped :)
let $ok := $all[not(tb:Like(self::eTree/@Label, $skip))]
return
if (empty($ok))
then ()
else $ok[1]
} ;
(: ----------------------------------------------------------------
Name : tb:IsStarred
Goal : Check whether the given <eTree> node contains an <eLeaf>
child of the type [Star]
History:
13-09-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:IsStarred($this as node()?) as xs:boolean
{
(: Just check ... :)
let $ok := $this[child::eLeaf/@Type = 'Star']
(: Return true if the collection is not empty :)
return
if (empty($ok))
then false()
else true()
} ;
(: ----------------------------------------------------------------
Name : tb:LastChild
Goal : Return the last child node of the given one
Skip over the nodes defined by $skip
History:
29-03-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:LastChild($this as node()?, $skip as xs:string?) as node()?
{ (: Get ALL the children of me :)
let $all := $this/child::eTree
(: Select those that do NOT have a label that should be skipped :)
let $ok := $all[not(tb:Like(self::eTree/@Label, $skip))]
(: Select those that are not empty :)
let $nstar := $ok[not(child::eLeaf/@Type = 'Star')]
return
if (empty($nstar))
then ()
else $nstar[last()]
} ;
(: ----------------------------------------------------------------
Name : functx:index-of-node
Goal : ??
History:
27-07-2009 ERK Copied from the internet
---------------------------------------------------------------- :)
declare function functx:index-of-node
( $nodes as node()* ,
$nodeToFind as node() ) as xs:integer* {
for $seq in (1 to count($nodes))
return $seq[$nodes[$seq] is $nodeToFind]
} ;
(: ----------------------------------------------------------------
Name : tb:adapt
Goal : Adapt a wildcard string to a regular expression
Note : Anchoring is described in:
http://www.w3.org/TR/xmlschema-2/#regexs
History:
27-07-2009 ERK Created
---------------------------------------------------------------- :)
declare function tb:adapt($strIn as xs:string) as xs:string
{
(: need to replace ^ instances! :)
let $strTmp1 := replace($strIn, '\^', '\\^') (: concat('\\', '^')) :)
(: need to replace + instances! :)
let $strTmp2 := replace($strTmp1, '\+', '\\+')
(: need to replace - instances! :)
let $strTmp := replace($strTmp2, '\-', '\\-')
(: need to replace dot . instances! :)
let $strTmp := replace($strTmp2, '\.', '\\.')
(: -- possibly define word boundary -- :)
let $strOut :=
if (not(starts-with($strTmp, '*'))) then
if (not(ends-with($strTmp, '*'))) then
concat('^', $strTmp, '$')
else
concat('^', $strTmp)
else
if (not(ends-with($strTmp, '*'))) then
concat($strTmp, '$')
else
$strTmp
let $strTmp := replace($strOut, '\*', '.*')
return $strTmp
};
(: ----------------------------------------------------------------
Name : tb:string-test
Goal : Test one name against a list of names using regular expressions
History:
27-07-2009 ERK Created
---------------------------------------------------------------- :)
declare function tb:string-test($testname as xs:string? ,
$names as xs:string*) as xs:boolean
{
some $name in $names satisfies
matches($testname, tb:adapt($name) )
};
declare function tb:string-debug($names as xs:string*) as xs:string
{
string-join(
for $word in $names
return concat('[', tb:adapt($word) , ']')
, ' ')
};
(: ----------------------------------------------------------------
Name : tb:Labelled
Goal : Give the clause back as bracketed labelling
History:
18-10-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:Labelled($this as node()*) as xs:string?
{
concat('[', $this/@Label, ' ', tb:Sentence($this), ']')
};
(: ----------------------------------------------------------------
Name : tb:Sentence
Goal : Combine all [Vern] leafs of the given nodes into a sentence
History:
23-07-2009 ERK Created
---------------------------------------------------------------- :)
declare function tb:Sentence($ndThis as element()*) as xs:string
{
string-join(
for $word in $ndThis//eLeaf[@Type='Vern' or @Type='Punct']
where $word/ancestor::eTree[not(@Label='CODE')]
return $word/@Text
, ' ')
};
(: ----------------------------------------------------------------
Name : tb:Phrases
Goal : Combine all [Vern] leafs of the given nodes into a sentence
History:
23-07-2009 ERK Created
---------------------------------------------------------------- :)
declare function tb:Phrases($ndThis as element()*) as xs:string
{
string-join(
for $phrase in $ndThis/child::eTree
return concat('[', tb:Sentence($phrase) , ']')
, ' ')
};
(: ----------------------------------------------------------------
Name : tb:Syntax
Goal : Combine all [Vern] leafs of the given nodes into a sentence
History:
23-07-2009 ERK Created
---------------------------------------------------------------- :)
declare function tb:Syntax($ndThis as element()*) as xs:string
{
string-join(
for $phrase in $ndThis/child::eTree
return concat('[', $phrase/@Label, ' ', tb:Sentence($phrase) , ']')
, ' ')
};
(: ----------------------------------------------------------------
Name : tb:Brackets
Goal : Created a list of <TextEl> elements for all the given nodes
History:
23-07-2009 ERK Created
---------------------------------------------------------------- :)
declare function tb:Brackets($ndThis as element()*) as element()*
{
for $elThis in $ndThis/eTree
return
<TextEl NodeID="{$elThis/@Id}"
Label="{$elThis/@Label}"
Phrase="{tb:Sentence($elThis)}" />
};
(: ----------------------------------------------------------------
Name : tb:Reference
Goal : Determine the kind of reference for the given node
History:
23-07-2009 ERK Created
---------------------------------------------------------------- :)
declare function tb:Reference($ndThis as node()) as xs:string
{
if (empty($ndThis/@RefType))
then '(None)'
else string($ndThis/@RefType)
};
(: ----------------------------------------------------------------
Name : tb:NPitem
Goal : Create one <NPitem> element for the given node
History:
23-07-2009 ERK Created
---------------------------------------------------------------- :)
declare function tb:NPitem($ndThis as element()) as element()
{
if (empty($ndThis/@RefType))
then
<NPitem NodeID="{$ndThis/@Id}"
Label="{$ndThis/@Label}"
Ref="{tb:Reference($ndThis)}"
ClDist="0" NdDist="0" />
else
<NPitem NodeID="{$ndThis/@Id}"
Label="{$ndThis/@Label}" Ref="{tb:Reference($ndThis)}"
ClDist="{data($ndThis/Attrib[@Name='ClDist']/@Value)}"
NdDist="{data($ndThis/Attrib[@Name='NdDist']/@Value)}" />
};
(: ----------------------------------------------------------------
Name : tb:PPitem
Goal : Create one <NPitem> element for the given PP node
History:
23-07-2009 ERK Created
---------------------------------------------------------------- :)
declare function tb:PPitem($ndPP as node()) as node()
{
let $ndThis := $ndPP/eTree[tb:Like(@Label,$_anypp)][1]
return
if (empty($ndThis))
then
<NPitem NodeID="{$ndThis/@Id}"
Label="{$ndPP/@Label}" Ref="(empty)"
ClDist="0" NdDist="0" />
else
(
if (empty($ndThis/@RefType))
then
<NPitem NodeID="{$ndThis/@Id}"
Label="{$ndPP/@Label}" Ref="{tb:Reference($ndThis)}"
ClDist="0" NdDist="0" />
else
<NPitem NodeID="{$ndThis/@Id}"
Label="{$ndPP/@Label}" Ref="{tb:Reference($ndThis)}"
ClDist="{data($ndThis/Attrib[@Name='ClDist']/@Value)}"
NdDist="{data($ndThis/Attrib[@Name='NdDist']/@Value)}" />
)
};
(: ----------------------------------------------------------------
Name : tb:NPitems
Goal : Create a list of <NPitem> elements for all NP objects
in the given list of nodes
History:
23-07-2009 ERK Created
---------------------------------------------------------------- :)
declare function tb:NPitems($ndThis as element()*) as element()*
{
for $elThis in $ndThis/eTree[tb:Like(@Label, $_anynp)]
return tb:NPitem($elThis)
};
(: ----------------------------------------------------------------
Name : tb:NPandPPitems
Goal : Create a list of <NPitem> elements for all NP objects
in the given list of nodes
History:
23-07-2009 ERK Created
---------------------------------------------------------------- :)
declare function tb:NPandPPitems($ndThis as element()*) as element()*
{
for $elThis in $ndThis/eTree[tb:Like(@Label, $_anynporpp)]
return (if (tb:Like($elThis/@Label, $_anynp))
then tb:NPitem($elThis)
else tb:PPitem($elThis) )
};
(: ----------------------------------------------------------------
Name : tb:DistIncreasing
Goal : The [NPitem] elements of the input [NPlist] have
monotonically increasing NPitem/@NdDist attribute
History:
27-07-2009 ERK Created
---------------------------------------------------------------- :)
declare function tb:DistIncreasing($ndThis as element()) as xs:boolean
{
( some $elThis in $ndThis/NPitem satisfies ($elThis/@NdDist >0)
) and
(
every $elThis in $ndThis/NPitem satisfies
(
if ($elThis/@NodeID != $ndThis/NPitem[last()]/@NodeID)
then
let $elNext := $ndThis/NPitem[functx:index-of-node($ndThis/NPitem, $elThis)+1]
let $intThis := data($elThis/@NdDist)
let $intNext := data($elNext/@NdDist)
return ($intThis cast as xs:integer <= $intNext cast as xs:integer)
else
true()
)
)
};
(: ----------------------------------------------------------------
Name : tb:DistDecreasing
Goal : The [NPitem] elements of the input [NPlist] have
monotonically decreasing NPitem/@NdDist attribute
History:
27-07-2009 ERK Created
---------------------------------------------------------------- :)
declare function tb:DistDecreasing($ndThis as element()) as xs:boolean
{
( some $elThis in $ndThis/NPitem satisfies ($elThis/@NdDist >0)
) and
(
every $elThis in $ndThis/NPitem satisfies
(
if ($elThis/@NodeID != $ndThis/NPitem[last()]/@NodeID)
then
let $elNext := $ndThis/NPitem[functx:index-of-node($ndThis/NPitem, $elThis)+1]
let $intThis := data($elThis/@NdDist)
let $intNext := data($elNext/@NdDist)
return ($intThis cast as xs:integer >= $intNext cast as xs:integer)
else
true()
)
)
};
(: ----------------------------------------------------------------
Name : tb:DistZero
Goal : The [NPitem] elements of the input [NPlist] have
zero value NPitem/@NdDist attribute
History:
28-07-2009 ERK Created
---------------------------------------------------------------- :)
declare function tb:DistZero($ndThis as element()) as xs:boolean
{
( every $elThis in $ndThis/NPitem satisfies ($elThis/@NdDist =0)
)
};
(: ----------------------------------------------------------------
Name : tb:DistMixed
Goal : The [NPitem] elements of the input [NPlist] have
both increasing and decreasing NPitem/@NdDist attribute
History:
27-07-2009 ERK Created
---------------------------------------------------------------- :)
declare function tb:DistMixed($ndThis as element()) as xs:boolean
{
( some $elThis in $ndThis/NPitem satisfies ($elThis/@NdDist >0)
)
and
(
some $elThis in $ndThis/NPitem satisfies
(
if ($elThis/@NodeID != $ndThis/NPitem[last()]/@NodeID)
then
let $elNext := $ndThis/NPitem[functx:index-of-node($ndThis/NPitem, $elThis)+1]
let $intThis := data($elThis/@NdDist)
let $intNext := data($elNext/@NdDist)
return ($intThis cast as xs:integer > $intNext cast as xs:integer)
else
false()
)
)
and
(
some $elThis in $ndThis/NPitem satisfies
(
if ($elThis/@NodeID != $ndThis/NPitem[last()]/@NodeID)
then
let $elNext := $ndThis/NPitem[functx:index-of-node($ndThis/NPitem, $elThis)+1]
let $intThis := data($elThis/@NdDist)
let $intNext := data($elNext/@NdDist)
return ($intThis cast as xs:integer < $intNext cast as xs:integer)
else
false()
)
)
};
(: ----------------------------------------------------------------
Name : tb:IP-layout
Goal : Give the layout of the IP passed on by [ndThis]
History:
27-07-2009 ERK Created
---------------------------------------------------------------- :)
declare function tb:IP-layout($ndThis as element()*) as xs:string
{
string-join(
for $elThis in $ndThis//TextEl
where
tb:Like($elThis/@Label, $_anynporpp)
or tb:Like($elThis/@Label, $_finiteverb)
return $elThis/@Label,
';'
)
};
(: ----------------------------------------------------------------
Name : tb:IP-content
Goal : Give the content of the IP passed on by [ndThis]
History:
27-07-2009 ERK Created
---------------------------------------------------------------- :)
declare function tb:IP-content($ndThis as element()*) as xs:string
{
string-join(
for $elThis in $ndThis//TextEl
where
tb:Like($elThis/@Label, $_anynporpp)
or tb:Like($elThis/@Label, $_finiteverb)
return concat('[',$elThis/@Label,' ', $elThis/@Phrase, ']'),
' '
)
};
(: ----------------------------------------------------------------
Name : tb:Distances
Goal : List all the distances found in the [NPitem] elements
History:
27-07-2009 ERK Created
---------------------------------------------------------------- :)
declare function tb:Distances($ndThis as element()) as xs:string
{
if (empty($ndThis))
then 'Empty'
else
string-join(
for $elThis in $ndThis/NPitem
return
(
if ($elThis/@NodeID != $ndThis/NPitem[last()]/@NodeID)
then
let $ndNext := $ndThis/NPitem[functx:index-of-node($ndThis/NPitem, $elThis)+1]
return concat('Unequal[', $elThis/@NodeID, '-', $ndNext/@NodeID, ']')
else 'LastEl'
),
';')
};
(: ----------------------------------------------------------------
Name : tb:LeafLike
Goal : True if the <eLeaf> of node1 looks enough like the <eLeaf> of node2
History:
12-03-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:LeafLike($nd1 as element()?, $nd2 as element()?) as xs:boolean
{
let $leaf1 := $nd1/descendant::eLeaf[1]/@Text
let $leaf2 := $nd2/descendant::eLeaf[1]/@Text
return
if (exists($nd1) and exists($nd2))
then
( (contains($leaf1, $leaf2)) or
(contains($leaf2, $leaf1)) )
else
false()
};
(: ----------------------------------------------------------------
Name : tb:IsAdvTh
Goal : True if node [ndThis] contains an adverb with an <eLeaf>
starting with th.
This should give words like: therfore, that, then, þan, þenne, for þæt, for to
The label of the node can be PP or ADVP*
History:
12-03-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:IsAdvTh($ndThis as node()?) as xs:boolean
{
(: Is this the correct node to start with? :)
if (tb:Like($ndThis/@Label, "PP|PP-*|ADVP*"))
then
(: Try get an <eTree> descendant that is ADV or ADV+P :)
let $adv := $ndThis/child::eTree[tb:Like(@Label, "ADV|ADV+P|ADV^*|ADV-*")]
(: Try to return something :)
return
if (empty($adv))
then
false()
else
( some $lfThis in $adv/descendant::eLeaf satisfies
(tb:Like($lfThis/@Text, $_anyth))
)
else
false()
};
(: ----------------------------------------------------------------
Name : tb:IsAdverb
Goal : True if node [ndThis] contains an adverb with an <eLeaf>
starting with th.
This should give words like: therfore, that, then, þan, þenne, for þæt, for to
The label of the node can be PP or ADVP*
History:
12-03-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:IsAdverb($ndThis as node()?, $strLeaf as xs:string?, $strNoLeaf as xs:string?) as xs:boolean
{
(: Is this the correct node to start with? :)
if (tb:Like($ndThis/@Label, "PP|PP-*|ADVP*"))
then
(: Try get an <eTree> descendant that is ADV or ADV+P :)
let $adv := $ndThis/child::eTree[tb:Like(@Label, "ADV|ADV+P|ADV^*|ADV-*")]
(: Try to return something :)
return
if (empty($adv))
then
false()
else
( some $lfThis in $adv/descendant::eLeaf satisfies
(tb:Like($lfThis/@Text, $strLeaf) and not(tb:Like($lfThis/@Text, $strNoLeaf)))
)
else
false()
};
(: ----------------------------------------------------------------
Name : tb:IsWhen
Goal : True if node [ndThis] contains a PP with the preposition (P) "when"
History:
20-04-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:IsWhen($ndThis as node()?) as xs:boolean
{
(: Is this the correct node to start with? :)
if (tb:Like($ndThis/@Label, "PP|PP-*"))
then
(: Try get an <eTree> descendant that is ADV or ADV+P :)
let $pre := $ndThis/child::eTree[tb:Like(@Label, "P")]
(: Try to return something :)
return
if (empty($pre))
then
false()
else
( some $lfThis in $pre/descendant::eLeaf satisfies
(tb:Like($lfThis/@Text, $_when_word))
)
else
false()
};
(: ----------------------------------------------------------------
Name : tb:IsDefNP
Goal : True if node [ndThis] contains an NP with first child
a determiner or PRO$ or NPR$
Note : This makes use of $_ignore_nodes (defined above)
History:
20-04-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:IsDefNP($ndThis as node()?) as xs:boolean
{
(: Is this the correct node to start with? :)
if (tb:Like($ndThis/@Label, $_anynp))
then
(: Get all the children :)
let $all := $ndThis/child::eTree
(: Select those that do NOT have a label that should be skipped :)
let $ok := $all[not(tb:Like(@Label, $_ignore_nodes))]
(: Try get an <eTree> descendant that is D :)
let $pre := $ok[tb:Like(@Label, $_dem)]
(: Also try get an <eTree> descendant that is PRO$ or NPR$ :)
let $anc := $ok[tb:Like(@Label, "PRO$|NPR$")]
(: Try to return something :)
return
( ( not(empty($pre)) and
not($pre/child::eLeaf[@Text='a'])
)
or not(empty($anc)) )
else
false()
};
(: ----------------------------------------------------------------
Name : tb:IsDem
Goal : True if node [ndThis] contains an NP with one (1) child,
and this child is of class "D"
Note : This makes use of $_ignore_nodes (defined above)
History:
20-04-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:IsDem($ndThis as node()?) as xs:boolean
{
(: Is this the correct node to start with? :)
if (tb:Like($ndThis/@Label, $_anynp))
then
(: Get all the children :)
let $all := $ndThis/child::eTree
(: Select those that do NOT have a label that should be skipped :)
let $ok := $all[not(tb:Like(@Label, $_ignore_nodes))]
(: Try get an <eTree> descendant that is D :)
let $pre := $ok[tb:Like(@Label, $_dem)]
(: Try to return something :)
return
(not(empty($pre)) and (count($ok)=1))
(: not(empty($pre)) :)
else
false()
};
(: ----------------------------------------------------------------
Name : tb:IsDemNP
Goal : True if node [ndThis] contains an NP where the
first child has a label like "D"
Note : This makes use of $_ignore_nodes (defined above)
History:
08-11-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:IsDemNP($ndThis as node()?) as xs:boolean
{
(: Is this the correct node to start with? :)
if (tb:Like($ndThis/@Label, $_anynp))
then
(: Get all the children :)
let $all := $ndThis/child::eTree
(: Select those that do NOT have a label that should be skipped :)
let $ok := $all[not(tb:Like(@Label, $_ignore_nodes))]
(: Try get an <eTree> descendant that is D :)
let $pre := $ok[tb:Like(@Label, $_dem)]
(: Try to return something :)
return
(exists($pre))
else
false()
};
(: ----------------------------------------------------------------
Name : tb:GetDem
Goal : Simulate the [IsDem] function, to find out what goes wrong
History:
20-04-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:GetDem($ndThis as node()?) as node()*
{
(: Is this the correct node to start with? :)
if (tb:Like($ndThis/@Label, $_anynp))
then
(: Get all the children :)
let $all := $ndThis/child::eTree
(: Select those that do NOT have a label that should be skipped :)
let $ok := $all[not(tb:Like(@Label, $_ignore_nodes))]
return $ok
else
()
};
(: ----------------------------------------------------------------
Name : tb:PhraseType
Goal : Determine the phrase type of the given node
For NPs this is the NPtype
For other constituents it is the label
History:
22-12-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:PhraseType($this as node()?) as xs:string?
{
(: Make sure we get the NP if this is a PP :)
let $cnst := tb:SelfOrPPobject($this)
(: Get the NP type and the label :)
let $npt := tb:Feature($cnst, 'NPtype')
let $strLabel := $this/@Label
(: Return whatever is appropriate :)
return
if ($npt = '') then $strLabel else $npt
};
(: ----------------------------------------------------------------
Name : tb:GuessCoref
Goal : Guess what the coreference type is, depending on the
value of the feature NP/NPtype
History:
23-12-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:GuessCoref($this as node()?) as xs:string?
{
(: Make sure we get the NP if this is a PP :)
let $cnst := tb:SelfOrPPobject($this)
(: Get the NP type and the label :)
let $npt := tb:Feature($cnst, 'NPtype')
let $strLabel := $this/@Label
(: Return whatever is appropriate :)
return
if (tb:Like($strLabel, '*TMP*')) then
'Temp'
else if ($npt = '') then
$strLabel
else if (tb:Like($npt, 'DemNP|Dem|Pro|PossPro|Pro|Trace|ZeroSbj'))then
'Identity'
else if ($npt = 'AnchoredNP') then
'Inferred'
else if ($npt = 'Bare') then
'Type'
else
(: this includes FullNP, QuantNP, IndefNP, Proper etc :)
'New'
};
(: ----------------------------------------------------------------
Name : tb:CleftedCat
Goal : Determine the category of the cleft, starting with the
cleft clause in [$ndCls]
History:
20-12-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:CleftedCat($ndCls as node()?) as xs:string?
{
(: Get the IP-SUB inside which the cleft clause is :)
let $ip := tb:SomeChild($ndCls, $_subIP)
(: Get the first constituent having a starred descendant :)
let $star := tb:AllStarred($ip)[1]
(: Get the label :)
let $strLabel := $star/@Label
(: Determine the category :)
return
if (tb:Like($strLabel, $_anyAdjunct)) then
'Adjunct'
else if (tb:Like($strLabel, $_subject)) then
'Subject'
else if (tb:Like($strLabel, $_objNP)) then
'Object'
else if (tb:Like($strLabel, $_anynp)) then
'NonArgNP'
else
'Other'
};
(: ----------------------------------------------------------------
Name : tb:Clefted
Goal : Retrieve the clefted constituent.
Start by determining its type from the cleft clause in [$ndCls]
History:
22-12-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:Clefted($ndCls as node()?) as node()?
{
(: Get the IP-SUB inside which the cleft clause is :)
let $ip := tb:SomeChild($ndCls, $_subIP)
(: Get the first constituent having a starred descendant :)
let $star := tb:AllStarred($ip)[1]
(: Get the label :)
let $strLabel := if (exists($star))then concat(tb:MainLabel($star/@Label), '*') else ''
(: Get all siblings preceding the clefted constituent with the correct label :)
let $prec := $ndCls/preceding-sibling::eTree
(: Get the LAST one having the specified label :)
let $clefted := if ($strLabel = '') then () else $prec[tb:Like(@Label, $strLabel)][last()]
(: DEBUG :)
let $msg := concat('Clause=', tb:Phrases($ndCls/parent::eTree),
' Prec[1]=', tb:Phrases($prec[1]),
' Prec[2]=', tb:Phrases($prec[2]),
' Clefted=', tb:Phrases($clefted), '\n')
(: Try to return the text of this constituent :)
(: return if (ru:Message($msg)) then $clefted else $clefted :)
return $clefted
};
(: ----------------------------------------------------------------
Name : tb:Constituent
Goal : Return the contents of this constituent or else "Not Found"
History:
22-12-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:Constituent($this as node()?) as xs:string?
{
if (exists($this)) then
tb:Sentence($this)
else
'(Not Found)'
};
(: ----------------------------------------------------------------
Name : tb:AttrList
Goal : Return the full list of attributes of the node [ndThis]
History:
26-05-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:AttrList($ndThis as node()?) as xs:string
{
string-join(
for $attr in $ndThis/@*
return
concat(name($attr), '=', string($attr))
, ' ')
};
(: ----------------------------------------------------------------
Name : tb:GetAdvTh
Goal : If node [ndThis] contains an adverb with an <eLeaf>
starting with th, then return this <eLeaf> string
This should give words like: therfore, that, then, þan, þenne, for þæt, for to
The label of the node can be PP or ADVP*
History:
12-03-2010 ERK Created
---------------------------------------------------------------- :)
declare function tb:GetAdvTh($ndThis as node()?) as node()?
{
(: Is this the correct node to start with? :)
if (tb:Like($ndThis/@Label, "PP|PP-*|ADVP*"))
then
(: Try get an <eTree> descendant that is ADV or ADV+P :)
let $adv := $ndThis/child::eTree[tb:Like(@Label, "ADV|ADV+P|ADV^*|ADV-*")]
(: Try to return something :)
return
if (empty($adv))
then
()
else
(
let $th := $adv/descendant::eLeaf[tb:Like(@Text, $_anyth)]
return $th[1]
)
else
()
};