[IPSUR-commits] r217 - pkg/RcmdrPlugin.IPSUR/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Aug 29 18:02:52 CEST 2014
Author: gkerns
Date: 2014-08-29 18:02:51 +0200 (Fri, 29 Aug 2014)
New Revision: 217
Modified:
pkg/RcmdrPlugin.IPSUR/R/misc.r
pkg/RcmdrPlugin.IPSUR/R/prob-sim-menu.R
Log:
deleted Simulate menu
Modified: pkg/RcmdrPlugin.IPSUR/R/misc.r
===================================================================
--- pkg/RcmdrPlugin.IPSUR/R/misc.r 2014-08-17 01:30:36 UTC (rev 216)
+++ pkg/RcmdrPlugin.IPSUR/R/misc.r 2014-08-29 16:02:51 UTC (rev 217)
@@ -59,44 +59,44 @@
-#######
-# Need this to assign numbers below
-RcmdrEnv <- function() {
- pos <- match("RcmdrEnv", search())
- if (is.na(pos)) { # Must create it
- RcmdrEnv <- list()
- attach(RcmdrEnv, pos = length(search()) - 1)
- on.exit(detach(RcmdrEnv))
- rm(RcmdrEnv)
- pos <- match("RcmdrEnv", search())
- }
- return(pos.to.env(pos))
- }
-
-###############################################################
-###############################################################
-# Extra counters
- #assign("simsetNumber", 0, envir = RcmdrEnv())
- #assign("datasetNumber", 0, envir = RcmdrEnv())
- assign("betasimNumber", 0, envir = RcmdrEnv())
- assign("chisqsimNumber", 0, envir = RcmdrEnv())
- assign("binomsimNumber", 0, envir = RcmdrEnv())
- assign("hypersimNumber", 0, envir = RcmdrEnv())
- assign("gammasimNumber", 0, envir = RcmdrEnv())
- assign("expsimNumber", 0, envir = RcmdrEnv())
- assign("normsimNumber", 0, envir = RcmdrEnv())
- assign("fsimNumber", 0, envir = RcmdrEnv())
- assign("tsimNumber", 0, envir = RcmdrEnv())
- assign("cauchysimNumber", 0, envir = RcmdrEnv())
- assign("geomsimNumber", 0, envir = RcmdrEnv())
- assign("lnormsimNumber", 0, envir = RcmdrEnv())
- assign("logissimNumber", 0, envir = RcmdrEnv())
- assign("nbinomsimNumber", 0, envir = RcmdrEnv())
- assign("poissimNumber", 0, envir = RcmdrEnv())
- assign("weibullsimNumber", 0, envir = RcmdrEnv())
- assign("unifsimNumber", 0, envir = RcmdrEnv())
- assign("disunifsimNumber", 0, envir = RcmdrEnv())
-
-###############################################################
-###############################################################
-# End Extra counters
+# #######
+# # Need this to assign numbers below
+# RcmdrEnv <- function() {
+# pos <- match("RcmdrEnv", search())
+# if (is.na(pos)) { # Must create it
+# RcmdrEnv <- list()
+# attach(RcmdrEnv, pos = length(search()) - 1)
+# on.exit(detach(RcmdrEnv))
+# rm(RcmdrEnv)
+# pos <- match("RcmdrEnv", search())
+# }
+# return(pos.to.env(pos))
+# }
+#
+# ###############################################################
+# ###############################################################
+# # Extra counters
+# #assign("simsetNumber", 0, envir = RcmdrEnv())
+# #assign("datasetNumber", 0, envir = RcmdrEnv())
+# assign("betasimNumber", 0, envir = RcmdrEnv())
+# assign("chisqsimNumber", 0, envir = RcmdrEnv())
+# assign("binomsimNumber", 0, envir = RcmdrEnv())
+# assign("hypersimNumber", 0, envir = RcmdrEnv())
+# assign("gammasimNumber", 0, envir = RcmdrEnv())
+# assign("expsimNumber", 0, envir = RcmdrEnv())
+# assign("normsimNumber", 0, envir = RcmdrEnv())
+# assign("fsimNumber", 0, envir = RcmdrEnv())
+# assign("tsimNumber", 0, envir = RcmdrEnv())
+# assign("cauchysimNumber", 0, envir = RcmdrEnv())
+# assign("geomsimNumber", 0, envir = RcmdrEnv())
+# assign("lnormsimNumber", 0, envir = RcmdrEnv())
+# assign("logissimNumber", 0, envir = RcmdrEnv())
+# assign("nbinomsimNumber", 0, envir = RcmdrEnv())
+# assign("poissimNumber", 0, envir = RcmdrEnv())
+# assign("weibullsimNumber", 0, envir = RcmdrEnv())
+# assign("unifsimNumber", 0, envir = RcmdrEnv())
+# assign("disunifsimNumber", 0, envir = RcmdrEnv())
+#
+# ###############################################################
+# ###############################################################
+# # End Extra counters
Modified: pkg/RcmdrPlugin.IPSUR/R/prob-sim-menu.R
===================================================================
--- pkg/RcmdrPlugin.IPSUR/R/prob-sim-menu.R 2014-08-17 01:30:36 UTC (rev 216)
+++ pkg/RcmdrPlugin.IPSUR/R/prob-sim-menu.R 2014-08-29 16:02:51 UTC (rev 217)
@@ -1,2987 +1,2987 @@
-# Last modified Feb 14, 2008
-# simulations optimized by Tyler Drombosky 2007
-
-`betaSimulate.ipsur` <-
-function ()
-{
- initializeDialog(title = gettextRcmdr("Simulate Beta Variates"))
- parameterFrame <- tkframe(top)
- locationFrame <- tkframe(top)
- if (!is.character(ActiveDataSet())) {
- locVariable <- tclVar("new")
- }
- else {
- locVariable <- tclVar("add")
- }
- addtoactiveButton <- tkradiobutton(locationFrame, variable = locVariable,
- value = "add")
- newDataButton <- tkradiobutton(locationFrame, variable = locVariable,
- value = "new")
- samplesVar <- tclVar("1")
- samplesEntry <- tkentry(top, width = "6", textvariable = samplesVar)
- shape1Var <- tclVar("1")
- shape1Entry <- tkentry(top, width = "6", textvariable = shape1Var)
- shape2Var <- tclVar("1")
- shape2Entry <- tkentry(top, width = "6", textvariable = shape2Var)
- ncpVar <- tclVar("0")
- ncpEntry <- tkentry(top, width = "6", textvariable = ncpVar)
- onOK <- function() {
- nsamples <- round(as.numeric(tclvalue(samplesVar)))
- shape1 <- tclvalue(shape1Var)
- shape2 <- tclvalue(shape2Var)
- ncp <- tclvalue(ncpVar)
- if (is.na(nsamples)) {
- errorCondition(recall = betaSimulate.ipsur, message = gettextRcmdr("Number of samples must be a positive integer."))
- return()
- }
- if (is.na(shape1)) {
- errorCondition(recall = betaSimulate.ipsur, message = gettextRcmdr("The shape1 parameter was not specified."))
- return()
- }
- if (is.na(shape2)) {
- errorCondition(recall = betaSimulate.ipsur, message = gettextRcmdr("The shape2 parameter was not specified."))
- return()
- }
- if (is.na(ncp)) {
- errorCondition(recall = betaSimulate.ipsur, message = gettextRcmdr("The noncentrality parameter was not specified."))
- return()
- }
- closeDialog()
- store <- tclvalue(locVariable)
- if (store == "new") {
- initializeDialog(title = gettextRcmdr("Simulation Dataset"))
- dsname <- tclVar("Simset")
- entryDsname <- tkentry(top, width = "20", textvariable = dsname)
- newDataSS <- tclVar("100")
- entryNewDataSS <- tkentry(top, width = "6", textvariable = newDataSS)
- onOK <- function() {
- dsnameValue <- trim.blanks(tclvalue(dsname))
- newSS <- round(as.numeric(tclvalue(newDataSS)))
- closeDialog()
- if (dsnameValue == "") {
- errorCondition(recall = betaSimulate.ipsur,
- message = gettextRcmdr("You must enter the name of a data set."))
- return()
- }
- if (!is.valid.name(dsnameValue)) {
- errorCondition(recall = betaSimulate.ipsur,
- message = paste("\"", dsnameValue, "\" ",
- gettextRcmdr("is not a valid name."), sep = ""))
- return()
- }
- if (is.element(dsnameValue, listDataSets())) {
- if ("no" == tclvalue(checkReplace(dsnameValue,
- gettextRcmdr("Data set")))) {
- betaSimulate.ipsur()
- return()
- }
- }
- if (is.na(newSS)) {
- errorCondition(recall = betaSimulate.ipsur,
- message = gettextRcmdr("Sample Size must be a positive integer."))
- return()
- }
- UpdatebetasimNumber()
- justDoIt(paste(dsnameValue, " = data.frame(beta.sim",
- getRcmdr("betasimNumber"), "=1:", newSS, ")",
- sep = ""))
- logger(paste(dsnameValue, "has been initialized."))
- for (k in getRcmdr("betasimNumber"):(nsamples +
- getRcmdr("betasimNumber") - 1)) {
- justDoIt(paste(dsnameValue, "$beta.sim", k,
- " <- rbeta(", newSS, ", shape1=", shape1,
- ", shape2=", shape2, ", ncp=", ncp, ")",
- sep = ""))
- }
- activeDataSet(dsnameValue)
- putRcmdr("betasimNumber", k)
- if (nsamples == 1) {
- logger(paste("There was 1 beta variate sample stored in ",
- dsnameValue, ".", sep = ""))
- }
- else {
- logger(paste("There were ", nsamples, " beta variate samples stored in ",
- dsnameValue, ".", sep = ""))
- }
- }
- OKCancelHelp(helpSubject = "rbeta")
- tkgrid(tklabel(top, text = gettextRcmdr("Enter name for data set:")),
- entryDsname, sticky = "e")
- tkgrid(tklabel(top, text = gettextRcmdr("Sample Size (rows):")),
- entryNewDataSS, sticky = "e")
- tkgrid(buttonsFrame, columnspan = "2", sticky = "w")
- tkgrid.configure(entryDsname, sticky = "w")
- tkgrid.configure(entryNewDataSS, sticky = "w")
- tkfocus(CommanderWindow())
- dialogSuffix(rows = 2, columns = 2, focus = entryDsname)
- }
- else {
- if (!is.character(ActiveDataSet())) {
- errorCondition(recall = betaSimulate.ipsur, message = gettextRcmdr("There is no active data set."))
- return()
- }
- .activeDataSet <- ActiveDataSet()
- justDoIt(paste("samplesn <- dim(", .activeDataSet,
- ")[1]", sep = ""))
- UpdatebetasimNumber()
- for (k in getRcmdr("betasimNumber"):(nsamples + getRcmdr("betasimNumber") -
- 1)) {
- justDoIt(paste(.activeDataSet, "$beta.sim", k,
- " <- rbeta(", samplesn, ", shape1=", shape1,
- ", shape2=", shape2, ", ncp=", ncp, ")", sep = ""))
- }
- activeDataSet(.activeDataSet)
- putRcmdr("betasimNumber", k)
- if (nsamples == 1) {
- logger(paste("There was 1 beta variate sample stored in ",
- .activeDataSet, ".", sep = ""))
- }
- else {
- logger(paste("There were ", nsamples, " beta variate samples stored in ",
- .activeDataSet, ".", sep = ""))
- }
- }
- tkfocus(CommanderWindow())
- }
- OKCancelHelp(helpSubject = "rbeta")
- tkgrid(tklabel(top, text = gettextRcmdr("Number of samples (columns):")),
- samplesEntry, sticky = "w")
- tkgrid(tklabel(top, text = gettextRcmdr("Parameters:"), fg = "blue"),
- columnspan = 4, sticky = "w")
- tkgrid(tklabel(top, text = gettextRcmdr("shape1")), shape1Entry,
- sticky = "w")
- tkgrid(tklabel(top, text = gettextRcmdr("shape2")), shape2Entry,
- sticky = "w")
- tkgrid(tklabel(top, text = gettextRcmdr("ncp (noncentrality parameter)")),
- ncpEntry, sticky = "w")
- tkgrid(tklabel(locationFrame, text = gettextRcmdr("Store values in:"),
- fg = "blue"), columnspan = 4, sticky = "w")
- tkgrid(tklabel(locationFrame, text = gettextRcmdr("Active Dataset")),
- addtoactiveButton, sticky = "w")
- tkgrid(tklabel(locationFrame, text = "New Dataset"), newDataButton,
- sticky = "w")
- tkgrid.configure(samplesEntry, sticky = "w")
- tkgrid.configure(shape1Entry, sticky = "w")
- tkgrid.configure(shape2Entry, sticky = "w")
- tkgrid.configure(ncpEntry, sticky = "w")
- tkgrid(locationFrame, sticky = "w")
- tkgrid(buttonsFrame, sticky = "w", columnspan = 2)
- dialogSuffix(rows = 6, columns = 1, focus = samplesEntry)
-}
-
-
-`binomialSimulate.ipsur` <-
-function ()
-{
- initializeDialog(title = gettextRcmdr("Simulate Binomial Variates"))
- parameterFrame <- tkframe(top)
- locationFrame <- tkframe(top)
- if (!is.character(ActiveDataSet())) {
- locVariable <- tclVar("new")
- }
- else {
- locVariable <- tclVar("add")
- }
- addtoactiveButton <- tkradiobutton(locationFrame, variable = locVariable,
- value = "add")
- newDataButton <- tkradiobutton(locationFrame, variable = locVariable,
- value = "new")
- samplesVar <- tclVar("1")
- samplesEntry <- tkentry(top, width = "6", textvariable = samplesVar)
- sizeVar <- tclVar("1")
- sizeEntry <- tkentry(top, width = "6", textvariable = sizeVar)
- probVar <- tclVar("0.5")
- probEntry <- tkentry(top, width = "6", textvariable = probVar)
- onOK <- function() {
- nsamples <- round(as.numeric(tclvalue(samplesVar)))
- size <- tclvalue(sizeVar)
- prob <- tclvalue(probVar)
- store <- tclvalue(locVariable)
- if (is.na(nsamples)) {
- errorCondition(recall = binomialSimulate.ipsur, message = gettextRcmdr("Number of samples must be a positive integer."))
- return()
- }
- if (is.na(size)) {
- errorCondition(recall = binomialSimulate.ipsur, message = gettextRcmdr("Number of trials was not specified."))
- return()
- }
- if (is.na(prob)) {
- errorCondition(recall = binomialSimulate.ipsur, message = gettextRcmdr("The success probability was not specified."))
- return()
- }
- closeDialog()
- if (store == "new") {
- initializeDialog(title = gettextRcmdr("Simulation Dataset"))
- dsname <- tclVar("Simset")
- entryDsname <- tkentry(top, width = "20", textvariable = dsname)
- newDataSS <- tclVar("100")
- entryNewDataSS <- tkentry(top, width = "6", textvariable = newDataSS)
- onOK <- function() {
- dsnameValue <- trim.blanks(tclvalue(dsname))
- newSS <- round(as.numeric(tclvalue(newDataSS)))
- closeDialog()
- if (dsnameValue == "") {
- errorCondition(recall = binomialSimulate.ipsur,
- message = gettextRcmdr("You must enter the name of a data set."))
- return()
- }
- if (!is.valid.name(dsnameValue)) {
- errorCondition(recall = binomialSimulate.ipsur,
- message = paste("\"", dsnameValue, "\" ",
- gettextRcmdr("is not a valid name."), sep = ""))
- return()
- }
- if (is.element(dsnameValue, listDataSets())) {
- if ("no" == tclvalue(checkReplace(dsnameValue,
- gettextRcmdr("Data set")))) {
- binomialSimulate.ipsur()
- return()
- }
- }
- if (is.na(newSS)) {
- errorCondition(recall = binomialSimulate.ipsur,
- message = gettextRcmdr("Sample Size must be a positive integer."))
- return()
- }
- UpdatebinomsimNumber()
- justDoIt(paste(dsnameValue, " = data.frame(binom.sim",
- getRcmdr("binomsimNumber"), "=1:", newSS, ")",
- sep = ""))
- logger(paste(dsnameValue, "has been initialized."))
- for (k in getRcmdr("binomsimNumber"):(nsamples +
- getRcmdr("binomsimNumber") - 1)) {
- justDoIt(paste(dsnameValue, "$binom.sim", k,
- " <- rbinom(", newSS, ", size=", size, ", prob=",
- prob, ")", sep = ""))
- }
- activeDataSet(dsnameValue)
- putRcmdr("binomsimNumber", k)
- if (nsamples == 1) {
- logger(paste("There was 1 binomial variate sample stored in ",
- dsnameValue, ".", sep = ""))
- }
- else {
- logger(paste("There were ", nsamples, " binomial variate samples stored in ",
- dsnameValue, ".", sep = ""))
- }
- }
- OKCancelHelp(helpSubject = "rbinom")
- tkgrid(tklabel(top, text = gettextRcmdr("Enter name for data set:")),
- entryDsname, sticky = "e")
- tkgrid(tklabel(top, text = gettextRcmdr("Sample Size (rows):")),
- entryNewDataSS, sticky = "e")
- tkgrid(buttonsFrame, columnspan = "2", sticky = "w")
- tkgrid.configure(entryDsname, sticky = "w")
- tkgrid.configure(entryNewDataSS, sticky = "w")
- tkfocus(CommanderWindow())
- dialogSuffix(rows = 2, columns = 2, focus = entryDsname)
- }
- else {
- if (!is.character(ActiveDataSet())) {
- errorCondition(recall = binomialSimulate.ipsur,
- message = gettextRcmdr("There is no active data set."))
- return()
- }
- .activeDataSet <- ActiveDataSet()
- justDoIt(paste("samplesn <- dim(", .activeDataSet,
- ")[1]", sep = ""))
- UpdatebinomsimNumber()
- for (k in getRcmdr("binomsimNumber"):(nsamples +
- getRcmdr("binomsimNumber") - 1)) {
- justDoIt(paste(.activeDataSet, "$binom.sim",
- k, " <- rbinom(", samplesn, ", size=", size,
- ", prob=", prob, ")", sep = ""))
- }
- activeDataSet(.activeDataSet)
- putRcmdr("binomsimNumber", k)
- if (nsamples == 1) {
- logger(paste("There was 1 binomial variate sample stored in ",
- .activeDataSet, ".", sep = ""))
- }
- else {
- logger(paste("There were ", nsamples, " binomial variate samples stored in ",
- .activeDataSet, ".", sep = ""))
- }
- }
- tkfocus(CommanderWindow())
- }
- OKCancelHelp(helpSubject = "rbinom")
- tkgrid(tklabel(top, text = gettextRcmdr("Number of samples (columns):")),
- samplesEntry, sticky = "w")
- tkgrid(tklabel(top, text = gettextRcmdr("Parameters:"), fg = "blue"),
- columnspan = 4, sticky = "w")
- tkgrid(tklabel(top, text = gettextRcmdr("size (number of trials)")),
- sizeEntry, sticky = "w")
- tkgrid(tklabel(top, text = gettextRcmdr("prob (of success)")),
- probEntry, sticky = "w")
- tkgrid(tklabel(locationFrame, text = gettextRcmdr("Store values in:"),
- fg = "blue"), columnspan = 4, sticky = "w")
- tkgrid(tklabel(locationFrame, text = gettextRcmdr("Active Dataset")),
- addtoactiveButton, sticky = "w")
- tkgrid(tklabel(locationFrame, text = "New Dataset"), newDataButton,
- sticky = "w")
- tkgrid.configure(samplesEntry, sticky = "w")
- tkgrid.configure(sizeEntry, sticky = "w")
- tkgrid.configure(probEntry, sticky = "w")
- tkgrid(locationFrame, sticky = "w")
- tkgrid(buttonsFrame, sticky = "w", columnspan = 2)
- dialogSuffix(rows = 6, columns = 1, focus = samplesEntry)
-}
-
-
-`cauchySimulate.ipsur` <-
-function ()
-{
- initializeDialog(title = gettextRcmdr("Simulate Cauchy Variates"))
- parameterFrame <- tkframe(top)
- locationFrame <- tkframe(top)
- if (!is.character(ActiveDataSet())) {
- locVariable <- tclVar("new")
- }
- else {
- locVariable <- tclVar("add")
- }
- addtoactiveButton <- tkradiobutton(locationFrame, variable = locVariable,
- value = "add")
- newDataButton <- tkradiobutton(locationFrame, variable = locVariable,
- value = "new")
- samplesVar <- tclVar("1")
- samplesEntry <- tkentry(top, width = "6", textvariable = samplesVar)
- locationVar <- tclVar("0")
- locationEntry <- tkentry(top, width = "6", textvariable = locationVar)
- scale1Var <- tclVar("1")
- scale1Entry <- tkentry(top, width = "6", textvariable = scale1Var)
- onOK <- function() {
- nsamples <- round(as.numeric(tclvalue(samplesVar)))
- location <- tclvalue(locationVar)
- scale1 <- tclvalue(scale1Var)
- if (is.na(nsamples)) {
- errorCondition(recall = cauchySimulate.ipsur, message = gettextRcmdr("Number of samples must be a positive integer."))
- return()
- }
- if (is.na(location)) {
- errorCondition(recall = cauchySimulate.ipsur, message = gettextRcmdr("The location parameter was not specified."))
- return()
- }
- if (is.na(scale1)) {
- errorCondition(recall = cauchySimulate.ipsur, message = gettextRcmdr("The scale parameter was not specified."))
- return()
- }
- closeDialog()
- store <- tclvalue(locVariable)
- if (store == "new") {
- initializeDialog(title = gettextRcmdr("Simulation Dataset"))
- dsname <- tclVar("Simset")
- entryDsname <- tkentry(top, width = "20", textvariable = dsname)
- newDataSS <- tclVar("100")
- entryNewDataSS <- tkentry(top, width = "6", textvariable = newDataSS)
- onOK <- function() {
- dsnameValue <- trim.blanks(tclvalue(dsname))
- newSS <- round(as.numeric(tclvalue(newDataSS)))
- closeDialog()
- if (dsnameValue == "") {
- errorCondition(recall = cauchySimulate.ipsur,
- message = gettextRcmdr("You must enter the name of a data set."))
- return()
- }
- if (!is.valid.name(dsnameValue)) {
- errorCondition(recall = cauchySimulate.ipsur,
- message = paste("\"", dsnameValue, "\" ",
- gettextRcmdr("is not a valid name."), sep = ""))
- return()
- }
- if (is.element(dsnameValue, listDataSets())) {
- if ("no" == tclvalue(checkReplace(dsnameValue,
- gettextRcmdr("Data set")))) {
- cauchySimulate.ipsur()
- return()
- }
- }
- if (is.na(newSS)) {
- errorCondition(recall = cauchySimulate.ipsur,
- message = gettextRcmdr("Sample Size must be a positive integer."))
- return()
- }
- UpdatecauchysimNumber()
- justDoIt(paste(dsnameValue, " = data.frame(cauchy.sim",
- getRcmdr("cauchysimNumber"), "=1:", newSS,
- ")", sep = ""))
- logger(paste(dsnameValue, "has been initialized."))
- for (k in getRcmdr("cauchysimNumber"):(nsamples +
- getRcmdr("cauchysimNumber") - 1)) {
- justDoIt(paste(dsnameValue, "$cauchy.sim",
- k, " <- rcauchy(", newSS, ", location=",
- location, ", scale=", scale1, ")", sep = ""))
- }
- activeDataSet(dsnameValue)
- putRcmdr("cauchysimNumber", k)
- if (nsamples == 1) {
- logger(paste("There was 1 Cauchy variate sample stored in ",
- dsnameValue, ".", sep = ""))
- }
- else {
- logger(paste("There were ", nsamples, " Cauchy variate samples stored in ",
- dsnameValue, ".", sep = ""))
- }
- }
- OKCancelHelp(helpSubject = "rcauchy")
- tkgrid(tklabel(top, text = gettextRcmdr("Enter name for data set:")),
- entryDsname, sticky = "e")
- tkgrid(tklabel(top, text = gettextRcmdr("Sample Size (rows):")),
- entryNewDataSS, sticky = "e")
- tkgrid(buttonsFrame, columnspan = "2", sticky = "w")
- tkgrid.configure(entryDsname, sticky = "w")
- tkgrid.configure(entryNewDataSS, sticky = "w")
- tkfocus(CommanderWindow())
- dialogSuffix(rows = 2, columns = 2, focus = entryDsname)
- }
- else {
- if (!is.character(ActiveDataSet())) {
- errorCondition(recall = cauchySimulate.ipsur,
- message = gettextRcmdr("There is no active data set."))
- return()
- }
- .activeDataSet <- ActiveDataSet()
- justDoIt(paste("samplesn <- dim(", .activeDataSet,
- ")[1]", sep = ""))
- UpdatecauchysimNumber()
- for (k in getRcmdr("cauchysimNumber"):(nsamples +
- getRcmdr("cauchysimNumber") - 1)) {
- justDoIt(paste(.activeDataSet, "$cauchy.sim",
- k, " <- rcauchy(", samplesn, ", location=",
- location, ", scale=", scale1, ")", sep = ""))
- }
- activeDataSet(.activeDataSet)
- putRcmdr("cauchysimNumber", k)
- if (nsamples == 1) {
- logger(paste("There was 1 Cauchy variate sample stored in ",
- .activeDataSet, ".", sep = ""))
- }
- else {
- logger(paste("There were ", nsamples, " Cauchy variate samples stored in ",
- .activeDataSet, ".", sep = ""))
- }
- }
- tkfocus(CommanderWindow())
- }
- OKCancelHelp(helpSubject = "rcauchy")
- tkgrid(tklabel(top, text = gettextRcmdr("Number of samples (columns):")),
- samplesEntry, sticky = "w")
- tkgrid(tklabel(top, text = gettextRcmdr("Parameters:"), fg = "blue"),
- columnspan = 4, sticky = "w")
- tkgrid(tklabel(top, text = gettextRcmdr("location")), locationEntry,
- sticky = "w")
- tkgrid(tklabel(top, text = gettextRcmdr("scale")), scale1Entry,
- sticky = "w")
- tkgrid(tklabel(locationFrame, text = gettextRcmdr("Store values in:"),
- fg = "blue"), columnspan = 4, sticky = "w")
- tkgrid(tklabel(locationFrame, text = gettextRcmdr("Active Dataset")),
- addtoactiveButton, sticky = "w")
- tkgrid(tklabel(locationFrame, text = "New Dataset"), newDataButton,
- sticky = "w")
- tkgrid.configure(samplesEntry, sticky = "w")
- tkgrid.configure(locationEntry, sticky = "w")
- tkgrid.configure(scale1Entry, sticky = "w")
- tkgrid(locationFrame, sticky = "w")
- tkgrid(buttonsFrame, sticky = "w", columnspan = 2)
- dialogSuffix(rows = 6, columns = 1, focus = samplesEntry)
-}
-
-
-`chisqSimulate.ipsur` <-
-function ()
-{
- initializeDialog(title = gettextRcmdr("Simulate Chi-Squared Variates"))
- parameterFrame <- tkframe(top)
- locationFrame <- tkframe(top)
- if (!is.character(ActiveDataSet())) {
- locVariable <- tclVar("new")
- }
- else {
- locVariable <- tclVar("add")
- }
- addtoactiveButton <- tkradiobutton(locationFrame, variable = locVariable,
- value = "add")
- newDataButton <- tkradiobutton(locationFrame, variable = locVariable,
- value = "new")
- samplesVar <- tclVar("1")
- samplesEntry <- tkentry(top, width = "6", textvariable = samplesVar)
- dfVar <- tclVar("1")
- dfEntry <- tkentry(top, width = "6", textvariable = dfVar)
- ncpVar <- tclVar("0")
- ncpEntry <- tkentry(top, width = "6", textvariable = ncpVar)
- onOK <- function() {
- nsamples <- round(as.numeric(tclvalue(samplesVar)))
- df <- tclvalue(dfVar)
- ncp <- tclvalue(ncpVar)
- if (is.na(nsamples)) {
- errorCondition(recall = chisqSimulate.ipsur, message = gettextRcmdr("Number of samples must be a positive integer."))
- return()
- }
- if (is.na(df)) {
- errorCondition(recall = chisqSimulate.ipsur, message = gettextRcmdr("The degrees of freedom were not specified."))
- return()
- }
- if (is.na(ncp)) {
- errorCondition(recall = chisqSimulate.ipsur, message = gettextRcmdr("The noncentrality parameter was not specified."))
- return()
- }
- closeDialog()
- store <- tclvalue(locVariable)
- if (store == "new") {
- initializeDialog(title = gettextRcmdr("Simulation Dataset"))
- dsname <- tclVar("Simset")
- entryDsname <- tkentry(top, width = "20", textvariable = dsname)
- newDataSS <- tclVar("100")
- entryNewDataSS <- tkentry(top, width = "6", textvariable = newDataSS)
- onOK <- function() {
- dsnameValue <- trim.blanks(tclvalue(dsname))
- newSS <- round(as.numeric(tclvalue(newDataSS)))
- closeDialog()
- if (dsnameValue == "") {
- errorCondition(recall = chisqSimulate.ipsur,
- message = gettextRcmdr("You must enter the name of a data set."))
- return()
- }
- if (!is.valid.name(dsnameValue)) {
- errorCondition(recall = chisqSimulate.ipsur,
- message = paste("\"", dsnameValue, "\" ",
- gettextRcmdr("is not a valid name."), sep = ""))
- return()
- }
- if (is.element(dsnameValue, listDataSets())) {
- if ("no" == tclvalue(checkReplace(dsnameValue,
- gettextRcmdr("Data set")))) {
- chisqSimulate.ipsur()
- return()
- }
- }
- if (is.na(newSS)) {
- errorCondition(recall = chisqSimulate.ipsur,
- message = gettextRcmdr("Sample Size must be a positive integer."))
- return()
- }
- UpdatechisqsimNumber()
- justDoIt(paste(dsnameValue, " = data.frame(chisq.sim",
- getRcmdr("chisqsimNumber"), "=1:", newSS, ")",
- sep = ""))
- logger(paste(dsnameValue, "has been initialized."))
- for (k in getRcmdr("chisqsimNumber"):(nsamples +
- getRcmdr("chisqsimNumber") - 1)) {
- justDoIt(paste(dsnameValue, "$chisq.sim", k,
- " <- rchisq(", newSS, ", df=", df, ", ncp=",
- ncp, ")", sep = ""))
- }
- activeDataSet(dsnameValue)
- putRcmdr("chisqsimNumber", k)
- if (nsamples == 1) {
- logger(paste("There was 1 chi-squared variate sample stored in ",
- dsnameValue, ".", sep = ""))
- }
- else {
- logger(paste("There were ", nsamples, " chi-squared variate samples stored in ",
- dsnameValue, ".", sep = ""))
- }
- }
- OKCancelHelp(helpSubject = "rchisq")
- tkgrid(tklabel(top, text = gettextRcmdr("Enter name for data set:")),
- entryDsname, sticky = "e")
- tkgrid(tklabel(top, text = gettextRcmdr("Sample Size (rows):")),
- entryNewDataSS, sticky = "e")
- tkgrid(buttonsFrame, columnspan = "2", sticky = "w")
- tkgrid.configure(entryDsname, sticky = "w")
- tkgrid.configure(entryNewDataSS, sticky = "w")
- tkfocus(CommanderWindow())
- dialogSuffix(rows = 2, columns = 2, focus = entryDsname)
- }
- else {
- if (!is.character(ActiveDataSet())) {
- errorCondition(recall = chisqSimulate.ipsur,
- message = gettextRcmdr("There is no active data set."))
- return()
- }
- .activeDataSet <- ActiveDataSet()
- justDoIt(paste("samplesn <- dim(", .activeDataSet,
- ")[1]", sep = ""))
- UpdatechisqsimNumber()
- for (k in getRcmdr("chisqsimNumber"):(nsamples +
- getRcmdr("chisqsimNumber") - 1)) {
- justDoIt(paste(.activeDataSet, "$chisq.sim",
- k, " <- rchisq(", samplesn, ", df=", df, ", ncp=",
- ncp, ")", sep = ""))
- }
- activeDataSet(.activeDataSet)
- putRcmdr("chisqsimNumber", k)
- if (nsamples == 1) {
- logger(paste("There was 1 chi-squared variate sample stored in ",
- .activeDataSet, ".", sep = ""))
- }
- else {
- logger(paste("There were ", nsamples, " chi-squared variate samples stored in ",
- .activeDataSet, ".", sep = ""))
- }
- }
- tkfocus(CommanderWindow())
- }
- OKCancelHelp(helpSubject = "rchisq")
- tkgrid(tklabel(top, text = gettextRcmdr("Number of samples (columns):")),
- samplesEntry, sticky = "w")
- tkgrid(tklabel(top, text = gettextRcmdr("Parameters:"), fg = "blue"),
- columnspan = 4, sticky = "w")
- tkgrid(tklabel(top, text = gettextRcmdr("df (degrees of freedom)")),
- dfEntry, sticky = "w")
- tkgrid(tklabel(top, text = gettextRcmdr("ncp (noncentrality parameter)")),
- ncpEntry, sticky = "w")
- tkgrid(tklabel(locationFrame, text = gettextRcmdr("Store values in:"),
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/ipsur -r 217
More information about the IPSUR-commits
mailing list