Skip to content

Commit

Permalink
Upgrade dictionary implementation in core (#297)
Browse files Browse the repository at this point in the history
  • Loading branch information
rokasramas committed Mar 16, 2021
1 parent 9e212c9 commit a322f9b
Show file tree
Hide file tree
Showing 16 changed files with 2,561 additions and 528 deletions.
12 changes: 12 additions & 0 deletions core/src/acc_text/nlg/dictionary/impl.clj
Original file line number Diff line number Diff line change
@@ -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))
15 changes: 11 additions & 4 deletions core/src/acc_text/nlg/dictionary/item.clj
Original file line number Diff line number Diff line change
Expand Up @@ -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"})

Expand Down
1,161 changes: 1,161 additions & 0 deletions core/src/acc_text/nlg/dictionary/lang/eng.clj

Large diffs are not rendered by default.

50 changes: 50 additions & 0 deletions core/src/acc_text/nlg/dictionary/lang/other.clj
Original file line number Diff line number Diff line change
@@ -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)))
4 changes: 3 additions & 1 deletion core/src/acc_text/nlg/generator.clj
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
104 changes: 0 additions & 104 deletions core/src/acc_text/nlg/grammar/dictionary_item.clj

This file was deleted.

41 changes: 21 additions & 20 deletions core/src/acc_text/nlg/grammar/impl.clj
Original file line number Diff line number Diff line change
@@ -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]]
Expand All @@ -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))]
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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))
Expand All @@ -174,5 +175,5 @@
:fun {}
:lincat {}
:lin {}
:oper []}
:oper (build-dictionary-operations context)}
(pre-traverse graph start-id)))))
20 changes: 8 additions & 12 deletions core/src/acc_text/nlg/graph/data.clj
Original file line number Diff line number Diff line change
@@ -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]
Expand All @@ -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}))))
25 changes: 0 additions & 25 deletions core/src/acc_text/nlg/graph/dictionary_item.clj

This file was deleted.

20 changes: 18 additions & 2 deletions core/src/acc_text/nlg/graph/utils.clj
Original file line number Diff line number Diff line change
@@ -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))))
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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}}))

0 comments on commit a322f9b

Please sign in to comment.