[IPSUR-commits] r216 - in pkg/RcmdrPlugin.IPSUR: . R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Aug 17 03:30:38 CEST 2014
Author: gkerns
Date: 2014-08-17 03:30:36 +0200 (Sun, 17 Aug 2014)
New Revision: 216
Modified:
pkg/RcmdrPlugin.IPSUR/
pkg/RcmdrPlugin.IPSUR/DESCRIPTION
pkg/RcmdrPlugin.IPSUR/NAMESPACE
pkg/RcmdrPlugin.IPSUR/R/First.r
pkg/RcmdrPlugin.IPSUR/R/enterTableProportionsTest.r
pkg/RcmdrPlugin.IPSUR/R/graphs-menu.R
pkg/RcmdrPlugin.IPSUR/R/misc.r
pkg/RcmdrPlugin.IPSUR/R/multiSamplePropTest.r
pkg/RcmdrPlugin.IPSUR/R/prob-cont-menu.R
pkg/RcmdrPlugin.IPSUR/R/prob-disc-menu.R
pkg/RcmdrPlugin.IPSUR/R/prob-sample-menu.R
pkg/RcmdrPlugin.IPSUR/R/prob-sim-menu.R
pkg/RcmdrPlugin.IPSUR/R/statistics-summaries-menu.R
pkg/RcmdrPlugin.IPSUR/R/statistics-tables-menu.R
Log:
updating for Rcmdr 2.1-0
Property changes on: pkg/RcmdrPlugin.IPSUR
___________________________________________________________________
Added: svn:ignore
+ .Rproj.user
.Rhistory
.RData
Modified: pkg/RcmdrPlugin.IPSUR/DESCRIPTION
===================================================================
--- pkg/RcmdrPlugin.IPSUR/DESCRIPTION 2013-01-25 11:59:19 UTC (rev 215)
+++ pkg/RcmdrPlugin.IPSUR/DESCRIPTION 2014-08-17 01:30:36 UTC (rev 216)
@@ -4,7 +4,7 @@
Title: An IPSUR Plugin for the R Commander
Author: G. Jay Kerns <gkerns at ysu.edu> with contributions by Theophilius Boye and Tyler Drombosky, adapted from the work of John Fox et al.
Maintainer: G. Jay Kerns <gkerns at ysu.edu>
-Imports: Rcmdr (>= 1.4-0), abind, e1071
+Imports: Rcmdr (>= 2.1-0)
Suggests: abind, car, distr, distrEx, e1071, effects (>= 1.0-7), foreign, grid, lattice, lmtest, MASS, mgcv, multcomp (>= 0.991-2), nlme, nnet, qcc, relimp, RODBC
LazyLoad: yes
LazyData: yes
Modified: pkg/RcmdrPlugin.IPSUR/NAMESPACE
===================================================================
--- pkg/RcmdrPlugin.IPSUR/NAMESPACE 2013-01-25 11:59:19 UTC (rev 215)
+++ pkg/RcmdrPlugin.IPSUR/NAMESPACE 2014-08-17 01:30:36 UTC (rev 216)
@@ -1,5 +1,5 @@
import(stats, Rcmdr)
-importFrom(e1071, skewness, kurtosis)
-importFrom(abind, abind)
+#importFrom(e1071, skewness, kurtosis)
+#importFrom(abind, abind)
exportPattern("^[^\\.]")
Modified: pkg/RcmdrPlugin.IPSUR/R/First.r
===================================================================
--- pkg/RcmdrPlugin.IPSUR/R/First.r 2013-01-25 11:59:19 UTC (rev 215)
+++ pkg/RcmdrPlugin.IPSUR/R/First.r 2014-08-17 01:30:36 UTC (rev 216)
@@ -21,4 +21,4 @@
Commander()
}
}
-}
\ No newline at end of file
+}
Modified: pkg/RcmdrPlugin.IPSUR/R/enterTableProportionsTest.r
===================================================================
--- pkg/RcmdrPlugin.IPSUR/R/enterTableProportionsTest.r 2013-01-25 11:59:19 UTC (rev 215)
+++ pkg/RcmdrPlugin.IPSUR/R/enterTableProportionsTest.r 2014-08-17 01:30:36 UTC (rev 216)
@@ -1,310 +1,310 @@
-# Last modified Feb 16, 2008
-
-
-`enterTableMultiPropTest` <-
-function ()
-{
- require("abind")
- env <- environment()
- initializeDialog(title = gettextRcmdr("Enter table for multi-proportions test"))
- outerTableFrame <- tkframe(top)
- assign(".tableFrame", tkframe(outerTableFrame), envir = env)
- setUpTable <- function(...) {
- tkdestroy(get(".tableFrame", envir = env))
- assign(".tableFrame", tkframe(outerTableFrame), envir = env)
- nrows <- as.numeric(tclvalue(rowsValue))
- ncols <- as.numeric(tclvalue(colsValue))
- make.col.names <- "tklabel(.tableFrame, text='')"
- col.varname <- paste(".colname.", 1, sep = "")
- assign(col.varname, tclVar("Success"), envir = env)
- make.col.names <- paste(make.col.names, ", ", "tkentry(.tableFrame, width='10', textvariable=",
- col.varname, ")", sep = "")
- col.varname <- paste(".colname.", 2, sep = "")
- assign(col.varname, tclVar("Failure"), envir = env)
- make.col.names <- paste(make.col.names, ", ", "tkentry(.tableFrame, width='10', textvariable=",
- col.varname, ")", sep = "")
- eval(parse(text = paste("tkgrid(", make.col.names, ")",
- sep = "")), envir = env)
- for (i in 1:nrows) {
- varname <- paste(".tab.", i, ".1", sep = "")
- assign(varname, tclVar(""), envir = env)
- row.varname <- paste(".rowname.", i, sep = "")
- assign(row.varname, tclVar(paste("Sample ", i, sep = "")),
- envir = env)
- make.row <- paste("tkentry(.tableFrame, width='10', textvariable=",
- row.varname, ")", sep = "")
- make.row <- paste(make.row, ", ", "tkentry(.tableFrame, width='10', textvariable=",
- varname, ")", sep = "")
- for (j in 2:ncols) {
- varname <- paste(".tab.", i, ".", j, sep = "")
- assign(varname, tclVar(""), envir = env)
- make.row <- paste(make.row, ", ", "tkentry(.tableFrame, width='10', textvariable=",
- varname, ")", sep = "")
- }
- eval(parse(text = paste("tkgrid(", make.row, ")",
- sep = "")), envir = env)
- }
- tkgrid(get(".tableFrame", envir = env), sticky = "w")
- }
- rowColFrame <- tkframe(top)
- rowsValue <- tclVar("2")
- rowsSlider <- tkscale(rowColFrame, from = 2, to = 10, showvalue = FALSE,
- variable = rowsValue, resolution = 1, orient = "horizontal",
- command = setUpTable)
- rowsShow <- tklabel(rowColFrame, textvariable = rowsValue,
- width = 2, justify = "right")
- colsValue <- tclVar("2")
- colsSlider <- tkscale(rowColFrame, from = 2, to = 10, showvalue = FALSE,
- variable = colsValue, resolution = 1, orient = "horizontal",
- command = setUpTable)
- colsShow <- tklabel(rowColFrame, textvariable = colsValue,
- width = 2, justify = "right")
- onOK <- function() {
- nrows <- as.numeric(tclvalue(rowsValue))
- ncols <- as.numeric(tclvalue(colsValue))
- cell <- 0
- counts <- rep(NA, nrows * ncols)
- row.names <- rep("", nrows)
- col.names <- rep("", ncols)
- for (i in 1:nrows) row.names[i] <- eval(parse(text = paste("tclvalue(",
- paste(".rowname.", i, sep = ""), ")", sep = "")))
- for (j in 1:ncols) col.names[j] <- eval(parse(text = paste("tclvalue(",
- paste(".colname.", j, sep = ""), ")", sep = "")))
- for (i in 1:nrows) {
- for (j in 1:ncols) {
- cell <- cell + 1
- varname <- paste(".tab.", i, ".", j, sep = "")
- counts[cell] <- as.numeric(eval(parse(text = paste("tclvalue(",
- varname, ")", sep = ""))))
- }
- }
- counts <- na.omit(counts)
- if (length(counts) != nrows * ncols) {
- errorCondition(recall = enterTableMultiPropTest,
- message = sprintf(gettextRcmdr("Number of valid entries (%d)\nnot equal to number of rows (%d) * number of columns (%d)."),
- length(counts), nrows, ncols))
- return()
- }
- if (length(unique(row.names)) != nrows) {
- errorCondition(recall = enterTableMultiPropTest,
- message = gettextRcmdr("Row names are not unique."))
- return()
- }
- if (length(unique(col.names)) != ncols) {
- errorCondition(recall = enterTableMultiPropTest,
- message = gettextRcmdr("Column names are not unique."))
- return()
- }
- closeDialog()
- command <- paste("matrix(c(", paste(counts, collapse = ","),
- "), ", nrows, ", ", ncols, ", byrow=TRUE)", sep = "")
- assign(".Table", justDoIt(command), envir = .GlobalEnv)
- logger(paste(".Table <- ", command, sep = ""))
- command <- paste("c(", paste(paste("'", row.names, "'",
- sep = ""), collapse = ", "), ")", sep = "")
- justDoIt(paste("rownames(.Table) <- ", command, sep = ""))
- logger(paste("rownames(.Table) <- ", command, sep = ""))
- command <- paste("c(", paste(paste("'", col.names, "'",
- sep = ""), collapse = ", "), ")", sep = "")
- justDoIt(paste("colnames(.Table) <- ", command, sep = ""))
- logger(paste("colnames(.Table) <- ", command, sep = ""))
- alternative <- as.character(tclvalue(alternativeVariable))
- level <- tclvalue(confidenceLevel)
- test <- as.character(tclvalue(testVariable))
- if (test == "normal")
- doItAndPrint(paste("prop.test(.Table, alternative='",
- alternative, "', conf.level=", level, ", correct=FALSE)",
- sep = ""))
- else doItAndPrint(paste("prop.test(.Table, alternative='",
- alternative, "', conf.level=", level, ", correct=TRUE)",
- sep = ""))
- logger("remove(.Table)")
- remove(.Table, envir = .GlobalEnv)
- tkfocus(CommanderWindow())
- }
- OKCancelHelp(helpSubject = "prop.test")
- radioButtons(name = "alternative", buttons = c("twosided",
- "less", "greater"), values = c("two.sided", "less", "greater"),
- labels = gettextRcmdr(c("Two-sided", "Difference < 0 (samples=2)",
- "Difference > 0 (samples=2)")), title = gettextRcmdr("Alternative Hypothesis"))
- confidenceFrame <- tkframe(top)
- confidenceLevel <- tclVar("0.95")
- confidenceField <- tkentry(confidenceFrame, width = "6",
- textvariable = confidenceLevel)
- radioButtons(name = "test", buttons = c("normal", "corrected"),
- labels = gettextRcmdr(c("Normal approximation", "Normal approximation with\ncontinuity correction (samples=2)")),
- title = gettextRcmdr("Type of Test"))
- tkgrid(tklabel(rowColFrame, text = gettextRcmdr("Number of Rows (samples):")),
- rowsSlider, rowsShow, sticky = "w")
- tkgrid(rowColFrame, sticky = "w")
- tkgrid(tklabel(top, text = gettextRcmdr("Enter counts:"),
- fg = "blue"), sticky = "w")
- tkgrid(outerTableFrame, sticky = "w")
- tkgrid(tklabel(top, text = gettextRcmdr("\nOptions:"), fg = "blue"),
- sticky = "w")
- tkgrid(tklabel(confidenceFrame, text = gettextRcmdr("Confidence Level (samples=2): ")),
- confidenceField, sticky = "w")
- tkgrid(confidenceFrame, sticky = "w")
- tkgrid(alternativeFrame, sticky = "nw")
- tkgrid(testFrame, sticky = "w")
- tkgrid(buttonsFrame, columnspan = 2, sticky = "w")
- dialogSuffix(rows = 5, columns = 2)
-}
-
-
-
-`enterTableSinglePropTest` <-
-function ()
-{
- require("abind")
- env <- environment()
- initializeDialog(title = gettextRcmdr("Enter table for single-proportion test"))
- outerTableFrame <- tkframe(top)
- assign(".tableFrame", tkframe(outerTableFrame), envir = env)
- setUpTable <- function(...) {
- tkdestroy(get(".tableFrame", envir = env))
- assign(".tableFrame", tkframe(outerTableFrame), envir = env)
- nrows <- as.numeric(tclvalue(rowsValue))
- ncols <- as.numeric(tclvalue(colsValue))
- make.col.names <- "tklabel(.tableFrame, text='')"
- col.varname <- paste(".colname.", 1, sep = "")
- assign(col.varname, tclVar("Success"), envir = env)
- make.col.names <- paste(make.col.names, ", ", "tkentry(.tableFrame, width='7', textvariable=",
- col.varname, ")", sep = "")
- col.varname <- paste(".colname.", 2, sep = "")
- assign(col.varname, tclVar("Failure"), envir = env)
- make.col.names <- paste(make.col.names, ", ", "tkentry(.tableFrame, width='7', textvariable=",
- col.varname, ")", sep = "")
- eval(parse(text = paste("tkgrid(", make.col.names, ")",
- sep = "")), envir = env)
- for (i in 1:nrows) {
- varname <- paste(".tab.", i, ".1", sep = "")
- assign(varname, tclVar(""), envir = env)
- row.varname <- paste(".rowname.", i, sep = "")
- assign(row.varname, tclVar("Counts:"), envir = env)
- make.row <- paste("tkentry(.tableFrame, width='7', textvariable=",
- row.varname, ")", sep = "")
- make.row <- paste(make.row, ", ", "tkentry(.tableFrame, width='7', textvariable=",
- varname, ")", sep = "")
- for (j in 2:ncols) {
- varname <- paste(".tab.", i, ".", j, sep = "")
- assign(varname, tclVar(""), envir = env)
- make.row <- paste(make.row, ", ", "tkentry(.tableFrame, width='7', textvariable=",
- varname, ")", sep = "")
- }
- eval(parse(text = paste("tkgrid(", make.row, ")",
- sep = "")), envir = env)
- }
- tkgrid(get(".tableFrame", envir = env), sticky = "w")
- }
- rowColFrame <- tkframe(top)
- rowsValue <- tclVar("1")
- rowsSlider <- tkscale(rowColFrame, from = 1, to = 1, showvalue = FALSE,
- variable = rowsValue, resolution = 1, orient = "horizontal",
- command = setUpTable)
- rowsShow <- tklabel(rowColFrame, textvariable = rowsValue,
- width = 2, justify = "right")
- colsValue <- tclVar("2")
- colsSlider <- tkscale(rowColFrame, from = 2, to = 10, showvalue = FALSE,
- variable = colsValue, resolution = 1, orient = "horizontal",
- command = setUpTable)
- colsShow <- tklabel(rowColFrame, textvariable = colsValue,
- width = 2, justify = "right")
- onOK <- function() {
- nrows <- as.numeric(tclvalue(rowsValue))
- ncols <- as.numeric(tclvalue(colsValue))
- cell <- 0
- counts <- rep(NA, nrows * ncols)
- row.names <- rep("", nrows)
- col.names <- rep("", ncols)
- for (i in 1:nrows) row.names[i] <- eval(parse(text = paste("tclvalue(",
- paste(".rowname.", i, sep = ""), ")", sep = "")))
- for (j in 1:ncols) col.names[j] <- eval(parse(text = paste("tclvalue(",
- paste(".colname.", j, sep = ""), ")", sep = "")))
- for (i in 1:nrows) {
- for (j in 1:ncols) {
- cell <- cell + 1
- varname <- paste(".tab.", i, ".", j, sep = "")
- counts[cell] <- as.numeric(eval(parse(text = paste("tclvalue(",
- varname, ")", sep = ""))))
- }
- }
- counts <- na.omit(counts)
- if (length(counts) != nrows * ncols) {
- errorCondition(recall = enterTableSinglePropTest,
- message = sprintf(gettextRcmdr("Number of valid entries (%d)\nnot equal to number of rows (%d) * number of columns (%d)."),
- length(counts), nrows, ncols))
- return()
- }
- if (length(unique(col.names)) != ncols) {
- errorCondition(recall = enterTableSinglePropTest,
- message = gettextRcmdr("Column names are not unique."))
- return()
- }
- closeDialog()
- command <- paste("matrix(c(", paste(counts, collapse = ","),
- "), ", nrows, ", ", ncols, ", byrow=TRUE)", sep = "")
- assign(".Table", justDoIt(command), envir = .GlobalEnv)
- logger(paste(".Table <- ", command, sep = ""))
- command <- paste("c(", paste(paste("'", row.names, "'",
- sep = ""), collapse = ", "), ")", sep = "")
- justDoIt(paste("rownames(.Table) <- ", command, sep = ""))
- logger(paste("rownames(.Table) <- ", command, sep = ""))
- command <- paste("c(", paste(paste("'", col.names, "'",
- sep = ""), collapse = ", "), ")", sep = "")
- justDoIt(paste("colnames(.Table) <- ", command, sep = ""))
- logger(paste("colnames(.Table) <- ", command, sep = ""))
- alternative <- as.character(tclvalue(alternativeVariable))
- level <- tclvalue(confidenceLevel)
- test <- as.character(tclvalue(testVariable))
- p <- tclvalue(pVariable)
- if (test == "normal")
- doItAndPrint(paste("prop.test(rbind(.Table), alternative='",
- alternative, "', p=", p, ", conf.level=", level,
- ", correct=FALSE)", sep = ""))
- else if (test == "corrected")
- doItAndPrint(paste("prop.test(rbind(.Table), alternative='",
- alternative, "', p=", p, ", conf.level=", level,
- ", correct=TRUE)", sep = ""))
- else doItAndPrint(paste("binom.test(rbind(.Table), alternative='",
- alternative, "', p=", p, ", conf.level=", level,
- ")", sep = ""))
- logger("remove(.Table)")
- remove(.Table, envir = .GlobalEnv)
- tkfocus(CommanderWindow())
- }
- OKCancelHelp(helpSubject = "prop.test")
- radioButtons(top, name = "alternative", buttons = c("twosided",
- "less", "greater"), values = c("two.sided", "less", "greater"),
- labels = gettextRcmdr(c("Population proportion = p0",
- "Population proportion < p0", "Population proportion > p0")),
- title = gettextRcmdr("Alternative Hypothesis"))
- rightFrame <- tkframe(top)
- confidenceFrame <- tkframe(top)
- confidenceLevel <- tclVar("0.95")
- confidenceField <- tkentry(confidenceFrame, width = "6",
- textvariable = confidenceLevel)
- pFrame <- tkframe(top)
- pVariable <- tclVar("0.5")
- pField <- tkentry(pFrame, width = "6", textvariable = pVariable)
- radioButtons(name = "test", buttons = c("normal", "corrected",
- "exact"), labels = gettextRcmdr(c("Normal approximation",
- "Normal approximation with\ncontinuity correction", "Exact binomial")),
- title = gettextRcmdr("Type of Test"))
- tkgrid(tklabel(rowColFrame, text = gettextRcmdr("Number of Rows (single sample):")),
- rowsSlider, rowsShow, sticky = "w")
- tkgrid(rowColFrame, sticky = "w")
- tkgrid(outerTableFrame, sticky = "w")
- tkgrid(tklabel(top, text = gettextRcmdr("\nOptions:"), fg = "blue"),
- sticky = "w")
- tkgrid(tklabel(pFrame, text = gettextRcmdr("Null hypothesis: p0 = ")),
- pField, sticky = "w")
- tkgrid(pFrame, sticky = "w")
- tkgrid(tklabel(confidenceFrame, text = gettextRcmdr("Confidence Level: ")),
- confidenceField, sticky = "w")
- tkgrid(confidenceFrame, sticky = "w")
- tkgrid(alternativeFrame, sticky = "nw")
- tkgrid(testFrame, sticky = "w")
- tkgrid(buttonsFrame, columnspan = 2, sticky = "w")
- dialogSuffix(rows = 5, columns = 2)
-}
+# Last modified Feb 16, 2008
+
+
+`enterTableMultiPropTest` <-
+function ()
+{
+ require("abind")
+ env <- environment()
+ initializeDialog(title = gettextRcmdr("Enter table for multi-proportions test"))
+ outerTableFrame <- tkframe(top)
+ assign(".tableFrame", tkframe(outerTableFrame), envir = env)
+ setUpTable <- function(...) {
+ tkdestroy(get(".tableFrame", envir = env))
+ assign(".tableFrame", tkframe(outerTableFrame), envir = env)
+ nrows <- as.numeric(tclvalue(rowsValue))
+ ncols <- as.numeric(tclvalue(colsValue))
+ make.col.names <- "tklabel(.tableFrame, text='')"
+ col.varname <- paste(".colname.", 1, sep = "")
+ assign(col.varname, tclVar("Success"), envir = env)
+ make.col.names <- paste(make.col.names, ", ", "tkentry(.tableFrame, width='10', textvariable=",
+ col.varname, ")", sep = "")
+ col.varname <- paste(".colname.", 2, sep = "")
+ assign(col.varname, tclVar("Failure"), envir = env)
+ make.col.names <- paste(make.col.names, ", ", "tkentry(.tableFrame, width='10', textvariable=",
+ col.varname, ")", sep = "")
+ eval(parse(text = paste("tkgrid(", make.col.names, ")",
+ sep = "")), envir = env)
+ for (i in 1:nrows) {
+ varname <- paste(".tab.", i, ".1", sep = "")
+ assign(varname, tclVar(""), envir = env)
+ row.varname <- paste(".rowname.", i, sep = "")
+ assign(row.varname, tclVar(paste("Sample ", i, sep = "")),
+ envir = env)
+ make.row <- paste("tkentry(.tableFrame, width='10', textvariable=",
+ row.varname, ")", sep = "")
+ make.row <- paste(make.row, ", ", "tkentry(.tableFrame, width='10', textvariable=",
+ varname, ")", sep = "")
+ for (j in 2:ncols) {
+ varname <- paste(".tab.", i, ".", j, sep = "")
+ assign(varname, tclVar(""), envir = env)
+ make.row <- paste(make.row, ", ", "tkentry(.tableFrame, width='10', textvariable=",
+ varname, ")", sep = "")
+ }
+ eval(parse(text = paste("tkgrid(", make.row, ")",
+ sep = "")), envir = env)
+ }
+ tkgrid(get(".tableFrame", envir = env), sticky = "w")
+ }
+ rowColFrame <- tkframe(top)
+ rowsValue <- tclVar("2")
+ rowsSlider <- tkscale(rowColFrame, from = 2, to = 10, showvalue = FALSE,
+ variable = rowsValue, resolution = 1, orient = "horizontal",
+ command = setUpTable)
+ rowsShow <- tklabel(rowColFrame, textvariable = rowsValue,
+ width = 2, justify = "right")
+ colsValue <- tclVar("2")
+ colsSlider <- tkscale(rowColFrame, from = 2, to = 10, showvalue = FALSE,
+ variable = colsValue, resolution = 1, orient = "horizontal",
+ command = setUpTable)
+ colsShow <- tklabel(rowColFrame, textvariable = colsValue,
+ width = 2, justify = "right")
+ onOK <- function() {
+ nrows <- as.numeric(tclvalue(rowsValue))
+ ncols <- as.numeric(tclvalue(colsValue))
+ cell <- 0
+ counts <- rep(NA, nrows * ncols)
+ row.names <- rep("", nrows)
+ col.names <- rep("", ncols)
+ for (i in 1:nrows) row.names[i] <- eval(parse(text = paste("tclvalue(",
+ paste(".rowname.", i, sep = ""), ")", sep = "")))
+ for (j in 1:ncols) col.names[j] <- eval(parse(text = paste("tclvalue(",
+ paste(".colname.", j, sep = ""), ")", sep = "")))
+ for (i in 1:nrows) {
+ for (j in 1:ncols) {
+ cell <- cell + 1
+ varname <- paste(".tab.", i, ".", j, sep = "")
+ counts[cell] <- as.numeric(eval(parse(text = paste("tclvalue(",
+ varname, ")", sep = ""))))
+ }
+ }
+ counts <- na.omit(counts)
+ if (length(counts) != nrows * ncols) {
+ errorCondition(recall = enterTableMultiPropTest,
+ message = sprintf(gettextRcmdr("Number of valid entries (%d)\nnot equal to number of rows (%d) * number of columns (%d)."),
+ length(counts), nrows, ncols))
+ return()
+ }
+ if (length(unique(row.names)) != nrows) {
+ errorCondition(recall = enterTableMultiPropTest,
+ message = gettextRcmdr("Row names are not unique."))
+ return()
+ }
+ if (length(unique(col.names)) != ncols) {
+ errorCondition(recall = enterTableMultiPropTest,
+ message = gettextRcmdr("Column names are not unique."))
+ return()
+ }
+ closeDialog()
+ command <- paste(".Table <- matrix(c(", paste(counts, collapse = ","),
+ "), ", nrows, ", ", ncols, ", byrow=TRUE)", sep = "")
+ justDoIt(command)
+ logger(paste(command, sep = ""))
+ command <- paste("c(", paste(paste("'", row.names, "'",
+ sep = ""), collapse = ", "), ")", sep = "")
+ justDoIt(paste("rownames(.Table) <- ", command, sep = ""))
+ logger(paste("rownames(.Table) <- ", command, sep = ""))
+ command <- paste("c(", paste(paste("'", col.names, "'",
+ sep = ""), collapse = ", "), ")", sep = "")
+ justDoIt(paste("colnames(.Table) <- ", command, sep = ""))
+ logger(paste("colnames(.Table) <- ", command, sep = ""))
+ alternative <- as.character(tclvalue(alternativeVariable))
+ level <- tclvalue(confidenceLevel)
+ test <- as.character(tclvalue(testVariable))
+ if (test == "normal")
+ doItAndPrint(paste("prop.test(.Table, alternative='",
+ alternative, "', conf.level=", level, ", correct=FALSE)",
+ sep = ""))
+ else doItAndPrint(paste("prop.test(.Table, alternative='",
+ alternative, "', conf.level=", level, ", correct=TRUE)",
+ sep = ""))
+ logger("remove(.Table)")
+ remove(.Table, envir = .GlobalEnv)
+ tkfocus(CommanderWindow())
+ }
+ OKCancelHelp(helpSubject = "prop.test")
+ radioButtons(name = "alternative", buttons = c("twosided",
+ "less", "greater"), values = c("two.sided", "less", "greater"),
+ labels = gettextRcmdr(c("Two-sided", "Difference < 0 (samples=2)",
+ "Difference > 0 (samples=2)")), title = gettextRcmdr("Alternative Hypothesis"))
+ confidenceFrame <- tkframe(top)
+ confidenceLevel <- tclVar("0.95")
+ confidenceField <- tkentry(confidenceFrame, width = "6",
+ textvariable = confidenceLevel)
+ radioButtons(name = "test", buttons = c("normal", "corrected"),
+ labels = gettextRcmdr(c("Normal approximation", "Normal approximation with\ncontinuity correction (samples=2)")),
+ title = gettextRcmdr("Type of Test"))
+ tkgrid(tklabel(rowColFrame, text = gettextRcmdr("Number of Rows (samples):")),
+ rowsSlider, rowsShow, sticky = "w")
+ tkgrid(rowColFrame, sticky = "w")
+ tkgrid(tklabel(top, text = gettextRcmdr("Enter counts:"),
+ fg = "blue"), sticky = "w")
+ tkgrid(outerTableFrame, sticky = "w")
+ tkgrid(tklabel(top, text = gettextRcmdr("\nOptions:"), fg = "blue"),
+ sticky = "w")
+ tkgrid(tklabel(confidenceFrame, text = gettextRcmdr("Confidence Level (samples=2): ")),
+ confidenceField, sticky = "w")
+ tkgrid(confidenceFrame, sticky = "w")
+ tkgrid(alternativeFrame, sticky = "nw")
+ tkgrid(testFrame, sticky = "w")
+ tkgrid(buttonsFrame, columnspan = 2, sticky = "w")
+ dialogSuffix(rows = 5, columns = 2)
+}
+
+
+
+`enterTableSinglePropTest` <-
+function ()
+{
+ require("abind")
+ env <- environment()
+ initializeDialog(title = gettextRcmdr("Enter table for single-proportion test"))
+ outerTableFrame <- tkframe(top)
+ assign(".tableFrame", tkframe(outerTableFrame), envir = env)
+ setUpTable <- function(...) {
+ tkdestroy(get(".tableFrame", envir = env))
+ assign(".tableFrame", tkframe(outerTableFrame), envir = env)
+ nrows <- as.numeric(tclvalue(rowsValue))
+ ncols <- as.numeric(tclvalue(colsValue))
+ make.col.names <- "tklabel(.tableFrame, text='')"
+ col.varname <- paste(".colname.", 1, sep = "")
+ assign(col.varname, tclVar("Success"), envir = env)
+ make.col.names <- paste(make.col.names, ", ", "tkentry(.tableFrame, width='7', textvariable=",
+ col.varname, ")", sep = "")
+ col.varname <- paste(".colname.", 2, sep = "")
+ assign(col.varname, tclVar("Failure"), envir = env)
+ make.col.names <- paste(make.col.names, ", ", "tkentry(.tableFrame, width='7', textvariable=",
+ col.varname, ")", sep = "")
+ eval(parse(text = paste("tkgrid(", make.col.names, ")",
+ sep = "")), envir = env)
+ for (i in 1:nrows) {
+ varname <- paste(".tab.", i, ".1", sep = "")
+ assign(varname, tclVar(""), envir = env)
+ row.varname <- paste(".rowname.", i, sep = "")
+ assign(row.varname, tclVar("Counts:"), envir = env)
+ make.row <- paste("tkentry(.tableFrame, width='7', textvariable=",
+ row.varname, ")", sep = "")
+ make.row <- paste(make.row, ", ", "tkentry(.tableFrame, width='7', textvariable=",
+ varname, ")", sep = "")
+ for (j in 2:ncols) {
+ varname <- paste(".tab.", i, ".", j, sep = "")
+ assign(varname, tclVar(""), envir = env)
+ make.row <- paste(make.row, ", ", "tkentry(.tableFrame, width='7', textvariable=",
+ varname, ")", sep = "")
+ }
+ eval(parse(text = paste("tkgrid(", make.row, ")",
+ sep = "")), envir = env)
+ }
+ tkgrid(get(".tableFrame", envir = env), sticky = "w")
+ }
+ rowColFrame <- tkframe(top)
+ rowsValue <- tclVar("1")
+ rowsSlider <- tkscale(rowColFrame, from = 1, to = 1, showvalue = FALSE,
+ variable = rowsValue, resolution = 1, orient = "horizontal",
+ command = setUpTable)
+ rowsShow <- tklabel(rowColFrame, textvariable = rowsValue,
+ width = 2, justify = "right")
+ colsValue <- tclVar("2")
+ colsSlider <- tkscale(rowColFrame, from = 2, to = 10, showvalue = FALSE,
+ variable = colsValue, resolution = 1, orient = "horizontal",
+ command = setUpTable)
+ colsShow <- tklabel(rowColFrame, textvariable = colsValue,
+ width = 2, justify = "right")
+ onOK <- function() {
+ nrows <- as.numeric(tclvalue(rowsValue))
+ ncols <- as.numeric(tclvalue(colsValue))
+ cell <- 0
+ counts <- rep(NA, nrows * ncols)
+ row.names <- rep("", nrows)
+ col.names <- rep("", ncols)
+ for (i in 1:nrows) row.names[i] <- eval(parse(text = paste("tclvalue(",
+ paste(".rowname.", i, sep = ""), ")", sep = "")))
+ for (j in 1:ncols) col.names[j] <- eval(parse(text = paste("tclvalue(",
+ paste(".colname.", j, sep = ""), ")", sep = "")))
+ for (i in 1:nrows) {
+ for (j in 1:ncols) {
+ cell <- cell + 1
+ varname <- paste(".tab.", i, ".", j, sep = "")
+ counts[cell] <- as.numeric(eval(parse(text = paste("tclvalue(",
+ varname, ")", sep = ""))))
+ }
+ }
+ counts <- na.omit(counts)
+ if (length(counts) != nrows * ncols) {
+ errorCondition(recall = enterTableSinglePropTest,
+ message = sprintf(gettextRcmdr("Number of valid entries (%d)\nnot equal to number of rows (%d) * number of columns (%d)."),
+ length(counts), nrows, ncols))
+ return()
+ }
+ if (length(unique(col.names)) != ncols) {
+ errorCondition(recall = enterTableSinglePropTest,
+ message = gettextRcmdr("Column names are not unique."))
+ return()
+ }
+ closeDialog()
+ command <- paste(".Table <- matrix(c(", paste(counts, collapse = ","),
+ "), ", nrows, ", ", ncols, ", byrow=TRUE)", sep = "")
+ justDoIt(command)
+ logger(paste(command, sep = ""))
+ command <- paste("c(", paste(paste("'", row.names, "'",
+ sep = ""), collapse = ", "), ")", sep = "")
+ justDoIt(paste("rownames(.Table) <- ", command, sep = ""))
+ logger(paste("rownames(.Table) <- ", command, sep = ""))
+ command <- paste("c(", paste(paste("'", col.names, "'",
+ sep = ""), collapse = ", "), ")", sep = "")
+ justDoIt(paste("colnames(.Table) <- ", command, sep = ""))
+ logger(paste("colnames(.Table) <- ", command, sep = ""))
+ alternative <- as.character(tclvalue(alternativeVariable))
+ level <- tclvalue(confidenceLevel)
+ test <- as.character(tclvalue(testVariable))
+ p <- tclvalue(pVariable)
+ if (test == "normal")
+ doItAndPrint(paste("prop.test(rbind(.Table), alternative='",
+ alternative, "', p=", p, ", conf.level=", level,
+ ", correct=FALSE)", sep = ""))
+ else if (test == "corrected")
+ doItAndPrint(paste("prop.test(rbind(.Table), alternative='",
+ alternative, "', p=", p, ", conf.level=", level,
+ ", correct=TRUE)", sep = ""))
+ else doItAndPrint(paste("binom.test(rbind(.Table), alternative='",
+ alternative, "', p=", p, ", conf.level=", level,
+ ")", sep = ""))
+ logger("remove(.Table)")
+ remove(.Table, envir = .GlobalEnv)
+ tkfocus(CommanderWindow())
+ }
+ OKCancelHelp(helpSubject = "prop.test")
+ radioButtons(top, name = "alternative", buttons = c("twosided",
+ "less", "greater"), values = c("two.sided", "less", "greater"),
+ labels = gettextRcmdr(c("Population proportion = p0",
+ "Population proportion < p0", "Population proportion > p0")),
+ title = gettextRcmdr("Alternative Hypothesis"))
+ rightFrame <- tkframe(top)
+ confidenceFrame <- tkframe(top)
+ confidenceLevel <- tclVar("0.95")
+ confidenceField <- tkentry(confidenceFrame, width = "6",
+ textvariable = confidenceLevel)
+ pFrame <- tkframe(top)
+ pVariable <- tclVar("0.5")
+ pField <- tkentry(pFrame, width = "6", textvariable = pVariable)
+ radioButtons(name = "test", buttons = c("normal", "corrected",
+ "exact"), labels = gettextRcmdr(c("Normal approximation",
+ "Normal approximation with\ncontinuity correction", "Exact binomial")),
+ title = gettextRcmdr("Type of Test"))
+ tkgrid(tklabel(rowColFrame, text = gettextRcmdr("Number of Rows (single sample):")),
+ rowsSlider, rowsShow, sticky = "w")
+ tkgrid(rowColFrame, sticky = "w")
+ tkgrid(outerTableFrame, sticky = "w")
+ tkgrid(tklabel(top, text = gettextRcmdr("\nOptions:"), fg = "blue"),
+ sticky = "w")
+ tkgrid(tklabel(pFrame, text = gettextRcmdr("Null hypothesis: p0 = ")),
+ pField, sticky = "w")
+ tkgrid(pFrame, sticky = "w")
+ tkgrid(tklabel(confidenceFrame, text = gettextRcmdr("Confidence Level: ")),
+ confidenceField, sticky = "w")
+ tkgrid(confidenceFrame, sticky = "w")
+ tkgrid(alternativeFrame, sticky = "nw")
+ tkgrid(testFrame, sticky = "w")
+ tkgrid(buttonsFrame, columnspan = 2, sticky = "w")
+ dialogSuffix(rows = 5, columns = 2)
+}
Modified: pkg/RcmdrPlugin.IPSUR/R/graphs-menu.R
===================================================================
--- pkg/RcmdrPlugin.IPSUR/R/graphs-menu.R 2013-01-25 11:59:19 UTC (rev 215)
+++ pkg/RcmdrPlugin.IPSUR/R/graphs-menu.R 2014-08-17 01:30:36 UTC (rev 216)
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/ipsur -r 216
More information about the IPSUR-commits
mailing list