Dodanie arole

Wojciech Jaworski
1 parent 2cf638de
Showing 5 changed files with 49 additions and 33 deletions
lexSemantics/ENIAMadjuncts.ml
lexSemantics/ENIAMlexSemantics.ml
lexSemantics/ENIAMlexSemanticsStringOf.ml
lexSemantics/ENIAMlexSemanticsTypes.ml
lexSemantics/makefile
@@ -268,19 +268,21 @@ let add_adjuncts preps compreps compars pos2 (selectors,schema) =
   | "adv" -> [selectors,schema @ ENIAMwalRenderer.adv_adjuncts_simp @ compars]
   | _ -> []
  
-let add_connected_adjuncts preps compreps compars pos2 (selectors,meanings,schema) =
+open ENIAMlexSemanticsTypes
+
+let add_connected_adjuncts preps compreps compars pos2 frame =
   let compreps = Xlist.rev_map compreps ENIAMwalRenderer.render_connected_comprep in
   let prepnps = Xlist.rev_map preps (fun (prep,cases) -> ENIAMwalRenderer.render_connected_prepnp prep cases) in
   let prepadjps = Xlist.rev_map preps (fun (prep,cases) -> ENIAMwalRenderer.render_connected_prepadjp prep cases) in
   let compars = Xlist.rev_map compars ENIAMwalRenderer.render_connected_compar in
   match pos2 with
-    "verb" -> [selectors,meanings,schema @ ENIAMwalRenderer.verb_connected_adjuncts_simp @ prepnps @ prepadjps @ compreps @ compars]
+    "verb" -> [{frame with positions=frame.positions @ ENIAMwalRenderer.verb_connected_adjuncts_simp @ prepnps @ prepadjps @ compreps @ compars}]
   | "noun" -> [
-      [Nsyn,Eq,["proper"]] @ selectors,meanings,ENIAMwalRenderer.proper_noun_connected_adjuncts_simp @ prepnps @ compreps @ compars;
-      [Nsyn,Eq,["common"];Nsem,Eq,["measure"]] @ selectors,meanings,ENIAMwalRenderer.measure_noun_connected_adjuncts_simp @ prepnps @ compreps @ compars;
-      [Nsyn,Eq,["common"];Nsem,Neq,["measure"]] @ selectors,meanings,ENIAMwalRenderer.common_noun_connected_adjuncts_simp @ prepnps @ compreps @ compars]
-  | "adj" -> [selectors,meanings,schema @ ENIAMwalRenderer.adj_connected_adjuncts_simp @ compars]
-  | "adv" -> [selectors,meanings,schema @ ENIAMwalRenderer.adv_connected_adjuncts_simp @ compars]
+      {frame with selectors=[Nsyn,Eq,["proper"]] @ frame.selectors; positions=ENIAMwalRenderer.proper_noun_connected_adjuncts_simp @ prepnps @ compreps @ compars};
+      {frame with selectors=[Nsyn,Eq,["common"];Nsem,Eq,["measure"]] @ frame.selectors; positions=ENIAMwalRenderer.measure_noun_connected_adjuncts_simp @ prepnps @ compreps @ compars};
+      {frame with selectors=[Nsyn,Eq,["common"];Nsem,Neq,["measure"]] @ frame.selectors; positions=frame.positions @ ENIAMwalRenderer.common_noun_connected_adjuncts_simp @ prepnps @ compreps @ compars}]
+  | "adj" -> [{frame with positions=frame.positions @ ENIAMwalRenderer.adj_connected_adjuncts_simp @ compars}]
+  | "adv" -> [{frame with positions=frame.positions @ ENIAMwalRenderer.adv_connected_adjuncts_simp @ compars}]
   | _ -> []
  
 (* let _ =
@@ -32,8 +32,8 @@ let find_meaning m =
 let lex_sie = LCG (ENIAMwalRenderer.render_morf (SimpleLexArg("się",QUB)))
  
 let find_senses t s = (* FIXME: sensy zawierające 'się' *)
-  let set = Xlist.fold s.frames StringSet.empty (fun set (selectors,meanings,positions) ->
-    Xlist.fold meanings set (fun set (name,hipero,weight) ->
+  let set = Xlist.fold s.frames StringSet.empty (fun set frame ->
+    Xlist.fold frame.meanings set (fun set (name,hipero,weight) ->
       StringSet.add set name)) in
   let senses = match t.token with
       Lemma(lemma,pos,_) -> ENIAMplWordnet.find_senses lemma pos
@@ -47,9 +47,9 @@ let find_senses t s = (* FIXME: sensy zawierające &#39;się&#39; *)
     | _ -> [] in
   let senses_sie = Xlist.fold senses_sie [] (fun senses_sie (name,hipero,weight) ->
     if StringSet.mem set name then senses_sie else (name,hipero,weight) :: senses_sie) in
-  let frames = if senses = [] then s.frames else ([],senses,[]) :: s.frames in
-  let frames = if senses_sie = [] then frames else ([],senses_sie,
-    [{empty_position with role="Lemma"; mode=["lemma"]; morfs=[lex_sie]}]) :: frames in
+  let frames = if senses = [] then s.frames else {empty_frame with meanings=senses} :: s.frames in
+  let frames = if senses_sie = [] then frames else {empty_frame with meanings=senses_sie;
+    positions=[{empty_position with role="Lemma"; mode=["lemma"]; morfs=[lex_sie]}]} :: frames in (* FIXME: czy to nie usuwa elementów z ramy? *)
   {s with frames=frames}
  
 let find_selprefs schema = (* FIXME: RelationRole *)
@@ -165,13 +165,12 @@ let assign_valence tokens lex_sems group =
           selectors,ENIAMwalRenderer.render_lex_entry entry) in
       let connected = List.flatten (Xlist.map connected (fun (sopinion,fopinion,meanings,neg,pred,aspect,schema) ->
           Xlist.rev_map (ENIAMvalence.transform_entry pos lemma neg pred aspect schema) (fun (selectors,schema) ->
-              selectors,meanings,schema))) in (* FIXME: gubię opinię *)
-      let connected = Xlist.fold connected [] (fun connected (selectors,meanings,schema) ->
-          if ENIAMadjuncts.check_selector_lex_constraints lexemes pos selectors then (selectors,meanings,schema) :: connected else connected) in
-      let connected = Xlist.rev_map connected (fun (selectors,meanings,schema) ->
-          selectors,
-          Xlist.map meanings find_meaning,
-          find_selprefs (ENIAMwalRenderer.render_connected_schema (ENIAMwalReduce.set_necessary schema))) in
+              {empty_frame with selectors=selectors; meanings= Xlist.map meanings find_meaning; positions=schema}))) in (* FIXME: gubię opinię *)
+      let connected = Xlist.fold connected [] (fun connected frame ->
+          if ENIAMadjuncts.check_selector_lex_constraints lexemes pos frame.selectors then frame :: connected else connected) in
+      let connected = Xlist.rev_map connected (fun frame ->
+          {frame with
+            positions = find_selprefs (ENIAMwalRenderer.render_connected_schema (ENIAMwalReduce.set_necessary frame.positions))}) in
       let connected = List.flatten (Xlist.rev_map connected (ENIAMadjuncts.add_connected_adjuncts preps compreps compars pos2)) in
       ExtArray.set lex_sems id {(ExtArray.get lex_sems id) with
                                 schemata=schemata; lex_entries=entries; frames=connected})
@@ -218,8 +217,8 @@ let assign_valence tokens lex_sems group =
  
 let disambiguate_senses lex_sems group =
   let prefs = Xlist.fold group (StringSet.singleton "ALL") (fun prefs id ->
-    Xlist.fold (ExtArray.get lex_sems id).frames prefs (fun prefs (_,_,schema) ->
-      Xlist.fold schema prefs (fun prefs t ->
+    Xlist.fold (ExtArray.get lex_sems id).frames prefs (fun prefs frame ->
+      Xlist.fold frame.positions prefs (fun prefs t ->
         Xlist.fold t.sel_prefs prefs (fun prefs -> function
           SynsetName s -> StringSet.add prefs s
         | _ -> failwith "disambiguate_senses")))) in
@@ -231,12 +230,12 @@ let disambiguate_senses lex_sems group =
   let senses = if is_zero then StringSet.add senses "0" else senses in*)
   Xlist.iter group (fun id ->
     let t = ExtArray.get lex_sems id in
-    ExtArray.set lex_sems id {t with frames=Xlist.map t.frames (fun (selectors,meanings,positions) ->
-      let meanings = Xlist.map meanings (fun (name,hipero,weight) ->
+    ExtArray.set lex_sems id {t with frames=Xlist.map t.frames (fun frame ->
+      let meanings = Xlist.map frame.meanings (fun (name,hipero,weight) ->
         let hipero = Xlist.fold hipero ["ALL",0] (fun hipero (name,cost) ->
           if StringSet.mem prefs name then (name,cost) :: hipero else hipero) in
         name,hipero,weight) in
-      selectors,meanings,positions)})
+      {frame with meanings=meanings})})
  
 let remove_unused_tokens tokens groups =
   let set = Xlist.fold groups IntSet.empty (fun set group ->
@@ -27,6 +27,11 @@ let lex_sems t =
     let t2 = ExtArray.get t id in
     (Printf.sprintf "%3d %s" id (lex_sem t2)) :: l)))*)
  
+let arole f =
+  (if f.arole = "" then "" else "," ^ f.arole) ^
+  (if f.arole_attr = "" then "" else "," ^ f.arole_attr) ^
+  (if f.arev then ",rev"  else "")
+
 let string_of_lex_sems tokens lex_sems =
   String.concat "\n" (List.rev (Int.fold 0 (ExtArray.size lex_sems - 1) [] (fun l id ->
     let t = ExtArray.get lex_sems id in
@@ -44,9 +49,9 @@ let string_of_lex_sems tokens lex_sems =
         String.concat "," (Xlist.map meanings (fun m -> ENIAMwalStringOf.meaning m))) in
     let senses = Xlist.map t.senses (fun (sense,hipero,weight) ->
         Printf.sprintf "%s[%s]%.2f" sense (String.concat "," (Xlist.map hipero (fun (s,n) -> s ^ " " ^ string_of_int n))) weight) in*)
-    let frames = Xlist.map t.frames (fun (selectors,meanings,schema) ->
-        "*[" ^ ENIAMcategoriesPL.string_of_selectors selectors ^ "] {" ^ ENIAMwalStringOf.schema schema ^ "} " ^
-        String.concat "," (Xlist.map meanings (fun (sense,hipero,weight) ->
+    let frames = Xlist.map t.frames (fun f ->
+        "*" ^ arole f ^ "[" ^ ENIAMcategoriesPL.string_of_selectors f.selectors ^ "] {" ^ ENIAMwalStringOf.schema f.positions ^ "} " ^
+        String.concat "," (Xlist.map f.meanings (fun (sense,hipero,weight) ->
         Printf.sprintf "%s[%s]%.2f" sense (String.concat "," (Xlist.map hipero (fun (s,n) -> s ^ " " ^ string_of_int n))) weight))) in
     (String.concat "\n    " ([core] @ (*senses @*) schemata @ frames @ lex_entries)) :: l)))
     (* let lroles = if snd t.lroles = "" then fst t.lroles else fst t.lroles ^ " " ^ snd t.lroles in
@@ -36,20 +36,30 @@ type semantics =
   | SpecialMod of string * (type_arg list * type_term)*)
   | PrepSemantics of (string * string * string * StringSet.t * string list) list (* case,role,role_attr,hipero,sel_prefs *)
  
+type frame = {
+  selectors: (ENIAM_LCGlexiconTypes.selector * ENIAM_LCGlexiconTypes.selector_relation * string list) list;
+  meanings: ((*ENIAMwalTypes.meaning **) string * (string * int) list * float) list;
+  positions: ENIAMwalTypes.position list;
+  arole: string;
+  arole_attr: string;
+  arev: bool;
+  }
+
+let empty_frame = {selectors=[]; meanings=[]; positions=[]; arole=""; arole_attr=""; arev=false}
+
 type lex_sem = {
   schemata: ((ENIAM_LCGlexiconTypes.selector * ENIAM_LCGlexiconTypes.selector_relation * string list) list *
              (ENIAM_LCGtypes.direction * ENIAM_LCGtypes.grammar_symbol) list) list;
   lex_entries: ((ENIAM_LCGlexiconTypes.selector * ENIAM_LCGlexiconTypes.selector_relation * string list) list *
                 ENIAM_LCGtypes.grammar_symbol) list;
-  frames: ((ENIAM_LCGlexiconTypes.selector * ENIAM_LCGlexiconTypes.selector_relation * string list) list *
-             ((*ENIAMwalTypes.meaning **) string * (string * int) list * float) list * ENIAMwalTypes.position list) list;
+  frames: frame list;
   cats: string list;
   (* e: labels; *)
   (* valence: (int * ENIAMwalTypes.frame) list;
   simple_valence: (int * ENIAMwalTypes.frame) list;
   very_simple_valence: ((ENIAM_LCGgrammarPLtypes.cat * ENIAM_LCGgrammarPLtypes.selector_relation * string list) list * ENIAM_LCGtypes.grammar_symbol) list; *)
   (* senses: (string * (string * int) list * float) list; *)
-  lroles: string * string;
+  (* lroles: string * string; *)
   semantics: semantics;
   }
  
@@ -64,7 +74,7 @@ type lex_sem = {
 let empty_lex_sem = {
   schemata=[]; lex_entries=[]; frames=[]; cats=["X"];
   (*e=empty_labels;*) (*valence=[]; simple_valence=[]; very_simple_valence=[];*) (*senses=[];*)
-  lroles="",""; semantics=Normal}
+  (*lroles="","";*) semantics=Normal}
  
 (* FIXME: poprawić katalog *)
 (*let subst_uncountable_lexemes_filename = resource_path ^ "/lexSemantics/subst_uncountable.dat"
@@ -6,8 +6,8 @@ OCAMLFLAGS=$(INCLUDES) -g
 OCAMLOPTFLAGS=$(INCLUDES) unix.cmxa xml-light.cmxa str.cmxa nums.cmxa zip.cmxa bz2.cmxa xlib.cmxa eniam-tokenizer.cmxa eniam-morphology.cmxa eniam-subsyntax.cmxa eniam-lcg-parser.cmxa eniam-lcg-lexicon.cmxa eniam-lexSemantics.cmxa
 INSTALLDIR=`ocamlc -where`/eniam
  
-SOURCES= entries.ml ENIAMwalTypes.ml ENIAMwalStringOf.ml ENIAMwalParser.ml ENIAMwalReduce.ml ENIAMvalence.ml ENIAMwalRenderer.ml ENIAMadjuncts.ml \
-    ENIAMlexSemanticsTypes.ml ENIAMlexSemanticsStringOf.ml ENIAMlexSemanticsHTMLof.ml ENIAMlexSemanticsXMLof.ml ENIAMplWordnet.ml ENIAMlexSemantics.ml #ENIAMlexSemanticsData.ml
+SOURCES= entries.ml ENIAMwalTypes.ml ENIAMwalStringOf.ml ENIAMwalParser.ml ENIAMwalReduce.ml ENIAMvalence.ml ENIAMwalRenderer.ml ENIAMlexSemanticsTypes.ml ENIAMadjuncts.ml \
+    ENIAMlexSemanticsStringOf.ml ENIAMlexSemanticsHTMLof.ml ENIAMlexSemanticsXMLof.ml ENIAMplWordnet.ml ENIAMlexSemantics.ml #ENIAMlexSemanticsData.ml
  
 all: eniam-lexSemantics.cma eniam-lexSemantics.cmxa