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

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
......@@ -47,21 +58,21 @@
:generate (fn [& [varname expr condition]]
{"$type" "Compute"
:Command "compute"
:variableNames [varname]
:expression expr
:condition condition
: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})
:Variable (variable-symbol-expression varname)
:Expression expr
:Condition condition})
:label_variable (fn [& [varname label]]
{"$type" "SetVariableLabel"
:Command "setVariableLabel"
:variableName varname
:label label})
:Variable (variable-symbol-expression varname)
:Label label})
:label_define (fn [& [defname codelist options]]
{"$type" ""
:name defname
......@@ -74,12 +85,12 @@
(cond->
{"$type" "SetValueLabels"
:Command "setValueLabels"
:variables (expand-varlist varlist *variables*)
:labels (map (fn [lab] {:value (first lab) :label (second lab)}) labels)}
: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"}]
:Messages
[{:MessageText (str "Undefined label list " codelistname)
:Severity "warning"}]
)
)
)
......@@ -88,13 +99,16 @@
:use (fn [& [filename]]
{"$type" "Load"
:Command "load"
:filename filename
: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"
: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]]
......@@ -107,8 +121,8 @@
: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"
......@@ -119,7 +133,7 @@
(let [expanded (expand-varlist varlist *variables*)]
{"$type" "DeleteVariables"
:Command "deleteVariables"
:variables expanded
:Variables (map variable-symbol-expression expanded)
:mod-varlist (vec (filter (comp not (set expanded)) *variables*))}
))
:keep_cases (fn [& [expr]]
......@@ -130,13 +144,13 @@
(let [expanded (expand-varlist varlist *variables*)]
{"$type" "KeepVariables"
:Command "keepVariables"
:variables expanded
: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))
......@@ -156,21 +170,21 @@
:power (expr-transform "power")
:negation (fn [& args]
(if (second args)
{:function "not"
:arguments (rest args)
{"$type" "FunctionCallExpression"
:Function "not"
:isSdtlName true
"$type" "FunctionCallExpression"}
: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 ".")
......@@ -285,34 +299,22 @@
: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,7 +41,48 @@
(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?
......@@ -60,6 +101,7 @@
))
)
(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