generowanie korpusu literówek

Wojciech Jaworski
1 parent f86c717e
Showing 5 changed files with 136 additions and 74 deletions
NKJP2/.gitignore
NKJP2/makefile
NKJP2/spelling.ml
NKJP2/validateTokenizer.ml
resources/NKJP1M/NKJP1M_spelling_errors.tar.bz2
 test
+NKJP1M_spelling_errors/*
+spelling
@@ -11,6 +11,10 @@ SOURCES=ENIAM_NKJP.ml validateTokenizer.ml
 all: $(SOURCES)
 	$(OCAMLOPT) -o test $(OCAMLOPTFLAGS) $^
+spelling: $(SOURCES) spelling.ml
+	mkdir -p NKJP1M_spelling_errors
+	$(OCAMLOPT) -o spelling $(OCAMLOPTFLAGS) $^
+
 # install:
 # 	mkdir -p /usr/share/eniam/Walenty
 # 	cp resources/*  /usr/share/eniam/Walenty
@@ -40,4 +44,4 @@ all: $(SOURCES)
 	$(OCAMLOPT) $(OCAMLOPTFLAGS) -c $<
 clean:
-	rm -f *~ *.cm[aoix] *.o *.so *.cmxa *.a test
+	rm -f *~ *.cm[aoix] *.o *.so *.cmxa *.a test spelling
+(*
+ *  ENIAM_NKJP, an interface for National Corpus of Polish (NKJP).
+ *  Copyright (C) 2017 Wojciech Jaworski <wjaworski atSPAMfree mimuw dot edu dot pl>
+ *  Copyright (C) 2017 Institute of Computer Science Polish Academy of Sciences
+ *
+ *  This library is free software: you can redistribute it and/or modify
+ *  it under the terms of the GNU Lesser General Public License as published by
+ *  the Free Software Foundation, either version 3 of the License, or
+ *  (at your option) any later version.
+ *
+ *  This library is distributed in the hope that it will be useful,
+ *  but WITHOUT ANY WARRANTY; without even the implied warranty of
+ *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ *  GNU Lesser General Public License for more details.
+ *
+ *  You should have received a copy of the GNU Lesser General Public License
+ *  along with this program.  If not, see <http://www.gnu.org/licenses/>.
+ *)
+
+let xml_space = Xml.PCData " "
+let xml_err_space = Xml.Element("sp",[],[])
+
+let make_xml_token real_orth orth =
+  if real_orth = orth then Xml.PCData orth else
+  Xml.Element("err",["cor",orth],[Xml.PCData real_orth])
+
+let rec merge_pcdata = function
+    Xml.PCData a :: Xml.PCData b :: l -> merge_pcdata (Xml.PCData(a ^ b) :: l)
+  | x :: l -> x :: (merge_pcdata l)
+  | [] -> []
+
+let generate_error_sentences sentences =
+  let sentences,_,_ = Xlist.fold sentences ([],"","") (fun (sentences,prev_orth,prev_cat) (id_s,tokens,named_tokens) ->
+    let no_tokens = Xlist.size tokens in
+    let tokens,prev_orth,prev_cat = Xlist.fold tokens ([],prev_orth,prev_cat) (fun (tokens,prev_orth,prev_cat) (_,_,no_spaces,real_orth,orth,_,cat,_) ->
+      let tokens = Int.fold 1 no_spaces tokens (fun tokens _ -> xml_space :: tokens) in
+      let tokens = if no_spaces = 0 && ValidateTokenizer.is_space_required prev_orth prev_cat orth cat then xml_err_space:: tokens else tokens in
+      (make_xml_token real_orth orth) :: tokens, orth, cat) in
+    Xml.Element("s",["id",id_s;"length",string_of_int no_tokens],merge_pcdata (List.rev tokens)) :: sentences,prev_orth,prev_cat) in
+  Xml.Element("p",[],List.rev sentences)
+
+let generate_error_corpus path out_path =
+  ENIAM_NKJP.fold ENIAM_NKJP.nkjp_path () (fun () (name,typ,channel,entries) ->
+    (* print_endline name; *)
+    let entries = List.rev (Xlist.rev_map entries (fun (id_div,has_ne,paragraphs) ->
+      let paragraphs = List.rev (Xlist.rev_map paragraphs (fun (paragraph,sentences) ->
+        generate_error_sentences sentences)) in
+      Xml.Element("div",["id",string_of_int id_div],paragraphs))) in
+    let xml = Xml.Element("source",["id",name;"type",typ;"channel",channel],entries) in
+    File.file_out (out_path ^ name ^ ".xml") (fun file ->
+      output_string file (Xml.to_string_fmt xml)))
+
+let _ = generate_error_corpus ENIAM_NKJP.nkjp_path "NKJP1M_spelling_errors/"
@@ -45,11 +45,29 @@ let make_token orth lemma cat interp =
          orth=orth;
          token=Lemma(lemma,cat,[Xlist.map interp (fun s -> [s])])}
-let suffixes = StringSet.of_list ["by"; "ż"; "ń"; "że"; "%"; "BY"; "ś"; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ]
+let suffixes = StringSet.of_list ["by"; "ż"; "ń"; "że"; "%"; "BY"; "ś"; "li"; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ]
 (* let prefixes = StringSet.of_list [
   (*"\""; "-"; "("; "„"; "/"; "."; "+"; "«"; "''"; "»"; "["; "–"; "'";
   "’"; ":"; "“"; ","; ")";*) ""; ""; ""; ""; ""; ""; ] *)
+let is_space_required prev_orth prev_cat orth cat =
+  if cat = "interp" || cat = "aglt" || prev_cat = "interp" || prev_cat = "" || StringSet.mem suffixes orth then false else (
+  let prev_char = List.hd (List.rev (Xunicode.classified_chars_of_utf8_string prev_orth)) in
+  let cur_char = List.hd (Xunicode.classified_chars_of_utf8_string orth) in
+  match prev_char,cur_char with
+    Xunicode.Sign a,Xunicode.Sign b -> (*print_endline ("is_space_required 1: " ^ prev_orth ^ " " ^ orth ^ " " ^ a ^ " " ^ b);*) true
+  | _,Xunicode.Sign _ -> false
+  | Xunicode.Sign _,_ -> false
+  | Xunicode.Digit _,Xunicode.Digit _ -> true
+  | Xunicode.Digit _,_ -> false
+  | _,Xunicode.Digit _ -> false
+  | Xunicode.Small _,Xunicode.Small _ -> true
+  | Xunicode.ForeignSmall _,Xunicode.Small _ -> true
+  | Xunicode.Capital _,Xunicode.Capital _ -> true
+  | Xunicode.Small _,Xunicode.Capital _ -> true
+  | Xunicode.Capital _,Xunicode.Small _ -> true
+  | Xunicode.ForeignCapital _,Xunicode.Small _ -> true
+  | a,b -> failwith ("is_space_required: " ^ prev_orth ^ " " ^ orth ^ " " ^ Xunicode.to_string a ^ " " ^ Xunicode.to_string b))
 let rec allign prev_orth prev_cat rev = function
     (SentBeg,0,_,_,_,orth,lemma,cat,interp) :: l ->
@@ -57,11 +75,8 @@ let rec allign prev_orth prev_cat rev = function
   | (_,0,_,_,_,orth,lemma,cat,interp) :: l -> failwith "allign"
   | (sent,beg,_,no_spaces,_,orth,lemma,cat,interp) :: l ->
        let rev =
-         if no_spaces > 0 then space :: rev
-         else if cat = "interp" || cat = "aglt" || prev_cat = "interp" || StringSet.mem suffixes orth (*|| StringSet.mem prefixes prev_orth*) then rev
-         else (
-         (* print_endline ("allign: " ^ prev_orth ^ " " ^ orth); *)
-         space :: rev) in
+         if no_spaces > 0 then space :: rev else
+         if is_space_required prev_orth prev_cat orth cat then space :: rev else rev in
        let rev = if sent = SentBeg then clause_beg :: sencence_beg :: rev else rev in
        let rev = (make_token orth lemma cat interp) :: rev in
        let rev = if sent = SentEnd then sencence_end :: clause_end :: rev else rev in
@@ -76,6 +91,20 @@ let rec set_lengths n rev = function
        set_lengths (n+len) ({t with beg=n; len=len; next=n+len} :: rev) l
   | [] -> List.rev rev
+(* FIXME: poprawić interpretacje przecinka i innych znaków interpunkcyjnych *)
+let rec set_special_tokens_lengths rev = function
+    ({token=Interp "<sentence>"} as sent) :: ({token=Interp "<clause>"} as cl) :: t :: l ->
+       let sent = {sent with len=1; next=sent.beg+1} in
+       let cl = {cl with beg=sent.next; len=1; next=sent.next+1} in
+       let t = {t with beg=t.beg+2; len=t.len-2} in
+       set_special_tokens_lengths (Token t :: Token cl :: Token sent :: rev) l
+  | ({orth="."; token=Lemma(".","interp",[[]])} as dot) :: ({token=Interp "</clause>"} as cl) :: {token=Interp "</sentence>"} :: l ->
+       let cl = {cl with beg=dot.beg; len=20; next=dot.beg+20} in
+       let dot = {dot with beg=cl.next; len=80; token= Interp "</sentence>"} in
+       set_special_tokens_lengths (Token dot :: Token cl :: rev) l
+  | t :: l -> set_special_tokens_lengths (Token t :: rev) l
+  | [] -> List.rev rev
+
 let render_paragraph tokens =
   String.concat "" (List.rev (Xlist.rev_map tokens (fun t -> t.orth)))
@@ -86,68 +115,36 @@ let rec get_next = function
   | Variant [] -> failwith "get_next"
   | Variant l -> get_next (List.hd l)
-let rec match_tokens erev nrev rev = function
+let make_seq  = function
+    [] -> failwith "make_seq"
+  | [t] -> t
+  | l -> Seq l
+
+let rec match_token_sequence erev nrev rev = function
     et :: ets, nt :: nts ->
-      let next = get_next et in
-      if next = nt.next then
-        match_tokens [] [] ((List.rev (et :: erev), List.rev (nt :: nrev)) :: rev) (ets,nts)
-      else if next < nt.next then
-        match_tokens (et :: erev) nrev rev (ets, nt :: nts)
-      else match_tokens erev (nt :: nrev) rev (et :: ets, nts)
-  | [],[] -> List.rev rev
-  | _ -> failwith "match_tokens"
-
-(*  let compare_token et t =
-  et.orth=t.orth && et.beg=t.beg && et.len=t.len && et.next=t.next && et.token=t.token
-
-let get_beg = function
-    Token t -> t.beg
-  | Seq [] -> failwith "get_beg"
-  | Seq l -> get_beg (List.hd l)
-  | Variant [] -> failwith "get_next"
-  | Variant l -> get_beg (List.hd l)
-
-let rec compare_tokens stats = function
-    Token et :: ets, t :: ts ->
-       if compare_token et t then compare_tokens stats (ets,ts) else (
-       Printf.printf "%s\n%s\n\n" (ENIAMtokens.string_of_token_env et) (ENIAMtokens.string_of_token_env t);
-       stats)
-  | Variant l :: ets, ts -> failwith "compare_tokens 4"
-  | Seq l :: ets, ts -> failwith "compare_tokens 3"
-  | [], ts -> failwith "compare_tokens 2"
-  | _, [] -> failwith "compare_tokens 1"
-
-let rec get_subsequence_rec next rev = function
-    t :: tokens -> if t.next = next then List.rev (t :: rev) else get_subsequence_rec next (t :: rev) tokens
-  | [] -> failwith "get_subsequence_rec"
-
-let get_subsequence beg next = function
-    t :: tokens -> if t.beg = beg then get_subsequence_rec next [] (t :: tokens) else failwith "get_subsequence 2"
-  | [] -> failwith "get_subsequence 1"
-
-let compare_token stats tokens = function
-    Token et :: ets, t :: ts ->
-       if compare_token et t then compare_tokens stats (ets,ts) else (
-       Printf.printf "%s\n%s\n\n" (ENIAMtokens.string_of_token_env et) (ENIAMtokens.string_of_token_env t);
-       stats)
-  | Variant l :: ets, ts -> failwith "compare_tokens 4"
-  | Seq l :: ets, ts -> failwith "compare_tokens 3"
-  | [], ts -> failwith "compare_tokens 2"
-  | _, [] -> failwith "compare_tokens 1"
-
-let rec compare_tokens stats tokens = function
-    et :: ets ->
-      let ts,tokens = get_subsequence (get_beg et) (get_next et) tokens in
-      compare_token stats ts et
-  | [] -> if tokens = [] then stats else failwith "compare_tokens 1"*)
-
-let rec compare_tokens stats = function
-    (ets,nts) :: l ->
-       Xlist.iter ets (fun et -> Printf.printf "%s\n" (ENIAMtokens.string_of_tokens 0 et));
-       Xlist.iter nts (fun nt -> Printf.printf "%s\n" (ENIAMtokens.string_of_token_env nt));
-       print_endline "";
-       compare_tokens stats l
-  | [] -> stats
+      let enext = get_next et in
+      let nnext = get_next nt in
+      if enext = nnext then
+        match_token_sequence [] [] ((List.rev (et :: erev), List.rev (nt :: nrev)) :: rev) (ets,nts)
+      else if enext < nnext then
+        match_token_sequence (et :: erev) nrev rev (ets, nt :: nts)
+      else match_token_sequence erev (nt :: nrev) rev (et :: ets, nts)
+  | [],[] -> Xlist.fold rev [] (fun l (et,nt) -> (make_seq et, make_seq nt) :: l)
+  | _ -> failwith "match_token_sequence"
+
+let rec compare_tokens = function
+    Token et, Token nt ->
+       et.orth = nt.orth && et.beg = nt.beg && et.len = nt.len && et.next = nt.next
+  | et,Variant l ->
+       Xlist.fold l true (fun b nt ->
+         compare_tokens (et,nt) && b)
+  | Variant l,nt ->
+       Xlist.fold l false (fun b et ->
+         compare_tokens (et,nt) || b)
+  | Seq[et], nt -> compare_tokens (et,nt)
+  | et, Seq[nt] -> compare_tokens (et,nt)
+  | Seq(et::ets),Seq(nt::nts) -> if compare_tokens (et,nt) then compare_tokens (Seq ets,Seq nts) else false
+  | _ -> false
 let validate stats name typ channel entries =
   (* if name = "120-2-900066" then ( *)
@@ -156,15 +153,21 @@ let validate stats name typ channel entries =
     Xlist.fold paragraphs stats (fun stats (paragraph,sentences) ->
       let tokens = flatten_sentences sentences in
       let tokens = allign "" "" [] tokens in
-      let tokens = set_lengths 0 [] tokens in
       let paragraph = render_paragraph tokens in
-      let tokens = remove_spaces [] tokens in
+      let tokens = set_lengths 0 [] tokens in
+      let tokens = set_special_tokens_lengths [] tokens in
+      let tokens = ENIAMpatterns.remove_spaces [] tokens in
       let eniam_tokens = ENIAMtokenizer.parse paragraph in
-      let l = match_tokens [] [] [] (eniam_tokens,tokens) in
-      compare_tokens stats l))
+      let l = match_token_sequence [] [] [] (eniam_tokens,tokens) in
+      Xlist.fold l stats (fun stats (eniam_token,nkjp_token) ->
+        if compare_tokens (eniam_token,nkjp_token) then stats else (
+          let s = Printf.sprintf "%s" (ENIAMtokens.string_of_tokens 0 eniam_token) in
+          let t = Printf.sprintf "%s" (ENIAMtokens.string_of_tokens 0 nkjp_token) in
+          Printf.printf "%s\n%s\n\n%!"  s t;
+          StringQMap.add stats (s ^ "\n" ^ t)))))
-let _ =
+(*let _ =
   let stats = ENIAM_NKJP.fold ENIAM_NKJP.nkjp_path StringQMap.empty (fun stats (name,typ,channel,entries) ->
     validate stats name typ channel entries) in
-  ()
+  ()*)