[rkward-cvs] SF.net SVN: rkward-code:[4867] trunk/rkward/tests
tfry at users.sf.net
tfry at users.sf.net
Thu Oct 2 13:39:59 UTC 2014
Revision: 4867
http://sourceforge.net/p/rkward/code/4867
Author: tfry
Date: 2014-10-02 13:39:58 +0000 (Thu, 02 Oct 2014)
Log Message:
-----------
Add plugin tests for recode_categorical
Modified Paths:
--------------
trunk/rkward/tests/data_plugin_tests.R
Added Paths:
-----------
trunk/rkward/tests/data_plugin_tests/recode_cateorigal.messages.txt
trunk/rkward/tests/data_plugin_tests/recode_cateorigal.rkcommands.R
trunk/rkward/tests/data_plugin_tests/recode_cateorigal.rkout
Added: trunk/rkward/tests/data_plugin_tests/recode_cateorigal.messages.txt
===================================================================
--- trunk/rkward/tests/data_plugin_tests/recode_cateorigal.messages.txt (rev 0)
+++ trunk/rkward/tests/data_plugin_tests/recode_cateorigal.messages.txt 2014-10-02 13:39:58 UTC (rev 4867)
@@ -0,0 +1,2 @@
+Warning in eval(expr, envir, enclos) :
+ Some input values were specified more than once: "9", "10"
Added: trunk/rkward/tests/data_plugin_tests/recode_cateorigal.rkcommands.R
===================================================================
--- trunk/rkward/tests/data_plugin_tests/recode_cateorigal.rkcommands.R (rev 0)
+++ trunk/rkward/tests/data_plugin_tests/recode_cateorigal.rkcommands.R 2014-10-02 13:39:58 UTC (rev 4867)
@@ -0,0 +1,40 @@
+local ({
+ x <- {e <- warpbreaks[["tension"]]; if (is.factor (e)) {levels (e)} else {sort (unique (e, nmax=10000))}}
+ if (length (x) > 100) x <- c (x[1:100], "____LIMIT____")
+ if (is.character (x)) { op <- options ('useFancyQuotes'=FALSE); x <- dQuote (x); options (op) }
+ x
+})
+local({
+## Compute
+input <- warpbreaks[["tension"]]
+# Use as.character() as intermediate data format, to support adding and dropping levels
+recoded <- as.character (warpbreaks[["tension"]])
+recoded[input == "L"] <- "low"
+recoded[input %in% c("M","H")] <- "midorhigh"
+.GlobalEnv$recoded <- as.factor (recoded)
+## Print result
+rk.header("Recode categorical data", parameters=list("Input variable", "warpbreaks[[\"tension\"]]",
+ "Output variable", "recoded",
+ "Number of differences after recoding", sum (warpbreaks[["tension"]] != recoded, na.rm=TRUE) + sum (is.na (warpbreaks[["tension"]]) != is.na (recoded))))
+})
+local ({
+ x <- {e <- withnas; if (is.factor (e)) {levels (e)} else {sort (unique (e, nmax=10000))}}
+ if (length (x) > 100) x <- c (x[1:100], "____LIMIT____")
+ if (is.character (x)) { op <- options ('useFancyQuotes'=FALSE); x <- dQuote (x); options (op) }
+ x
+})
+local({
+## Compute
+input <- withnas
+recoded <- as.logical ("", length.out = length (withnas))
+recoded[input %in% c("2","3","4","5","6","7","8","9","10")] <- FALSE
+recoded[input %in% c("9","10")] <- NA
+recoded[is.na (input)] <- TRUE
+
+warning ("Some input values were specified more than once: ", "\"9\", \"10\"")
+.GlobalEnv$recoded2 <- recoded
+## Print result
+rk.header("Recode categorical data", parameters=list("Input variable", "withnas",
+ "Output variable", "recoded2",
+ "Number of differences after recoding", sum (withnas != recoded2, na.rm=TRUE) + sum (is.na (withnas) != is.na (recoded2))))
+})
Added: trunk/rkward/tests/data_plugin_tests/recode_cateorigal.rkout
===================================================================
--- trunk/rkward/tests/data_plugin_tests/recode_cateorigal.rkout (rev 0)
+++ trunk/rkward/tests/data_plugin_tests/recode_cateorigal.rkout 2014-10-02 13:39:58 UTC (rev 4867)
@@ -0,0 +1,30 @@
+<h1>Recode categorical data</h1>
+<h2>Parameters</h2>
+<ul><li>Input variable: warpbreaks[["tension"]]</li>
+<li>Output variable: recoded</li>
+<li>Number of differences after recoding: 54</li>
+</ul>
+DATE<br />
+
+<p class='character'>
+
+<font class='factor'></p>
+
+<p class='character'>low low low low low low low low low midorhigh midorhigh midorhigh midorhigh midorhigh midorhigh midorhigh midorhigh midorhigh midorhigh midorhigh midorhigh midorhigh midorhigh midorhigh midorhigh midorhigh midorhigh low low low low low low low low low midorhigh midorhigh midorhigh midorhigh midorhigh midorhigh midorhigh midorhigh midorhigh midorhigh midorhigh midorhigh midorhigh midorhigh midorhigh midorhigh midorhigh midorhigh</p>
+
+<p class='character'></font>
+</p>
+
+<br>
+
+<p class='character'>Levels:<font class='factorlevels'> low midorhigh</font>
+<br></p>
+<h1>Recode categorical data</h1>
+<h2>Parameters</h2>
+<ul><li>Input variable: withnas</li>
+<li>Output variable: recoded2</li>
+<li>Number of differences after recoding: 20</li>
+</ul>
+DATE<br />
+
+<p class='logical'>NA FALSE TRUE FALSE FALSE FALSE FALSE FALSE NA NA NA FALSE FALSE FALSE TRUE FALSE FALSE FALSE NA NA</p>
Modified: trunk/rkward/tests/data_plugin_tests.R
===================================================================
--- trunk/rkward/tests/data_plugin_tests.R 2014-10-02 13:35:20 UTC (rev 4866)
+++ trunk/rkward/tests/data_plugin_tests.R 2014-10-02 13:39:58 UTC (rev 4867)
@@ -9,6 +9,9 @@
library ("datasets")
data (women)
data (sleep)
+ data (warpbreaks)
+ withnas <- sleep$ID
+ withnas[c(3,15)] <- NA
}
## the tests
), tests = list (
@@ -22,6 +25,14 @@
}),
new ("RKTest", id="subset_dataframe", call=function () {
rk.call.plugin ("rkward::subset_dataframe", drp_fltr_num.string="range", frm_Onlyssbs.checked="1", inp_Exprssnr.text="group == 1", inp_Mnmmrmpt.text="0", inp_Mxmmrmpt.text="3", maxinc.state="0", mininc.state="1", svb_Svrsltst.active="1", svb_Svrsltst.objectname="sset.result", svb_Svrsltst.parent=".GlobalEnv", var_data.available="sleep", vrsl_Fltrbyvr.available="sleep[[\"extra\"]]", vrsl_Slctdvrb.available="sleep[[\"extra\"]]\nsleep[[\"ID\"]]", submit.mode="submit")
+ }),
+ new ("RKTest", id="recode_cateorigal", call=function () {
+ rk.call.plugin ("rkward::recode_categorical", datamode.string="factor", other.string="copy", saveto.objectname="recoded", saveto.parent=".GlobalEnv", saveto_select.string="other", set.serialized="_row=new_value.string=custom\tnew_value_custom.input.text=low\told_value_type.string=value\tvalues.available=\\\"L\\\"\n_row=new_value.string=custom\tnew_value_custom.input.text=midorhigh\told_value_type.string=value\tvalues.available=\\\"M\\\"\\n\\\"H\\\"", x.available="warpbreaks[[\"tension\"]]", submit.mode="submit")
+ rk.print (recoded)
+ rm (recoded, envir=.GlobalEnv)
+ rk.call.plugin ("rkward::recode_categorical", datamode.string="logical", other.string="na", saveto.objectname="recoded2", saveto.parent=".GlobalEnv", saveto_select.string="other", set.serialized="_row=new_value.string=custom\tnew_value_custom.logical.string=FALSE\told_value_type.string=value\tvalues.available=\\\"2\\\"\\n\\\"3\\\"\\n\\\"4\\\"\\n\\\"5\\\"\\n\\\"6\\\"\\n\\\"7\\\"\\n\\\"8\\\"\\n\\\"9\\\"\\n\\\"10\\\"\n_row=new_value.string=na\told_value_type.string=value\tvalues.available=\\\"9\\\"\\n\\\"10\\\"\n_row=new_value.string=custom\tnew_value_custom.logical.string=TRUE\told_value_type.string=na", x.available="withnas", submit.mode="submit")
+ rk.print (recoded2)
+ rm (recoded2, envir=.GlobalEnv)
})
), postCalls = list (
function(){rm("women", pos=globalenv())}
More information about the rkward-tracker
mailing list