Adopt document plan grammar generation to use GF operations

api/src/data/entities/amr.clj

@@ -14,7 +14,7 @@
                                  :syntax   (for [instance syntax]
                                              (reduce-kv (fn [m k v]
                                                           (assoc m k (cond-> v
-                                                                             (not (contains? #{:value :role :roles} k))
+                                                                             (not (contains? #{:value :role :roles :ret} k))
                                                                              (keyword))))
                                                         {}
                                                         (into {} instance)))})

api/test/api/end_to_end_test.clj

@@ -11,6 +11,10 @@
                                       :name         "cut"
                                       :phrases      ["cut"]
                                       :partOfSpeech :VB})
+  (dictionary/create-dictionary-item {:key          "at-location"
+                                      :name         "at-location"
+                                      :phrases      ["arena" "place" "venue"]
+                                      :partOfSpeech :NOUN})
   (f))
 
 (use-fixtures :each fixtures/clean-db prepare-environment)
@@ -64,8 +68,8 @@
 
 (deftest ^:integration authorship-document-plan-bulk-generation
   (let [data {"9780307743657" {:title "The Shinning" :author "Stephen King"}
-              "9780575099999" {:title "Horns"        :author "Joe Hill"}
-              "9780099765219" {:title "Fight Club"   :author "Chuck Palahniuk"}}
+              "9780575099999" {:title "Horns" :author "Joe Hill"}
+              "9780099765219" {:title "Fight Club" :author "Chuck Palahniuk"}}
         {{result-id :resultId} :body status :status} (generate-bulk "authorship" data)]
     (is (= 200 status))
     (is (some? result-id))
@@ -221,3 +225,15 @@
     (is (= 200 status))
     (is (some? result-id))
     (is (= #{"Computers book."} (-> result-id (get-variants) :sample)))))
+
+(deftest ^:integration location-amr-plan-generation
+  (let [{{result-id :resultId} :body status :status} (generate "location-amr" "books.csv")]
+    (is (= 200 status))
+    (is (some? result-id))
+    (is (= #{"In the city centre there is a place Alimentum."
+             "In the city centre there is a venue Alimentum."
+             "In the city centre there is an arena Alimentum."
+             "There is a place in the city centre Alimentum."
+             "There is a venue in the city centre Alimentum."
+             "There is an Alimentum in the city centre."
+             "There is an arena in the city centre Alimentum."} (-> result-id (get-variants) :sample)))))

api/test/resources/document_plans/location-amr.edn

@@ -1,12 +1,12 @@
 {:type     "Document-plan"
  :segments [{:children [{:roles          [{:children [{:type  "Quote"
                                                        :srcId "uf:[gtVTc!uQe%WeEy${"
-                                                       :text  "Alimentum"}]
-                                           :name     "name"}
+                                                       :text  "city centre"}]
+                                           :name     "objectref"}
                                           {:children [{:type  "Quote"
                                                        :srcId "#UU2hr35[NTazfg6d7JV"
-                                                       :text  "city centre"}]
-                                           :name     "location"}]
+                                                       :text  "Alimentum"}]
+                                           :name     "locationdata"}]
                          :dictionaryItem {:name   "at-location"
                                           :type   "Dictionary-item"
                                           :srcId  "5SgtK-{hj)?WV7+(Y=o."

api/test/resources/grammar/concept-net/at-location.yaml

@@ -0,0 +1,19 @@
+members:
+  - place
+  - venue
+  - arena
+roles:
+  - objectRef
+  - locationData
+frames:
+  - example: There is a place in the city center, KFC
+    syntax:
+      - type: gf
+        value: atLocation
+        roles:
+          - objectRef
+          - locationData
+        ret:
+          - N
+          - N
+          - N

api/test/resources/grammar/default.yaml

@@ -6,3 +6,4 @@ includes:
   - library/genre.yaml
   - other/cut.yaml
   - other/see.yaml
+  - concept-net/at-location.yaml

core/gf/concept-net/ConceptNetEng.gf

@@ -1,3 +1,35 @@
-concrete ConceptNetEng of ConceptNet = ConceptNetI with 
-         (Syntax = SyntaxEng),
-         (LexConceptNet = LexConceptNetEng);
+resource ConceptNetEng = open SyntaxEng, ParadigmsEng, UtilsEng in {
+
+  oper -- atLocation
+    SS : Type = {s : Str} ;
+
+    -- There is a place in the LOCATION
+    placeInLocation : N -> N -> N -> SS =
+        \locationDictionary,locationData,objectRef ->
+            (mkUtt (mkThereIsAThing (mkCN locationDictionary (mkInAdv locationData)) objectRef)) ;
+
+    -- In the LOCATION there is a place
+    inLocationPlace : N -> N -> N -> SS =
+        \locationDictionary,locationData,objectRef ->
+            (mkUtt (mkS (mkInAdv locationData) (mkS presentSimTemp positivePol (mkThereIsAThing locationDictionary objectRef)))) ;
+
+    -- VENUE in the LOCATION
+    venueInLocation : N -> N -> N -> SS =
+        \locationDictionary,locationData,objectRef ->
+            (mkUtt (mkThereIsAThing objectRef (mkInAdv locationData))) ;
+
+    atLocation : N -> N -> N -> SS =
+        \lexicon,arg0,arg1 ->
+            ((placeInLocation lexicon arg0 arg1) | (inLocationPlace lexicon arg0 arg1) | (venueInLocation lexicon arg0 arg1)) ;
+
+  oper -- hasProperty
+
+    itHas : A -> N -> SS =
+        \propertyName,object ->
+            (mkS presentSimTemp positivePol (mkCl (mkNP object) propertyName)) ;
+
+    hasProperty : A -> N -> SS =
+        \lexicon,arg0 ->
+            (mkUtt (itHas lexicon arg0)) ;
+
+}

core/src/acc_text/nlg/gf/generator.clj

@@ -53,27 +53,27 @@
 
 (declare join-function-body)
 
-(defn join-expression [expr]
+(defn join-expression [expr ret]
   (if (sequential? expr)
-    (cond->> (join-function-body expr)
+    (cond->> (join-function-body expr ret)
              (< 1 (count expr)) (format "(%s)"))
     (let [{:keys [type value params]} expr]
       (case type
-        :literal (format "\"%s\"" (escape-string value))
+        :literal (cond->> (format "\"%s\"" (escape-string value))
+                          (not= "Str" (second ret)) (format "(mk%s %s)" (second ret)))
         :function (format "%s.s" value)
-        :gf #_(format "%s.s" value)
-        (format "%s %s.s" value (str/join (interleave params (repeat " "))))))))
+        :gf (format "(%s %s).s" value (str/join " " (map #(str % ".s") (filter some? params))))))))
 
 (defn get-operator [expr next-expr]
   (when (some? next-expr)
     (if (some sequential? [expr next-expr])
       "|"
       "++")))
 
-(defn join-function-body [body]
+(defn join-function-body [body ret]
   (str/join " " (map (fn [expr next-expr]
                        (let [operator (get-operator expr next-expr)]
-                         (cond-> (join-expression expr)
+                         (cond-> (join-expression expr ret)
                                  (some? operator) (str " " operator))))
                      body
                      (concat (rest body) [nil]))))
@@ -84,7 +84,7 @@
                          (inc i)
                          (str/join (interleave params (repeat " ")))
                          (name (nth ret 0))
-                         (if (seq body) (join-function-body body) "\"\"")))
+                         (if (seq body) (join-function-body body ret) "\"\"")))
                syntax))
 
 (defn ->abstract [{::grammar/keys [module flags syntax]}]
@@ -99,7 +99,7 @@
   (format "concrete %s of %s = open %s in {%s\n}"
           (str (name module) (name instance))
           (name module)
-          "LangFunctionsEng, ConceptNetEng"
+          "LangFunctionsEng, ConceptNetEng, SyntaxEng, ParadigmsEng"
           (join-body
             "param" (parse-param syntax)
             "lincat" (parse-lincat syntax)

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

@@ -15,7 +15,7 @@
         (zipmap relations concepts)))
 
 (defn attach-selectors [m attrs]
-  (let [selectors (->> (keys attrs) (remove #{:pos :role :roles :value :type}) (select-keys attrs))]
+  (let [selectors (->> (keys attrs) (remove #{:pos :role :roles :ret :value :type}) (select-keys attrs))]
     (cond-> m (seq selectors) (assoc :selectors selectors))))
 
 (defmulti build-function (fn [concept _ _ _] (:type concept)))
@@ -28,29 +28,29 @@
               :value (concept->name child-concept)})
    :ret    [:s "Str"]})
 
-(defmethod build-function :data [{value :value :as concept} _ _ _]
+(defmethod build-function :data [{value :value :as concept} _ _ {types :types}]
   {:name   (concept->name concept)
    :params []
    :body   [{:type  :literal
              :value (format "{{%s}}" value)}]
-   :ret    [:s "Str"]})
+   :ret    [:s (get types (concept->name concept) "Str")]})
 
-(defmethod build-function :quote [{value :value :as concept} _ _ _]
+(defmethod build-function :quote [{value :value :as concept} _ _ {types :types}]
   {:name   (concept->name concept)
    :params []
    :body   [{:type  :literal
              :value value}]
-   :ret    [:s "Str"]})
+   :ret    [:s (get types (concept->name concept) "Str")]})
 
-(defmethod build-function :dictionary-item [{value :value {name :name} :attributes :as concept} _ _ {dictionary :dictionary}]
+(defmethod build-function :dictionary-item [{value :value {name :name} :attributes :as concept} _ _ {:keys [types dictionary]}]
   {:name   (concept->name concept)
    :params []
    :body   (for [dict-value (let [dict-entry (get dictionary value)]
                               (set (cond->> dict-entry
                                             (empty? dict-entry) (cons (or name value)))))]
              [{:type  :literal
                :value dict-value}])
-   :ret    [:s "Str"]})
+   :ret    [:s (get types (concept->name concept) "Str")]})
 
 (defmethod build-function :modifier [concept children relations _]
   (let [child-concept (get-child-with-role children relations :child)
@@ -83,9 +83,9 @@
                                                         :value (get role-map role-key)}
                          (= :gf type) {:type   :gf
                                        :value  value
-                                       :params
-                                       (cons (concept->name function-concept) (map role-map roles))
-                                       #_(when function-concept (cons (concept->name function-concept) (map role-map roles)))}
+                                       :params (cond->> (map (comp role-map str/lower-case) roles)
+                                                        (some? function-concept)
+                                                        (cons (concept->name function-concept)))}
                          (some? role) {:type  :literal
                                        :value (format "{{%s}}" role)}
                          (= pos :AUX) {:type  :function
@@ -126,12 +126,34 @@
                :value (concept->name child-concept)}])
    :ret    [:s "Str"]})
 
+(defn find-types [concept-map relation-map {amr :amr}]
+  (reduce (fn [m {:keys [id value]}]
+            (let [relations (get relation-map id)
+                  children (map (comp concept-map :to) relations)
+                  function-concept (get-child-with-role children relations :function)
+                  role-map (reduce (fn [m [{role :role {attr-name :name} :attributes} concept]]
+                                     (cond-> m
+                                             (and (not= :function role)
+                                                  (some? attr-name)) (assoc (str/lower-case attr-name) (concept->name concept))))
+                                   {}
+                                   (zipmap relations children))
+                  {:keys [ret roles]} (-> amr (get (keyword value)) (:frames) (first) (:syntax) (first))]
+              (cond-> m
+                      (seq ret) (merge (zipmap (cond->> (map (comp role-map str/lower-case) roles)
+                                                        (some? function-concept)
+                                                        (cons (concept->name function-concept)))
+                                               ret)))))
+          {}
+          (filter #(= :amr (:type %)) (vals concept-map))))
+
 (defn build-grammar [module instance {::sg/keys [concepts relations]} context]
   #:acc-text.nlg.gf.grammar{:module   module
                             :instance instance
                             :flags    {:startcat (concept->name (first concepts))}
                             :syntax   (let [concept-map (zipmap (map :id concepts) concepts)
-                                            relation-map (group-by :from relations)]
+                                            relation-map (group-by :from relations)
+                                            type-map (find-types concept-map relation-map context)
+                                            context (assoc context :types type-map)]
                                         (map (fn [{id :id :as concept}]
                                                (let [relations (get relation-map id)
                                                      children (map (comp concept-map :to) relations)]

core/test/acc_text/nlg/gf/generator_test.clj

@@ -9,16 +9,21 @@
 
 (deftest ^:integration quote-cases
   (is (= ["He said: \"GO!\""] (let [semantic-graph (utils/load-test-semantic-graph "quote")
-                                    grammar        (grammar/build :grammar :1 semantic-graph {})]
+                                    grammar (grammar/build :grammar :1 semantic-graph {})]
                                 (generate grammar)))))
 
 (deftest ^:integration at-location
-  (is (get (set (generate (grammar/build :AtLoc :1 (utils/load-test-semantic-graph "location-amr")
-                                         {:amr
-                                          {:at-location
-                                           {:frames
-                                            [{:examples ["There is a place in the city center"]
-                                              :syntax
-                                              [{:type :gf :value "AtLocation"}]}]}}
-                                          :dictionary {}})))
-           "there is a [VENUE_NAME_ARG] in the [LOCATION_ARG]")))
+  (is (= ["in the city centre there is a place Alimentum"
+          "in the city centre there is a venue Alimentum"
+          "in the city centre there is an arena Alimentum"
+          "there is a place in the city centre Alimentum"
+          "there is a venue in the city centre Alimentum"
+          "there is an Alimentum in the city centre"
+          "there is an arena in the city centre Alimentum"]
+         (generate (grammar/build :AtLoc :1 (utils/load-test-semantic-graph "location-amr")
+                                  {:amr        {:at-location
+                                                {:frames [{:syntax [{:type  :gf
+                                                                     :value "atLocation"
+                                                                     :roles ["objectRef" "locationData"]
+                                                                     :ret   ["N" "N" "N"]}]}]}}
+                                   :dictionary {"at-location" ["arena" "place" "venue"]}})))))