Commit 4bd85e68 authored by Sigbjørn Revheim's avatar Sigbjørn Revheim

Adding support for some of the latest changes in SDTL

parent b4fb5cd4
......@@ -26,6 +26,17 @@
:auto-whitespace (parser "whitespace = #'[ \t\f\r\n]+'")
)
(defn number-range-expression
[from to increment]
{"$type" "NumberRangeExpression"
:NumberRangeStart from
:NumberRangeEnd to
:NumberRangeIncrement increment})
(defn variable-symbol-expression
[varname]
{"$type" "VariableSymbolExpression"
:VariableName varname})
;; mapping of grammar production names to transformation functions
(def transformations
......@@ -36,108 +47,111 @@
:analysis (fn [& args] {"$type" "Analysis"
:Command "analysis"
:message (str "Ignoring \"" (-> args first trim) "\"")})
:invalid (fn [& args] {"$type" "Invalid"
:Command "invalid"
:message (str "Invalid/unexpected syntax for \"" (-> args first trim) "\"")
:invalid (fn [& args] {"$type" "Invalid"
:Command "invalid"
:message (str "Invalid/unexpected syntax for \"" (-> args first trim) "\"")
:messages [{:messageText (str "Invalid syntax for " (first args))
:severity "error"}]})
:unsupported (fn [& args] {"$type" "Unsupported"
:Command "unsupported"})
:unrecognized (fn [& args] (first args))
:generate (fn [& [varname expr condition]]
{"$type" "Compute"
:Command "compute"
:variableNames [varname]
:expression expr
:condition condition
:mod-varlist (conj *variables* varname)})
{"$type" "Compute"
:Command "compute"
:Variable (variable-symbol-expression varname)
:Expression expr
:Condition condition
:mod-varlist (conj *variables* varname)})
:replace (fn [& [varname expr condition]]
{"$type" "Compute"
:Command "compute"
:variableNames [varname]
:expression expr
:condition condition})
{"$type" "Compute"
:Command "compute"
:Variable (variable-symbol-expression varname)
:Expression expr
:Condition condition})
:label_variable (fn [& [varname label]]
{"$type" "SetVariableLabel"
:Command "setVariableLabel"
:variableName varname
:label label})
{"$type" "SetVariableLabel"
:Command "setVariableLabel"
:Variable (variable-symbol-expression varname)
:Label label})
:label_define (fn [& [defname codelist options]]
{"$type" ""
:name defname
:codelist codelist
:options options})
{"$type" ""
:name defname
:codelist codelist
:options options})
:codelist (fn [& args] args)
:value_label (fn [& [value label]] {value label})
:label_values (fn [& [varlist codelistname]]
(let [labels (get *codelists* codelistname)]
(cond->
{"$type" "SetValueLabels"
:Command "setValueLabels"
:variables (expand-varlist varlist *variables*)
:labels (map (fn [lab] {:value (first lab) :label (second lab)}) labels)}
(not labels) (assoc
:messages
[{:messageText (str "Undefined label list " codelistname)
:severity "warning"}]
)
)
)
(let [labels (get *codelists* codelistname)]
(cond->
{"$type" "SetValueLabels"
:Command "setValueLabels"
:Variables (map variable-symbol-expression (expand-varlist varlist *variables*))
:Labels (map (fn [lab] {:Value (first lab) :Label (second lab)}) labels)}
(not labels) (assoc
:Messages
[{:MessageText (str "Undefined label list " codelistname)
:Severity "warning"}]
)
)
)
)
:by_clause (fn [& args] (first args))
:use (fn [& [filename]]
{"$type" "Load"
:Command "load"
:filename filename
:mod-varlist (get *other-vars* filename (:default *other-vars*))})
{"$type" "Load"
:Command "load"
:FileName filename
:Software "Stata"
:IsCompressed false
:mod-varlist (get *other-vars* filename (:default *other-vars*))})
:save (fn [& [filename]]
{"$type" "Save"
:Command "save"
:filename filename
:software "stata"
:mod-other-vars (assoc *other-vars* filename *variables*)})
{"$type" "Save"
:Command "save"
:FileName filename
:Software "Stata"
:IsCompressed false
:mod-other-vars (assoc *other-vars* filename *variables*)})
:quoted_use_arg (fn [& args] (first args))
:order_vars (fn [& [varlist options]]
(let [newlist (reorder-variables (expand-varlist varlist *variables*) options)]
{"$type" ""
:Command "order"
:variables (expand-varlist varlist *variables*)
:how (keys options)
:result (diff-varlists *variables* newlist)
:mod-varlist newlist}))
(let [newlist (reorder-variables (expand-varlist varlist *variables*) options)]
{"$type" ""
:Command "order"
:variables (expand-varlist varlist *variables*)
:how (keys options)
:result (diff-varlists *variables* newlist)
:mod-varlist newlist}))
:format_vars (fn [& args] {"$type" "SetDisplayFormat"
:Command "setDisplayFormat"
:format (if (-> args first string?) (first args) (second args))
:variables (expand-varlist (if (-> args first string?) (second args) (first args)) *variables*)})
:Format (if (-> args first string?) (first args) (second args))
:Variables (map variable-symbol-expression (expand-varlist (if (-> args first string?) (second args) (first args)) *variables*))})
:drop_cases (fn [& [expr]]
{"$type" "Select"
:Command "select"
:condition {:function "not"
:isSdtlName true
:arguments [expr]}})
{"$type" "Select"
:Command "select"
:condition {:function "not"
:isSdtlName true
:arguments [expr]}})
:drop_vars (fn [& [varlist]]
(let [expanded (expand-varlist varlist *variables*)]
{"$type" "DeleteVariables"
:Command "deleteVariables"
:variables expanded
:mod-varlist (vec (filter (comp not (set expanded)) *variables*))}
))
(let [expanded (expand-varlist varlist *variables*)]
{"$type" "DeleteVariables"
:Command "deleteVariables"
:Variables (map variable-symbol-expression expanded)
:mod-varlist (vec (filter (comp not (set expanded)) *variables*))}
))
:keep_cases (fn [& [expr]]
{"$type" "Select"
:Command "select"
:condition expr})
{"$type" "Select"
:Command "select"
:condition expr})
:keep_vars (fn [& [varlist]]
(let [expanded (expand-varlist varlist *variables*)]
{"$type" "KeepVariables"
:Command "keepVariables"
:variables expanded
:mod-varlist (vec (filter (set expanded) *variables*))}))
(let [expanded (expand-varlist varlist *variables*)]
{"$type" "KeepVariables"
:Command "keepVariables"
:Variables (map variable-symbol-expression expanded)
:mod-varlist (vec (filter (set expanded) *variables*))}))
:rename (fn [& args] {"$type" "Rename"
:Command "rename"
:renames [{
:oldName (first args)
:newName (second args)
}]
:Renames [{"$type" "RenamePair"
:OldVariable (variable-symbol-expression (first args))
:NewVariable (variable-symbol-expression (second args))
}]
:mod-varlist (vec (map #(if (= % (first args)) (second args) %) *variables*))})
:filter (fn [& args] (first args))
:expression (fn [& args] (first args))
......@@ -156,21 +170,21 @@
:power (expr-transform "power")
:negation (fn [& args]
(if (second args)
{:function "not"
:arguments (rest args)
:isSdtlName true
"$type" "FunctionCallExpression"}
{"$type" "FunctionCallExpression"
:Function "not"
:isSdtlName true
:Arguments (rest args)}
(first args)
)
)
:primary (fn [& [prim]]
(cond
(number? prim) {"$type" "NumericConstantExpression" , :value prim}
(string? prim) {"$type" "StringConstantExpression" , :value prim}
(number? prim) {"$type" "NumericConstantExpression", :value prim}
(string? prim) {"$type" "StringConstantExpression", :value prim}
:else prim
)
)
:varname_operand (fn [& args] {:variableName (first args), "$type" "VariableSymbolExpression"})
:varname_operand (fn [& args] (variable-symbol-expression (first args)))
:parenthesized (fn [& args] (first args))
:number (fn [& [numlit]]
(if (starts-with? numlit ".")
......@@ -184,19 +198,19 @@
{"$type" "MissingValueConstantExpression"
:value value})
:recode (fn [& [vars rules filter options]]
(let [varlist (recode-varlist (expand-varlist vars *variables*) (or options {}))]
{"$type" "Recode"
:Command "recode"
:recodedVariables varlist
:rules (apply-options-to-rules rules (or options {}))
:mod-varlist (vec (concat *variables* (extract-target-variables varlist)))}))
(let [varlist (recode-varlist (expand-varlist vars *variables*) (or options {}))]
{"$type" "Recode"
:Command "recode"
:recodedVariables varlist
:rules (apply-options-to-rules rules (or options {}))
:mod-varlist (vec (concat *variables* (extract-target-variables varlist)))}))
:simple_recode (fn [& [varname rules filter options]]
(let [varlist (recode-varlist [varname] (or options {}))]
{"$type" "Recode"
:Command "recode"
:recodedVariables varlist
:rules (apply-options-to-rules rules (or options {}))
:mod-varlist (vec (concat *variables* (extract-target-variables varlist)))}))
(let [varlist (recode-varlist [varname] (or options {}))]
{"$type" "Recode"
:Command "recode"
:recodedVariables varlist
:rules (apply-options-to-rules rules (or options {}))
:mod-varlist (vec (concat *variables* (extract-target-variables varlist)))}))
:reshape_long (fn [& [stublist options]]
(if stublist
(let [make (reduce (fn [a b] (assoc a b (filter #(starts-with? % b) *variables*))) {} stublist)]
......@@ -221,31 +235,31 @@
(merge {:variables vars} aggstat)
)
:collapse_percentile (fn [& [arg]] {:aggstat "p" :p (->> arg rest (apply str) (read-string))})
:collapse_semean (fn [& _] {:aggstat "semean"})
:collapse_sebinomial (fn [& _] {:aggstat "sebinomial"})
:collapse_sepoisson (fn [& _] {:aggstat "sepoisson"})
:collapse_semean (fn [& _] {:aggstat "semean"})
:collapse_sebinomial (fn [& _] {:aggstat "sebinomial"})
:collapse_sepoisson (fn [& _] {:aggstat "sepoisson"})
:collapse_other (fn [& [arg]] {:aggstat arg})
:merge (fn [& args]
(let [options (nth args 3 nil)
gen-merge (get-var-length-option :generate 3 options)
(let [options (nth args 3 nil)
gen-merge (get-var-length-option :generate 3 options)
keep-using (get-var-length-option :keepusing 6 options)
other-vars (get *other-vars* (nth args 2))]
{"$type" ""
{"$type" ""
:Command "merge"
:mod-varlist (concat
*variables*
(cond->> (filter (comp not (set *variables*)) other-vars)
keep-using (filter (set (expand-varlist (first (get options keep-using)) other-vars)))
)
(cond
(get-var-length-option :nogenerate 5 options) nil
gen-merge (first (get options gen-merge))
:else ["_merge"]
))
:options options
:cardinality (first args)
:keys (expand-varlist (second args) *variables*)
:using (nth args 2)
*variables*
(cond->> (filter (comp not (set *variables*)) other-vars)
keep-using (filter (set (expand-varlist (first (get options keep-using)) other-vars)))
)
(cond
(get-var-length-option :nogenerate 5 options) nil
gen-merge (first (get options gen-merge))
:else ["_merge"]
))
:options options
:cardinality (first args)
:keys (expand-varlist (second args) *variables*)
:using (nth args 2)
}
)
)
......@@ -269,50 +283,38 @@
generate (get-var-length-option :generate 3 options)
keep (first (:keep options))
varlist (cond->> files
true (map #(get *other-vars* %))
true (reduce concat)
keep (#(filter (set (expand-varlist keep %)) %))
generate (concat (first (get options generate)))
true (concat *variables*)
true distinct
)]
{"$type" ""
:Command "append"
:files (first args)
:options (second args)
true (map #(get *other-vars* %))
true (reduce concat)
keep (#(filter (set (expand-varlist keep %)) %))
generate (concat (first (get options generate)))
true (concat *variables*)
true distinct
)]
{"$type" ""
:Command "append"
:files (first args)
:options (second args)
:mod-varlist varlist
}))
:filelist (fn [& args] args)
:varlist (fn [& args] args)
:numlist (fn [& args]
{"$type" "NumberListExpression"
:values args}
{"$type" "ValueListExpression"
:Values args}
)
:simple_range (fn [& [from to]]
{"$type" "NumberRangeExpression"
:from from
:to to
:step 1}
)
(number-range-expression from to 1))
:step_range (fn [& [from step to]]
{"$type" "NumberRangeExpression"
:from from
:to to
:step step}
)
(number-range-expression from to step))
:diff_step_range (fn [& [from second to]]
{"$type" "NumberRangeExpression"
:from from
:to to
:step (- second from)}
)
(number-range-expression from to (- second from)))
:varRange (fn [& args] {:first (first args) :last (second args)})
:rules (fn [& args] args)
:simple_rules (fn [& args] args)
:elementlist (fn [& args] args)
:nonmissing_values (fn [& _] "nonmissing")
:missing_values (fn [& _] "missing")
:other_values (fn [& _] "else")
:nonmissing_values (fn [& _] {"$type" "UnhandledNonmissingValuesExpression"})
:missing_values (fn [& _] {"$type" "UnhandledMissingValuesExpression"})
:other_values (fn [& _] {"$type" "UnhandledValuesExpression"})
:element_range (fn [& args] {:first (first args) :last (second args)})
:rule transform-recode-rule
:simple_rule transform-recode-rule
......@@ -322,7 +324,7 @@
:egen_expr egen-expr
:comment (fn [& args] {"$type" "Comment"
:Command "comment"
:commentText (trim (first args))})
:CommentText (trim (first args))})
}
)
......
......@@ -41,25 +41,67 @@
(filter (comp not nil?) (map #(:target %) variables))
)
(defn transform-recode-rule
[& args]
(m/filter-vals
some?
{:FromValue (cond
(= (first (first args)) "min") [{"$type" "NumericMinimumValueExpression"}]
(= (first (first args)) "max") [{"$type" "NumericMaximumValueExpression"}]
(= (first (first args)) "missing") [{"$type" "UnhandledMissingValuesExpression"}]
(= (first (first args)) "nonmissing") [{"$type" "UnhandledNonmissingValuesExpression"}]
(= (first (first args)) "else") [{"$type" "UnhandledValuesExpression"}]
:default args)
:To (second args)
:Label (if (> (count args) 2) (nth args 2))}))
(defn transform-recode-rule2
[& args]
(m/filter-vals
some?
{:FromValue (cond
(= (first (first args)) "min") [{"$type" "NumericMinimumValueExpression"}]
(= (first (first args)) "max") [{"$type" "NumericMaximumValueExpression"}]
:default (let [values (filter number? (first args))
ranges (filter map? (first args))]
(cond-> {:args args :fTo (second args), :Label (if (> (count args) 2) (nth args 2))}
(not-empty values) (assoc :FromValue values)
(not-empty ranges) (assoc :fromValueRange ranges)
)
))
:To (second args)
:Label (if (> (count args) 2) (nth args 2))}))
(defn transform-recode-rule_test
[& args]
(m/filter-vals
some?
{:specialFromValue (first args)
:to (second args)
:label (if (> (count args) 2) (nth args 2))})
)
(defn transform-recode-rule_original
[& args]
(m/filter-vals
some?
(if (string? (first args))
{:specialFromValue (first args)
:to (second args)
:label (if (> (count args) 2) (nth args 2))}
;; else
(let [values (filter number? (first args))
ranges (filter map? (first args))]
(cond-> {:to (second args), :label (if (> (count args) 2) (nth args 2))}
(not-empty values) (assoc :fromValue values)
(not-empty ranges) (assoc :fromValueRange ranges)
)
)
))
{:specialFromValue (first args)
:to (second args)
:label (if (> (count args) 2) (nth args 2))}
;; else
(let [values (filter number? (first args))
ranges (filter map? (first args))]
(cond-> {:to (second args), :label (if (> (count args) 2) (nth args 2))}
(not-empty values) (assoc :fromValue values)
(not-empty ranges) (assoc :fromValueRange ranges)
)
)
))
)
(defn make-seq-comparable [s]
(let [digit-set #{\0 \1 \2 \3 \4 \5 \6 \7 \8 \9}]
{:content s
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment