Upgrade dictionary implementation in core (#297)

core/src/acc_text/nlg/dictionary/impl.clj

@@ -0,0 +1,12 @@
+(ns acc-text.nlg.dictionary.impl
+  (:require [acc-text.nlg.dictionary.item :as dict-item]
+            [acc-text.nlg.dictionary.lang.eng :as eng]
+            [acc-text.nlg.dictionary.lang.other :as other]))
+
+(defmulti resolve-dict-item ::dict-item/language)
+
+(defmethod resolve-dict-item "Eng" [dict-item]
+  (eng/resolve-dict-item dict-item))
+
+(defmethod resolve-dict-item :default [dict-item]
+  (other/resolve-dict-item dict-item))

core/src/acc_text/nlg/dictionary/item.clj

@@ -15,10 +15,17 @@
 (s/def ::definition string?)
 
 (s/def ::category
-  #{"A" "A2" "Adv"
-    "N" "N2" "N3"
-    "PN" "Prep"
-    "V" "V0" "V2" "V3" "V2A" "V2Q" "V2S" "V2V" "VA" "VP" "VQ" "VS" "VV"})
+  #{"A" "A2"
+    "AdA" "AdN" "AdV" "Adv"
+    "Conj"
+    "IP"
+    "Interj"
+    "N" "N2" "N3" "NP" "PN"
+    "Post" "Prep"
+    "Pron"
+    "Quant"
+    "Subj"
+    "V" "V2" "V2A" "V2S" "V2V" "V2Q" "V3" "VA" "VQ" "VS" "VV"})
 
 (s/def ::language #{"Eng" "Ger" "Est" "Lit" "Lav" "Rus"})
 

core/src/acc_text/nlg/dictionary/lang/other.clj

@@ -0,0 +1,50 @@
+(ns acc-text.nlg.dictionary.lang.other
+  (:require [acc-text.nlg.dictionary.item :as dict-item]
+            [acc-text.nlg.dictionary.item.form :as dict-item-form]
+            [clojure.string :as str]))
+
+(defn escape-string [s]
+  (str/replace s #"\"" "\\\\\""))
+
+(defn join-forms [forms]
+  (->> forms
+       (map #(format "\"%s\"" (escape-string (::dict-item-form/value %))))
+       (str/join " ")))
+
+(defmulti resolve-dict-item (fn [{::dict-item/keys [language category]}]
+                              (str/join "/" [language category])))
+
+(defmethod resolve-dict-item :default [{::dict-item/keys [language category]}]
+  (throw (Exception. (format "Don't know how to resolve dictionary item category `%s` for language `%s`" category language))))
+
+(defmethod resolve-dict-item "Spa/N" [{::dict-item/keys [forms attributes]}]
+  (if (contains? attributes "Gender")
+    (format "(ParadigmsSpa.mkN %s ParadigmsSpa.%s)" (join-forms forms) (get attributes "Gender"))
+    (format "(ParadigmsSpa.mkN %s)" (join-forms forms))))
+
+(defmethod resolve-dict-item "Spa/V" [{::dict-item/keys [forms]}]
+  (format "(ParadigmsSpa.mkV %s)" (join-forms forms)))
+
+(defmethod resolve-dict-item "Spa/A" [{::dict-item/keys [forms]}]
+  (format "(ParadigmsSpa.mkA %s)" (join-forms forms)))
+
+(defmethod resolve-dict-item "Spa/Adv" [{::dict-item/keys [forms]}]
+  (format "(ParadigmsSpa.mkAdv %s)" (join-forms forms)))
+
+(defmethod resolve-dict-item "Spa/AdV" [{::dict-item/keys [forms]}]
+  (format "(ParadigmsSpa.mkAdV %s)" (join-forms forms)))
+
+(defmethod resolve-dict-item "Ger/V" [{::dict-item/keys [forms]}]
+  (format "(ParadigmsGer.mkV %s)" (join-forms forms)))
+
+(defmethod resolve-dict-item "Rus/A" [{::dict-item/keys [forms]}]
+  (format "(ParadigmsRus.mkA %s)" (join-forms forms)))
+
+(defmethod resolve-dict-item "Rus/N" [{::dict-item/keys [forms attributes]}]
+  (format "(ParadigmsRus.mkN %s MorphoRus.%s MorphoRus.%s)"
+          (join-forms (if (= 1 (count forms)) (repeat 13 (first forms)) forms))
+          (get attributes "Gender" "Masc")
+          (get attributes "Animacy" "Inanimate")))
+
+(defmethod resolve-dict-item "Rus/V" [{::dict-item/keys [forms attributes]}]
+  (format "(ParadigmsRus.mkV MorphoRus.%s %s)" (get attributes "Aspect") (join-forms forms)))

core/src/acc_text/nlg/generator.clj

@@ -27,10 +27,12 @@
                        cat))))
 
 (defn ->incomplete [lang {::grammar/keys [module cat fun lincat lin]}]
-  (format "incomplete concrete %sBody of %s = open Syntax, Grammar, %sLex, Paradigms%s in {%s\n}"
+  (format "incomplete concrete %sBody of %s = open Syntax, Grammar, %sLex, Morpho%s, Res%s, Paradigms%s in {%s\n}"
           module
           module
           module
+          (if (= lang "Lav") "Eng" lang)
+          lang
           lang
           (join-body
             "lincat" (->> lincat

core/src/acc_text/nlg/grammar/impl.clj

@@ -1,15 +1,15 @@
 (ns acc-text.nlg.grammar.impl
-  (:require [acc-text.nlg.grammar.dictionary-item :refer [build-dictionary-item]]
+  (:require [acc-text.nlg.dictionary.impl :as dictionary]
+            [acc-text.nlg.dictionary.item :as dict-item]
             [acc-text.nlg.graph.amr :refer [attach-amrs]]
             [acc-text.nlg.graph.categories :refer [resolve-categories]]
             [acc-text.nlg.graph.condition :refer [determine-conditions]]
             [acc-text.nlg.graph.data :refer [resolve-data]]
-            [acc-text.nlg.graph.dictionary-item :refer [resolve-dictionary-items]]
             [acc-text.nlg.graph.lists :refer [resolve-lists]]
             [acc-text.nlg.graph.modifier :refer [resolve-modifiers]]
             [acc-text.nlg.graph.paths :refer [resolve-paths]]
             [acc-text.nlg.graph.polarity :refer [resolve-polarity]]
-            [acc-text.nlg.graph.utils :refer [add-concept-position find-root-id get-in-edge get-successors prune-graph]]
+            [acc-text.nlg.graph.utils :refer [add-concept-position find-root-id get-successors prune-graph graph->tree]]
             [acc-text.nlg.graph.variables :refer [resolve-variables]]
             [acc-text.nlg.graph.segment :refer [add-paragraph-symbol]]
             [acc-text.nlg.semantic-graph.utils :refer [semantic-graph->ubergraph]]
@@ -21,9 +21,11 @@
 (def data-types #{:data :quote :dictionary-item})
 
 (defn node->cat [graph node-id]
-  (let [{:keys [type position]} (attrs graph node-id)]
-    (str (str/replace (name type) #"-" "_")
-         (format "%02d" (or position 0)))))
+  (let [{:keys [type position] :as attrs} (attrs graph node-id)]
+    (case type
+      :dictionary-item (str/replace (:label attrs) #"-" "_")
+      (str (str/replace (name type) #"-" "_")
+           (format "%02d" (or position 0))))))
 
 (defn s-node? [graph node-id]
   (let [category (:category (attrs graph node-id))]
@@ -81,18 +83,8 @@
     #:acc-text.nlg.grammar
         {:oper [[cat "Str" (format "\"%s\"" (str/replace value #"\"" "\\\\\""))]]}))
 
-(defmethod build-node :dictionary-item [graph node-id]
-  (let [cat (node->cat graph node-id)
-        in-edge-category (get-in graph [:attrs (:id (get-in-edge graph node-id)) :category])
-        {category :category :as attrs} (attrs graph node-id)]
-    #:acc-text.nlg.grammar
-        {:oper [[cat
-                 (cond
-                   (= "Str" in-edge-category) "Str"
-                   (= "Str" category) "{s : Str}"
-                   (nil? in-edge-category) "Text"
-                   :else category)
-                 (build-dictionary-item in-edge-category attrs)]]}))
+(defmethod build-node :dictionary-item [_ _]
+  #:acc-text.nlg.grammar{})
 
 (defmethod build-node :synonyms [graph node-id]
   (let [successors (get-successors graph node-id)
@@ -146,12 +138,21 @@
       (resolve-lists context)
       (resolve-modifiers context)
       (resolve-categories)
-      (resolve-dictionary-items context)
       (resolve-data context)
       (resolve-polarity)
       (resolve-paths context)
       (add-concept-position)))
 
+(defn build-dictionary-operations [context]
+  (map (fn [{::dict-item/keys [key category] :as dict-item}]
+         (let [resolved-item (dictionary/resolve-dict-item dict-item)]
+           [(str/replace key #"-" "_")
+            category
+            (if (string? resolved-item)
+              resolved-item
+              (str (graph->tree (semantic-graph->ubergraph resolved-item))))]))
+       (vals (:dictionary context))))
+
 (defn build-grammar
   ([semantic-graph context]
    (build-grammar "Default" "Instance" semantic-graph context))
@@ -174,5 +175,5 @@
                   :fun      {}
                   :lincat   {}
                   :lin      {}
-                  :oper     []}
+                  :oper     (build-dictionary-operations context)}
              (pre-traverse graph start-id)))))

core/src/acc_text/nlg/graph/data.clj

@@ -1,7 +1,5 @@
 (ns acc-text.nlg.graph.data
-  (:require [acc-text.nlg.dictionary.item :as dict-item]
-            [acc-text.nlg.graph.utils :refer [find-nodes get-in-edge]]
-            [acc-text.nlg.graph.dictionary-item :refer [get-dictionary-item add-dictionary-item]]
+  (:require [acc-text.nlg.graph.utils :refer [find-nodes get-in-edge]]
             [loom.attr :refer [attrs]]))
 
 (defn get-data [data key]
@@ -25,14 +23,12 @@
 (defn resolve-data [g {data :data dictionary :dictionary {lang "*Language"} :constants}]
   (reduce (fn [g [node-id {key :name}]]
             (let [category (find-data-category g node-id)
-                  value (get-data data key)
-                  dictionary-keys (group-by ::dict-item/key (vals dictionary))]
-              (cond
-                (contains? dictionary [value category]) (add-dictionary-item g node-id
-                                                                             (get-dictionary-item dictionary lang value category))
-                (contains? dictionary-keys value) (add-dictionary-item g node-id
-                                                                       (get-dictionary-item dictionary lang value
-                                                                                            (get-in dictionary-keys [value 0 ::dict-item/category])))
-                :else (update-in g [:attrs node-id] #(merge % {:type :quote :value value})))))
+                  value (get-data data key)]
+              (update-in g [:attrs node-id] #(merge % (if (contains? dictionary [value category])
+                                                        {:type     :dictionary-item
+                                                         :name     (format "%s_%s_%s" value category lang)
+                                                         :label    value
+                                                         :category category}
+                                                        {:type :quote :value value})))))
           g
           (concat (find-nodes g {:type :data}))))

core/src/acc_text/nlg/graph/utils.clj

@@ -1,10 +1,11 @@
 (ns acc-text.nlg.graph.utils
   (:require [acc-text.nlg.semantic-graph :as sg]
+            [clojure.set :as set]
+            [clojure.string :as str]
             [loom.alg :as alg]
             [loom.attr :refer [attrs]]
             [loom.graph :as graph]
-            [ubergraph.core :as uber]
-            [clojure.set :as set]))
+            [ubergraph.core :as uber]))
 
 (defn id-seq []
   (map #(keyword (format "%02d" %)) (rest (range))))
@@ -46,6 +47,9 @@
 (defn find-root-id [g]
   (ffirst (find-nodes g {:type :document-plan})))
 
+(defn find-root-nodes [g]
+  (filter #(nil? (get-in-edge g %)) (graph/nodes g)))
+
 (defn prune-detached-nodes [g root-id]
   (apply graph/remove-nodes g
          (set/difference
@@ -86,5 +90,17 @@
                                  (merge {:id (uuid->id id)} concept)))
                           (sort-by :id))}))
 
+(defn escape-string [s]
+  (str/replace s #"\"" "\\\\\""))
+
+(defn graph->tree
+  ([g] (graph->tree g (first (find-root-nodes g))))
+  ([g root-node]
+   (let [{:keys [type name module value]} (attrs g root-node)]
+     (case type
+       :quote (escape-string value)
+       :operation (cons (symbol (str module "." name))
+                        (map #(graph->tree g %) (get-successors g root-node)))))))
+
 (defn save-graph [graph filename]
   (uber/viz-graph graph {:auto-label true :save {:format :png :filename filename}}))