[rkward-cvs] SF.net SVN: rkward:[2636] trunk/rkward/tests

tfry at users.sourceforge.net tfry at users.sourceforge.net
Wed Sep 2 08:58:06 UTC 2009


Revision: 2636
          http://rkward.svn.sourceforge.net/rkward/?rev=2636&view=rev
Author:   tfry
Date:     2009-09-02 08:58:05 +0000 (Wed, 02 Sep 2009)

Log Message:
-----------
Add the last few missing tests for the analysis.pluginmap

Modified Paths:
--------------
    trunk/rkward/tests/analysis_plugins.R

Added Paths:
-----------
    trunk/rkward/tests/analysis_plugins/RKTestStandard.box_test.rkcommands.R
    trunk/rkward/tests/analysis_plugins/RKTestStandard.box_test.rkout
    trunk/rkward/tests/analysis_plugins/RKTestStandard.crosstab_multi.rkcommands.R
    trunk/rkward/tests/analysis_plugins/RKTestStandard.crosstab_multi.rkout
    trunk/rkward/tests/analysis_plugins/RKTestStandard.crosstab_n_to_1.rkcommands.R
    trunk/rkward/tests/analysis_plugins/RKTestStandard.crosstab_n_to_1.rkout
    trunk/rkward/tests/analysis_plugins/RKTestStandard.hp_filter.rkcommands.R
    trunk/rkward/tests/analysis_plugins/RKTestStandard.hp_filter.rkout
    trunk/rkward/tests/analysis_plugins/RKTestStandard.kpss_test.messages.txt
    trunk/rkward/tests/analysis_plugins/RKTestStandard.kpss_test.rkcommands.R
    trunk/rkward/tests/analysis_plugins/RKTestStandard.kpss_test.rkout
    trunk/rkward/tests/analysis_plugins/RKTestStandard.linear_regression.rkcommands.R
    trunk/rkward/tests/analysis_plugins/RKTestStandard.linear_regression.rkout
    trunk/rkward/tests/analysis_plugins/RKTestStandard.pp_test.rkcommands.R
    trunk/rkward/tests/analysis_plugins/RKTestStandard.pp_test.rkout

Added: trunk/rkward/tests/analysis_plugins/RKTestStandard.box_test.rkcommands.R
===================================================================
--- trunk/rkward/tests/analysis_plugins/RKTestStandard.box_test.rkcommands.R	                        (rev 0)
+++ trunk/rkward/tests/analysis_plugins/RKTestStandard.box_test.rkcommands.R	2009-09-02 08:58:05 UTC (rev 2636)
@@ -0,0 +1,26 @@
+local({
+## Prepare
+## Compute
+objects <- list (substitute (test50x), substitute (test10y))
+results <- data.frame ('Variable Name'=rep (NA, length (objects)), check.names=FALSE)
+for (i in 1:length (objects)) {
+	results[i, 'Variable Name'] <- rk.get.description (objects[[i]], is.substitute=TRUE)
+	var <- eval (objects[[i]], envir=globalenv ())
+	results[i, 'Length'] <- length (var)
+	results[i, 'NAs'] <- sum (is.na(var))
+
+	try ({
+		test <- Box.test (var, lag = 1, type = "Box-Pierce")
+		results[i, 'X-squared'] <- test$statistic
+		results[i, 'degrees of freedom'] <- test$parameter
+		results[i, 'p-value'] <- test$p.value
+	})
+}
+## Print result
+rk.header ("Box-Pierce Test",
+	parameters=list ("lag", "1", "type", "Box-Pierce"))
+
+rk.results (results)
+})
+.rk.rerun.plugin.link(plugin="rkward::Box_test", settings="lag.real=1.000000\nlength.state=1\nnarm.state=0\ntype.string=Box-Pierce\nx.available=test50x\\ntest10y", label="Run again")
+.rk.make.hr()

Added: trunk/rkward/tests/analysis_plugins/RKTestStandard.box_test.rkout
===================================================================
--- trunk/rkward/tests/analysis_plugins/RKTestStandard.box_test.rkout	                        (rev 0)
+++ trunk/rkward/tests/analysis_plugins/RKTestStandard.box_test.rkout	2009-09-02 08:58:05 UTC (rev 2636)
@@ -0,0 +1,11 @@
+<h1>Box-Pierce Test</h1>
+<h2>Parameters</h2>
+<ul><li>lag: 1</li>
+<li>type: Box-Pierce</li>
+</ul>
+DATE<br>
+<table border="1">
+<tr><td>Variable Name</td><td>Length</td><td>NAs</td><td>X-squared</td><td>degrees of freedom</td><td>p-value</td></tr>
+<tr><td>test50x</td><td>50</td><td>0</td><td>44.18</td><td>1</td><td>2.9953e-11</td></tr>
+<tr><td>test10y</td><td>11</td><td>1</td><td>4.9</td><td>1</td><td>0.026857</td></tr>
+</table>

Added: trunk/rkward/tests/analysis_plugins/RKTestStandard.crosstab_multi.rkcommands.R
===================================================================
--- trunk/rkward/tests/analysis_plugins/RKTestStandard.crosstab_multi.rkcommands.R	                        (rev 0)
+++ trunk/rkward/tests/analysis_plugins/RKTestStandard.crosstab_multi.rkcommands.R	2009-09-02 08:58:05 UTC (rev 2636)
@@ -0,0 +1,13 @@
+local({
+## Prepare
+data <- data.frame (test_table[["A"]],test_table[["B"]],test_table[["C"]],test_table[["D"]], check.names=FALSE)
+datadescription <- paste (rk.get.description (test_table[["A"]],test_table[["B"]],test_table[["C"]],test_table[["D"]]), collapse=", ");
+## Compute
+result <- ftable (data);
+## Print result
+rk.header ("Crosstabs (n to n)", parameters=list ("Variables"=datadescription))
+
+rk.print (result)
+})
+.rk.rerun.plugin.link(plugin="rkward::crosstab_multi", settings="exclude_nas.state=1\nx.available=test_table[[\\\"A\\\"]]\\ntest_table[[\\\"B\\\"]]\\ntest_table[[\\\"C\\\"]]\\ntest_table[[\\\"D\\\"]]", label="Run again")
+.rk.make.hr()

Added: trunk/rkward/tests/analysis_plugins/RKTestStandard.crosstab_multi.rkout
===================================================================
--- trunk/rkward/tests/analysis_plugins/RKTestStandard.crosstab_multi.rkout	                        (rev 0)
+++ trunk/rkward/tests/analysis_plugins/RKTestStandard.crosstab_multi.rkout	2009-09-02 08:58:05 UTC (rev 2636)
@@ -0,0 +1,24 @@
+<h1>Crosstabs (n to n)</h1>
+<h2>Parameters</h2>
+<ul><li>Variables: A, B, C, D</li>
+</ul>
+DATE<br>
+
+<p align= center >
+<table cellspacing=0 border=1><caption align=bottom class=captiondataframe></caption><tr><td>
+	<table border=0 class=dataframe>
+	<tbody> <td class=cellinside>                 </td><td class=cellinside>                 </td><td class=cellinside>                 </td><td class=cellinside>test_table[["D"]]</td><td class=cellinside>1                </td><td class=cellinside>2                </td></tr>
+ <td class=cellinside>test_table[["A"]]</td><td class=cellinside>test_table[["B"]]</td><td class=cellinside>test_table[["C"]]</td><td class=cellinside>                 </td><td class=cellinside>                 </td><td class=cellinside>                 </td></tr>
+ <td class=cellinside>1                </td><td class=cellinside>1                </td><td class=cellinside>1                </td><td class=cellinside>                 </td><td class=cellinside>1                </td><td class=cellinside>1                </td></tr>
+ <td class=cellinside>                 </td><td class=cellinside>                 </td><td class=cellinside>2                </td><td class=cellinside>                 </td><td class=cellinside>1                </td><td class=cellinside>1                </td></tr>
+ <td class=cellinside>                 </td><td class=cellinside>2                </td><td class=cellinside>1                </td><td class=cellinside>                 </td><td class=cellinside>1                </td><td class=cellinside>1                </td></tr>
+ <td class=cellinside>                 </td><td class=cellinside>                 </td><td class=cellinside>2                </td><td class=cellinside>                 </td><td class=cellinside>1                </td><td class=cellinside>1                </td></tr>
+ <td class=cellinside>2                </td><td class=cellinside>1                </td><td class=cellinside>1                </td><td class=cellinside>                 </td><td class=cellinside>0                </td><td class=cellinside>1                </td></tr>
+ <td class=cellinside>                 </td><td class=cellinside>                 </td><td class=cellinside>2                </td><td class=cellinside>                 </td><td class=cellinside>1                </td><td class=cellinside>1                </td></tr>
+ <td class=cellinside>                 </td><td class=cellinside>2                </td><td class=cellinside>1                </td><td class=cellinside>                 </td><td class=cellinside>1                </td><td class=cellinside>1                </td></tr>
+ <td class=cellinside>                 </td><td class=cellinside>                 </td><td class=cellinside>2                </td><td class=cellinside>                 </td><td class=cellinside>1                </td><td class=cellinside>1                </td></tr>
+ 
+	</tbody>
+</table>
+ </td></table>
+ <br>

Added: trunk/rkward/tests/analysis_plugins/RKTestStandard.crosstab_n_to_1.rkcommands.R
===================================================================
--- trunk/rkward/tests/analysis_plugins/RKTestStandard.crosstab_n_to_1.rkcommands.R	                        (rev 0)
+++ trunk/rkward/tests/analysis_plugins/RKTestStandard.crosstab_n_to_1.rkcommands.R	2009-09-02 08:58:05 UTC (rev 2636)
@@ -0,0 +1,40 @@
+local({
+## Prepare
+## Compute
+x <- warpbreaks[["tension"]]
+yvars <- list (substitute (warpbreaks[["wool"]]), substitute (warpbreaks[["tension"]]))
+results <- list()
+descriptions <- list ()
+
+# calculate crosstabs
+for (i in 1:length (yvars)) {
+	yvar <- eval (yvars[[i]], envir=globalenv ())
+	results[[i]] <- table(x, yvar)
+
+	descriptions[[i]] <- list ('Dependent'=rk.get.description (warpbreaks[["tension"]]), 'Independent'=rk.get.description (yvars[[i]], is.substitute=TRUE))
+}
+
+# calculate chisquares
+chisquares <- list ()
+for (i in 1:length (results)) {
+	chisquares[[i]] <- chisq.test (results[[i]], simulate.p.value = FALSE)
+}
+## Print result
+rk.header ("Crosstabs (n to 1)", level=1)
+for (i in 1:length (results)) {
+	rk.header ("Crosstabs (n to 1)", parameters=list ("Dependent", descriptions[[i]][['Dependent']], "Independent", descriptions[[i]][['Independent']]), level=2)
+	rk.results (results[[i]], titles=c(descriptions[[i]][['Dependent']], descriptions[[i]][['Independent']]))
+
+	rk.header ("Pearson's Chi Square Test for Crosstabs", list ("Dependent", descriptions[[i]][['Dependent']], "Independent", descriptions[[i]][['Independent']], "Method", chisquares[[i]][["method"]]), level=2)
+	rk.results (list ('Statistic'=chisquares[[i]][['statistic']], 'df'=chisquares[[i]][['parameter']], 'p'=chisquares[[i]][['p.value']]))
+
+	rk.header ("Barplot for Crosstabs", list ("Dependent", descriptions[[i]][['Dependent']], "Independent", descriptions[[i]][['Independent']], "colors", "default", "Type", "juxtaposed", "Legend", "FALSE"), level=2)
+	rk.graph.on ()
+	try ({
+		barplot(results[[i]], beside=TRUE)
+	})
+	rk.graph.off ()
+}
+})
+.rk.rerun.plugin.link(plugin="rkward::crosstab", settings="barplot.state=TRUE\nbarplot_embed.colors.string=default\nbarplot_embed.labels.state=0\nbarplot_embed.legend.state=0\nbarplot_embed.plotoptions.add_grid.state=0\nbarplot_embed.plotoptions.asp.real=0.00000000\nbarplot_embed.plotoptions.main.text=\nbarplot_embed.plotoptions.pointcolor.color.string=\nbarplot_embed.plotoptions.pointtype.string=\nbarplot_embed.plotoptions.sub.text=\nbarplot_embed.plotoptions.xaxt.state=\nbarplot_embed.plotoptions.xlab.text=\nbarplot_embed.plotoptions.xlog.state=\nbarplot_embed.plotoptions.xmaxvalue.text=\nbarplot_embed.plotoptions.xminvalue.text=\nbarplot_embed.plotoptions.yaxt.state=\nbarplot_embed.plotoptions.ylab.text=\nbarplot_embed.plotoptions.ylog.state=\nbarplot_embed.plotoptions.ymaxvalue.text=\nbarplot_embed.plotoptions.yminvalue.text=\nbarplot_embed.type.string=juxtaposed\nchisq.state=TRUE\nsimpv.string=FALSE\nx.available=warpbreaks[[\\\"tension\\\"]]\ny.available=warpbreaks[[\\\"wool\\\"]]\\nwarpbreaks[[\\\"tension\\\"]]", label="Run again")
+.rk.make.hr()

Added: trunk/rkward/tests/analysis_plugins/RKTestStandard.crosstab_n_to_1.rkout
===================================================================
--- trunk/rkward/tests/analysis_plugins/RKTestStandard.crosstab_n_to_1.rkout	                        (rev 0)
+++ trunk/rkward/tests/analysis_plugins/RKTestStandard.crosstab_n_to_1.rkout	2009-09-02 08:58:05 UTC (rev 2636)
@@ -0,0 +1,68 @@
+<h1>Crosstabs (n to 1)</h1>
+DATE<br>
+<h2>Crosstabs (n to 1)</h2>
+<h3>Parameters</h3>
+<ul><li>Dependent: tension</li>
+<li>Independent: wool</li>
+</ul>
+<br>
+<table border="1">
+<tr><td></td><td>wool = A</td><td>wool = B</td></tr>
+<tr><td>tension = L</td><td>9</td><td>9</td></tr>
+<tr><td>tension = M</td><td>9</td><td>9</td></tr>
+<tr><td>tension = H</td><td>9</td><td>9</td></tr>
+</table>
+<h2>Pearson's Chi Square Test for Crosstabs</h2>
+<h3>Parameters</h3>
+<ul><li>Dependent: tension</li>
+<li>Independent: wool</li>
+<li>Method: Pearson's Chi-squared test</li>
+</ul>
+<br>
+<table border="1">
+<tr><td>Statistic</td><td>df</td><td>p</td></tr>
+<tr><td>0</td><td>2</td><td>1</td></tr>
+</table>
+<h2>Barplot for Crosstabs</h2>
+<h3>Parameters</h3>
+<ul><li>Dependent: tension</li>
+<li>Independent: wool</li>
+<li>colors: default</li>
+<li>Type: juxtaposed</li>
+<li>Legend: FALSE</li>
+</ul>
+<br>
+<img src="graph.png" width="480" height="480"><br>
+<h2>Crosstabs (n to 1)</h2>
+<h3>Parameters</h3>
+<ul><li>Dependent: tension</li>
+<li>Independent: tension</li>
+</ul>
+<br>
+<table border="1">
+<tr><td></td><td>tension = L</td><td>tension = M</td><td>tension = H</td></tr>
+<tr><td>tension = L</td><td>18</td><td>0</td><td>0</td></tr>
+<tr><td>tension = M</td><td>0</td><td>18</td><td>0</td></tr>
+<tr><td>tension = H</td><td>0</td><td>0</td><td>18</td></tr>
+</table>
+<h2>Pearson's Chi Square Test for Crosstabs</h2>
+<h3>Parameters</h3>
+<ul><li>Dependent: tension</li>
+<li>Independent: tension</li>
+<li>Method: Pearson's Chi-squared test</li>
+</ul>
+<br>
+<table border="1">
+<tr><td>Statistic</td><td>df</td><td>p</td></tr>
+<tr><td>108</td><td>4</td><td>1.9429e-22</td></tr>
+</table>
+<h2>Barplot for Crosstabs</h2>
+<h3>Parameters</h3>
+<ul><li>Dependent: tension</li>
+<li>Independent: tension</li>
+<li>colors: default</li>
+<li>Type: juxtaposed</li>
+<li>Legend: FALSE</li>
+</ul>
+<br>
+<img src="graph.png" width="480" height="480"><br>

Added: trunk/rkward/tests/analysis_plugins/RKTestStandard.hp_filter.rkcommands.R
===================================================================
--- trunk/rkward/tests/analysis_plugins/RKTestStandard.hp_filter.rkcommands.R	                        (rev 0)
+++ trunk/rkward/tests/analysis_plugins/RKTestStandard.hp_filter.rkcommands.R	2009-09-02 08:58:05 UTC (rev 2636)
@@ -0,0 +1,29 @@
+local({
+## Prepare
+## Compute
+## Print result
+rk.header ("Hodrick-Prescott Filter", parameters=list("Lambda", 1600))
+x <- get("co2", envir=globalenv())
+lambda <- 1600
+
+if (any (is.na (x))) stop ("Missing values cannot be handled")
+
+i <- diag(length(x))
+trend <- solve(i + lambda * crossprod(diff(i, lag=1, d=2)), x) # The HP Filter itself. Thanks to Grant V. Farnsworth
+cycle <- x - trend
+if (is.ts(x)) {
+	trend <- ts(trend,start(x),frequency=frequency(x))
+	cycle <- ts(cycle,start(x),frequency=frequency(x))
+}
+assign("hptrend", trend, envir=globalenv())
+assign("hpcycle", cycle, envir=globalenv())
+rk.graph.on ()
+try({
+	par(mfrow=c(2,1),mar=c(2,4,2,2)+0.1)
+	plot.ts(cbind(x, trend), ylab="co2, Trend", col=c("blue", "red"),lwd=c(1,1), plot.type="single")
+	plot.ts(cycle, ylab="Cycle", col="green4", lwd=1)
+})
+rk.graph.off ()
+})
+.rk.rerun.plugin.link(plugin="rkward::hp_filter", settings="create_cycle.state=1\ncreate_trend.state=1\ncustom.state=0\ncycle_col.color.string=green4\ncycle_lty.string=\ncycle_lwd.real=1.000000\ncycle_name.selection=hpcycle\ndownlab.text=\nlambda.string=1600\nplot_cycle.state=1\nseries_col.color.string=blue\nseries_lty.string=\nseries_lwd.real=1.000000\ntrend_col.color.string=red\ntrend_lty.string=\ntrend_lwd.real=1.000000\ntrend_name.selection=hptrend\nuplab.text=\nx.available=co2", label="Run again")
+.rk.make.hr()

Added: trunk/rkward/tests/analysis_plugins/RKTestStandard.hp_filter.rkout
===================================================================
--- trunk/rkward/tests/analysis_plugins/RKTestStandard.hp_filter.rkout	                        (rev 0)
+++ trunk/rkward/tests/analysis_plugins/RKTestStandard.hp_filter.rkout	2009-09-02 08:58:05 UTC (rev 2636)
@@ -0,0 +1,30 @@
+<h1>Hodrick-Prescott Filter</h1>
+<h2>Parameters</h2>
+<ul><li>Lambda: 1600</li>
+</ul>
+DATE<br>
+<img src="graph.png" width="480" height="480"><br>
+
+
+<p align= center >
+<table cellspacing=0 border=1><caption align=bottom class=captiondataframe></caption><tr><td>
+	<table border=0 class=dataframe>
+	<tbody> <tr class= firstline > <th>Min.</th><th>1st Qu.</th><th>Median</th><th>Mean</th><th>3rd Qu.</th><th>Max.</th> </tr>
+ <td class=cellinside>316</td><td class=cellinside>323</td><td class=cellinside>335</td><td class=cellinside>337</td><td class=cellinside>351</td><td class=cellinside>363</td></tr>
+ 
+	</tbody>
+</table>
+ </td></table>
+ <br>
+
+
+<p align= center >
+<table cellspacing=0 border=1><caption align=bottom class=captiondataframe></caption><tr><td>
+	<table border=0 class=dataframe>
+	<tbody> <tr class= firstline > <th>Min.</th><th>1st Qu.</th><th>Median</th><th>Mean</th><th>3rd Qu.</th><th>Max.</th> </tr>
+ <td class=cellinside>-3.72</td><td class=cellinside>-1.66</td><td class=cellinside> 0.25</td><td class=cellinside> 0.00</td><td class=cellinside> 1.80</td><td class=cellinside> 3.92</td></tr>
+ 
+	</tbody>
+</table>
+ </td></table>
+ <br>

Added: trunk/rkward/tests/analysis_plugins/RKTestStandard.kpss_test.messages.txt
===================================================================
--- trunk/rkward/tests/analysis_plugins/RKTestStandard.kpss_test.messages.txt	                        (rev 0)
+++ trunk/rkward/tests/analysis_plugins/RKTestStandard.kpss_test.messages.txt	2009-09-02 08:58:05 UTC (rev 2636)
@@ -0,0 +1,5 @@
+Warning messages:
+1: In kpss.test(var, null = "Trend", lshort = FALSE) :
+  p-value greater than printed p-value
+2: In kpss.test(var, null = "Trend", lshort = FALSE) :
+  p-value greater than printed p-value

Added: trunk/rkward/tests/analysis_plugins/RKTestStandard.kpss_test.rkcommands.R
===================================================================
--- trunk/rkward/tests/analysis_plugins/RKTestStandard.kpss_test.rkcommands.R	                        (rev 0)
+++ trunk/rkward/tests/analysis_plugins/RKTestStandard.kpss_test.rkcommands.R	2009-09-02 08:58:05 UTC (rev 2636)
@@ -0,0 +1,27 @@
+local({
+## Prepare
+require (tseries)
+## Compute
+objects <- list (substitute (test10y), substitute (test10z), substitute (test50x), substitute (test50y))
+results <- data.frame ('Variable Name'=rep (NA, length (objects)), check.names=FALSE)
+for (i in 1:length (objects)) {
+	results[i, 'Variable Name'] <- rk.get.description (objects[[i]], is.substitute=TRUE)
+	var <- eval (objects[[i]], envir=globalenv ())
+	results[i, 'Length'] <- length (var)
+	results[i, 'NAs'] <- sum (is.na(var))
+
+	try ({
+		test <- kpss.test (var, null = "Trend", lshort = FALSE)
+		results[i, 'KPSS Trend'] <- test$statistic
+		results[i, 'Truncation lag parameter'] <- test$parameter
+		results[i, 'p-value'] <- test$p.value
+	})
+}
+## Print result
+rk.header ("KPSS Test for Level Stationarity",
+	parameters=list ("null hypothesis"="Trend", "version of truncation lag parameter"="long"))
+
+rk.results (results)
+})
+.rk.rerun.plugin.link(plugin="rkward::kpss_test", settings="length.state=1\nlshort.string=FALSE\nnarm.state=0\nnull.string=Trend\nx.available=test10y\\ntest10z\\ntest50x\\ntest50y", label="Run again")
+.rk.make.hr()

Added: trunk/rkward/tests/analysis_plugins/RKTestStandard.kpss_test.rkout
===================================================================
--- trunk/rkward/tests/analysis_plugins/RKTestStandard.kpss_test.rkout	                        (rev 0)
+++ trunk/rkward/tests/analysis_plugins/RKTestStandard.kpss_test.rkout	2009-09-02 08:58:05 UTC (rev 2636)
@@ -0,0 +1,13 @@
+<h1>KPSS Test for Level Stationarity</h1>
+<h2>Parameters</h2>
+<ul><li>null hypothesis: Trend</li>
+<li>version of truncation lag parameter: long</li>
+</ul>
+DATE<br>
+<table border="1">
+<tr><td>Variable Name</td><td>Length</td><td>NAs</td><td>KPSS Trend</td><td>Truncation lag parameter</td><td>p-value</td></tr>
+<tr><td>test10y</td><td>11</td><td>1</td><td>0.12980</td><td>2</td><td>0.079995</td></tr>
+<tr><td>test10z</td><td>11</td><td>1</td><td>0.11135</td><td>2</td><td>0.1</td></tr>
+<tr><td>test50x</td><td>50</td><td>0</td><td>0.10241</td><td>5</td><td>0.1</td></tr>
+<tr><td>test50y</td><td>50</td><td>0</td><td>0.13780</td><td>5</td><td>0.06518</td></tr>
+</table>

Added: trunk/rkward/tests/analysis_plugins/RKTestStandard.linear_regression.rkcommands.R
===================================================================
--- trunk/rkward/tests/analysis_plugins/RKTestStandard.linear_regression.rkcommands.R	                        (rev 0)
+++ trunk/rkward/tests/analysis_plugins/RKTestStandard.linear_regression.rkcommands.R	2009-09-02 08:58:05 UTC (rev 2636)
@@ -0,0 +1,10 @@
+local({
+## Prepare
+## Compute
+results <- summary.lm (lm (warpbreaks[["breaks"]] ~ warpbreaks[["tension"]] + warpbreaks[["wool"]]))
+## Print result
+rk.header ("Linear Regression")
+rk.print(results)
+})
+.rk.rerun.plugin.link(plugin="rkward::linear_regression", settings="intercept.state=1\nx.available=warpbreaks[[\\\"tension\\\"]]\\nwarpbreaks[[\\\"wool\\\"]]\ny.available=warpbreaks[[\\\"breaks\\\"]]", label="Run again")
+.rk.make.hr()

Added: trunk/rkward/tests/analysis_plugins/RKTestStandard.linear_regression.rkout
===================================================================
--- trunk/rkward/tests/analysis_plugins/RKTestStandard.linear_regression.rkout	                        (rev 0)
+++ trunk/rkward/tests/analysis_plugins/RKTestStandard.linear_regression.rkout	2009-09-02 08:58:05 UTC (rev 2636)
@@ -0,0 +1,38 @@
+<h1>Linear Regression</h1>
+DATE<br>
+<p class='character'>
+</p><br><li>Call:<font class='call'> lm(formula = warpbreaks[["breaks"]] ~ warpbreaks[["tension"]] + </font>
+Call:<font class='call'>     warpbreaks[["wool"]])</font>
+<br><li>  Residuals<br>
+
+
+<p align= center >
+<table cellspacing=0 border=1><caption align=bottom class=captiondataframe></caption><tr><td>
+	<table border=0 class=dataframe>
+	<tbody> <tr class= firstline > <th></th><th>Min</th><th>1Q</th><th>Median</th><th>3Q</th><th>Max</th> </tr>
+ <tr><td class=firstcolumn></td><td class=cellinside>-19.5</td><td class=cellinside> -8.1</td><td class=cellinside> -2.1</td><td class=cellinside>  6.5</td><td class=cellinside> 30.7</td></tr>
+ 
+	</tbody>
+</table>
+ </td></table>
+ <br>
+<br><li>Coefficients
+
+
+<p align= center >
+<table cellspacing=0 border=1><caption align=bottom class=captiondataframe></caption><tr><td>
+	<table border=0 class=dataframe>
+	<tbody> <tr class= firstline > <th></th><th>Estimate</th><th>Std. Error</th><th>t value</th><th>Pr(>|t|)</th><th></th> </tr>
+ <tr><td class=firstcolumn>(Intercept)</td><td class=cellinside> 39.28 </td><td class=cellinside>  3.16 </td><td class=cellinside>12.42  </td><td class=cellinside>< 2e-16</td><td class=cellinside>***    </td></tr>
+ <tr><td class=firstcolumn>warpbreaks[["tension"]]M</td><td class=cellinside>-10.00 </td><td class=cellinside>  3.87 </td><td class=cellinside>-2.58  </td><td class=cellinside>0.01279</td><td class=cellinside>  *    </td></tr>
+ <tr><td class=firstcolumn>warpbreaks[["tension"]]H</td><td class=cellinside>-14.72 </td><td class=cellinside>  3.87 </td><td class=cellinside>-3.80  </td><td class=cellinside>0.00039</td><td class=cellinside>***    </td></tr>
+ <tr><td class=firstcolumn>warpbreaks[["wool"]]B</td><td class=cellinside> -5.78 </td><td class=cellinside>  3.16 </td><td class=cellinside>-1.83  </td><td class=cellinside>0.07361</td><td class=cellinside>  .    </td></tr>
+ 
+	</tbody>
+</table>
+ </td></table>
+ <br>
+<p class='character'>
+<p>--- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1</p>
+</p><br><li>Residuals standard error: 11.617 on 50 degrees of freedom
+<br><li>Multiple R-Squared:<b>0.269</b><br><li>Adjusted R-Squared:<b>0.225</b><br><li>F-statistics: <b>6.138</b> on 3 and 50 DF. P-value:<b>0.001</b>.
\ No newline at end of file

Added: trunk/rkward/tests/analysis_plugins/RKTestStandard.pp_test.rkcommands.R
===================================================================
--- trunk/rkward/tests/analysis_plugins/RKTestStandard.pp_test.rkcommands.R	                        (rev 0)
+++ trunk/rkward/tests/analysis_plugins/RKTestStandard.pp_test.rkcommands.R	2009-09-02 08:58:05 UTC (rev 2636)
@@ -0,0 +1,26 @@
+local({
+## Prepare
+## Compute
+objects <- list (substitute (rock[["shape"]]), substitute (rock[["perm"]]), substitute (rock[["peri"]]), substitute (rock[["area"]]))
+results <- data.frame ('Variable Name'=rep (NA, length (objects)), check.names=FALSE)
+for (i in 1:length (objects)) {
+	results[i, 'Variable Name'] <- rk.get.description (objects[[i]], is.substitute=TRUE)
+	var <- eval (objects[[i]], envir=globalenv ())
+	results[i, 'Length'] <- length (var)
+	results[i, 'NAs'] <- sum (is.na(var))
+
+	try ({
+		test <- PP.test (var, lshort = FALSE)
+		results[i, 'Dickey-Fuller'] <- test$statistic
+		results[i, 'Truncation lag parameter'] <- test$parameter
+		results[i, 'p-value'] <- test$p.value
+	})
+}
+## Print result
+rk.header ("Phillips-Perron Test for Unit Roots",
+	parameters=list ("Truncation lag parameter short ('TRUE') or long ('FALSE')", "FALSE"))
+
+rk.results (results)
+})
+.rk.rerun.plugin.link(plugin="rkward::PP_test", settings="length.state=1\nlshort.string=FALSE\nnarm.state=0\nx.available=rock[[\\\"shape\\\"]]\\nrock[[\\\"perm\\\"]]\\nrock[[\\\"peri\\\"]]\\nrock[[\\\"area\\\"]]", label="Run again")
+.rk.make.hr()

Added: trunk/rkward/tests/analysis_plugins/RKTestStandard.pp_test.rkout
===================================================================
--- trunk/rkward/tests/analysis_plugins/RKTestStandard.pp_test.rkout	                        (rev 0)
+++ trunk/rkward/tests/analysis_plugins/RKTestStandard.pp_test.rkout	2009-09-02 08:58:05 UTC (rev 2636)
@@ -0,0 +1,12 @@
+<h1>Phillips-Perron Test for Unit Roots</h1>
+<h2>Parameters</h2>
+<ul><li>Truncation lag parameter short ('TRUE') or long ('FALSE'): FALSE</li>
+</ul>
+DATE<br>
+<table border="1">
+<tr><td>Variable Name</td><td>Length</td><td>NAs</td><td>Dickey-Fuller</td><td>Truncation lag parameter</td><td>p-value</td></tr>
+<tr><td>shape</td><td>48</td><td>0</td><td>-8.2621</td><td>9</td><td>0.01</td></tr>
+<tr><td>perm</td><td>48</td><td>0</td><td>-2.4302</td><td>9</td><td>0.40232</td></tr>
+<tr><td>peri</td><td>48</td><td>0</td><td>-3.4823</td><td>9</td><td>0.054578</td></tr>
+<tr><td>area</td><td>48</td><td>0</td><td>-4.0273</td><td>9</td><td>0.01627</td></tr>
+</table>

Modified: trunk/rkward/tests/analysis_plugins.R
===================================================================
--- trunk/rkward/tests/analysis_plugins.R	2009-09-01 12:19:39 UTC (rev 2635)
+++ trunk/rkward/tests/analysis_plugins.R	2009-09-02 08:58:05 UTC (rev 2636)
@@ -23,6 +23,9 @@
 			assign ("test10x", 100+c (1:10, NA), envir=globalenv())
 			assign ("test10y", 200+c (1:10, NA), envir=globalenv())
 			assign ("test10z", c (1:10, NA)*4, envir=globalenv())
+			x <- data.frame ("A" = rep (c (1, 2), 8), "B" = rep (c (1, 1, 2, 2), 4), "C" = rep (c (1, 1, 1, 1, 2, 2, 2, 2), 2), "D"= c (rep (1, 8), rep (2, 8)))
+			x[2,2] <- NA
+			assign ("test_table", x, envir=globalenv())
 		}
 	## the tests
 	), tests = list (
@@ -117,10 +120,37 @@
 			rk.call.plugin ("rkward::grubbs_test", descriptives.state="0", length.state="1", opposite.state="FALSE", two_sided.state="TRUE", type.string="10", x.available="warpbreaks[[\"breaks\"]]\ntest10z", submit.mode="submit")
 
 			rk.call.plugin ("rkward::grubbs_test", descriptives.state="1", length.state="1", opposite.state="TRUE", two_sided.state="FALSE", type.string="11", x.available="warpbreaks[[\"breaks\"]]\ntest10z", submit.mode="submit")
-		}, libraries = c ("outliers"))
+		}, libraries = c ("outliers")),
+		new ("RKTest", id="pp_test", call=function () {
+			rk.call.plugin ("rkward::PP_test", length.state="1", lshort.string="FALSE", narm.state="0", x.available="rock[[\"shape\"]]\nrock[[\"perm\"]]\nrock[[\"peri\"]]\nrock[[\"area\"]]", submit.mode="submit")
+		}),
+		new ("RKTest", id="crosstab_n_to_1", call=function () {
+			rk.call.plugin ("rkward::crosstab", barplot.state="TRUE", barplot_embed.colors.string="default", barplot_embed.labels.state="0", barplot_embed.legend.state="0", barplot_embed.plotoptions.add_grid.state="0", barplot_embed.plotoptions.asp.real="0.00000000", barplot_embed.plotoptions.main.text="", barplot_embed.plotoptions.pointcolor.color.string="", barplot_embed.plotoptions.pointtype.string="", barplot_embed.plotoptions.sub.text="", barplot_embed.plotoptions.xaxt.state="", barplot_embed.plotoptions.xlab.text="", barplot_embed.plotoptions.xlog.state="", barplot_embed.plotoptions.xmaxvalue.text="", barplot_embed.plotoptions.xminvalue.text="", barplot_embed.plotoptions.yaxt.state="", barplot_embed.plotoptions.ylab.text="", barplot_embed.plotoptions.ylog.state="", barplot_embed.plotoptions.ymaxvalue.text="", barplot_embed.plotoptions.yminvalue.text="", barplot_embed.type.string="juxtaposed", chisq.state="TRUE", simpv.string="FALSE", x.available="warpbreaks[[\"tension\"]]", y.available="warpbreaks[[\"wool\"]]\nwarpbreaks[[\"tension\"]]", submit.mode="submit")
+		}),
+		new ("RKTest", id="crosstab_multi", call=function () {
+			rk.call.plugin ("rkward::crosstab_multi", exclude_nas.state="1", x.available="test_table[[\"A\"]]\ntest_table[[\"B\"]]\ntest_table[[\"C\"]]\ntest_table[[\"D\"]]", submit.mode="submit")
+		}),
+		new ("RKTest", id="box_test", call=function () {
+			rk.call.plugin ("rkward::Box_test", lag.real="1.000000", length.state="1", narm.state="0", type.string="Box-Pierce", x.available="test50x\ntest10y", submit.mode="submit")
+		}),
+		new ("RKTest", id="kpss_test", call=function () {
+			rk.call.plugin ("rkward::kpss_test", length.state="1", lshort.string="FALSE", narm.state="0", null.string="Trend", x.available="test10y\ntest10z\ntest50x\ntest50y", submit.mode="submit")
+		}, libraries=c("tseries")),
+		new ("RKTest", id="hp_filter", call=function () {
+			data (co2)
+			rk.sync.global()
+
+			rk.call.plugin ("rkward::hp_filter", create_cycle.state="1", create_trend.state="1", custom.state="0", cycle_col.color.string="green4", cycle_lty.string="", cycle_lwd.real="1.000000", cycle_name.selection="hpcycle", downlab.text="", lambda.string="1600", plot_cycle.state="1", series_col.color.string="blue", series_lty.string="", series_lwd.real="1.000000", trend_col.color.string="red", trend_lty.string="", trend_lwd.real="1.000000", trend_name.selection="hptrend", uplab.text="", x.available="co2", submit.mode="submit")
+
+			rk.print (summary (hptrend))
+			rk.print (summary (hpcycle))
+		}),
+		new ("RKTest", id="linear_regression", call=function () {
+			rk.call.plugin ("rkward::linear_regression", intercept.state="1", x.available="warpbreaks[[\"tension\"]]\nwarpbreaks[[\"wool\"]]", y.available="warpbreaks[[\"breaks\"]]", submit.mode="submit")
+		})
 	), postCalls = list (	# like initCalls: run after all tests to clean up.
 		function () {
-			suppressWarnings (rm (list=c ("women", "warpbreaks", "rock", "test50x", "test50y", "test50z", "test10x", "test10y", "test10z"), envir=globalenv())) 
+			suppressWarnings (rm (list=c ("women", "warpbreaks", "rock", "co2", "test50x", "test50y", "test50z", "test10x", "test10y", "test10z", "test_table"), envir=globalenv()))
 		}
 	)
 )


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.




More information about the rkward-tracker mailing list