# the plugin code was generated by this script
# you should not change the plugin code directly, but this script
# note: this script only creates objects in your workspace,
# *EXCEPT* for the last call, see below.
require(rkwarddev)
rkwarddev.required("0.08-1")
local({
# set the output directory to overwrite the actual plugin
output.dir <- tempdir()
overwrite <- TRUE
# if you set guess.getters to TRUE, the resulting code will need RKWard >= 0.6.0
guess.getter <- TRUE
rk.set.indent(by=" ")
rk.set.empty.e(TRUE)
update.translations <- TRUE
about.info <- rk.XML.about(
name="rk.ANOVA",
author=c(
person(given="Meik", family="Michalke",
email="meik.michalke@hhu.de", role=c("aut","cre"))),
about=list(desc="RKWard GUI to conduct ANOVAs (using the ez package), pairwise t-Tests and plot interactions.",
version="0.01-23", url="https://rkward.kde.org")
)
dependencies.info <- rk.XML.dependencies(
dependencies=list(rkward.min=ifelse(isTRUE(guess.getter), "0.6.0", "0.5.6")),
package=list(c(name="ez"), c(name="sciplot"))
)
############
## ANOVA
############
design <- rk.XML.radio(
label="Design",
options=list(
"Between subjects"=c(val="between"),
"Within subjects (repeated measures)"=c(val="within", chk=TRUE),
"Mixed"=c(val="mixed")
),
id.name="design"
)
data <- rk.XML.varselector(
label="Select data",
id.name="data"
)
dataSelected <- rk.XML.varslot(
label="Data (must be data.frame)",
source=data, required=TRUE, classes="data.frame",
id.name="dataSelected"
)
dependend <- rk.XML.varslot(
label="Dependent variable",
source=data, required=TRUE,
id.name="dependend"
)
caseID <- rk.XML.varslot(
label="Case/subject identifier",
source=data,
id.name="caseID"
)
within <- rk.XML.varslot(
label="Within subject variables",
source=data, multi=TRUE,
id.name="within"
)
between <- rk.XML.varslot(
label="Between subject variables",
source=data, multi=TRUE,
id.name="between"
)
# observed data
data2 <- rk.XML.varselector(
label="Select observed variables",
id.name="data2"
)
observed <- rk.XML.varslot(
label="Observed variables (not manipulated)",
source=data2, multi=TRUE,
id.name="observed"
)
sumOfSqType <- rk.XML.dropdown(
label="Sums of squares type for unbalanced designs",
options=list(
"Type 1"=c(val=1),
"Type 2"=c(val=2, chk=TRUE),
"Type 3"=c(val=3)
),
id.name="sumOfSqType"
)
# logic: only relevant for pure between designs
hetScedCorrection <- rk.XML.dropdown(
label="Heteroscedasticity correction",
options=list(
"None"=c(val="false", chk=TRUE),
"hc3 (Long & Ervin; default)"=c(val="hc3"),
"hc0 (White)"=c(val="hc0"),
"hc1 (Long & Ervin)"=c(val="hc1"),
"hc2 (Long & Ervin)"=c(val="hc2"),
"hc4 (Cribari-Neto)"=c(val="hc4")
),
id.name="hetScedCorrection"
)
showExtraInfo <- rk.XML.cbox(
label="Show sums of squares, raw likelihood ratios etc.",
value="true",
id.name="showExtraInfo"
)
aov <- rk.XML.cbox(
label="Return 'aov' object",
value="true",
chk=TRUE,
id.name="aov"
)
noLoadMsg <- rk.XML.cbox(
label="Suppress package loading messages",
value="true",
chk=TRUE,
id.name="noLoadMsg"
)
saveResults <- rk.XML.saveobj(
"Save results to workspace",
initial="anova.results",
id.name="saveResults"
)
tab1.data <- rk.XML.row(
data,
rk.XML.col(
rk.XML.frame(dataSelected),
rk.XML.frame(design),
rk.XML.frame(dependend, caseID),
rk.XML.frame(within, between)
)
)
tab2.observed <- rk.XML.row(
data2,
rk.XML.col(
rk.XML.frame(rk.XML.text("Observed variables are independent variables you have <b>already defined</b> as either between or within variables, but that were measured and <b>not manipulated</b>. They affect the calculated effect size (generalized eta seqared).")),
rk.XML.frame(observed)
)
)
tab3.options <- rk.XML.row(
rk.XML.col(
rk.XML.frame(sumOfSqType),
rk.XML.frame(hetScedCorrection),
rk.XML.frame(rk.XML.col(showExtraInfo),rk.XML.col(aov)),
rk.XML.stretch(),
noLoadMsg,
saveResults
)
)
full.dialog <- rk.XML.dialog(
rk.XML.tabbook(
label="ANOVA",
tabs=list(
"Data"=tab1.data,
"Observed"=tab2.observed,
"Options"=tab3.options
),
),
label="ANOVA"
)
## logic section to tie the second varslot to the data.frame
lgc.sect <- rk.XML.logic(
rk.XML.connect(governor="current_object", client=dataSelected, set="available"),
rk.XML.connect(governor=dataSelected, client=data, get="available", set="root"),
anova.gov.data <- rk.XML.convert(sources=list(available=dataSelected), mode=c(notequals="")),
anova.gov.between <- rk.XML.convert(sources=list(string=design), mode=c(equals="between")),
anova.gov.within <- rk.XML.convert(sources=list(string=design), mode=c(equals="within")),
anova.gov.mixed <- rk.XML.convert(sources=list(string=design), mode=c(equals="mixed")),
anova.gov.show.bvars <- rk.XML.convert(sources=list(anova.gov.between, anova.gov.mixed), mode=c(or=""), id.name="lgc_bvars"),
anova.gov.show.wvars <- rk.XML.convert(sources=list(anova.gov.within, anova.gov.mixed), mode=c(or=""), id.name="lgc_vvars"),
rk.XML.connect(governor=anova.gov.data, client=dependend, set="enabled"),
rk.XML.connect(governor=anova.gov.data, client=between, set="enabled"),
rk.XML.connect(governor=anova.gov.data, client=within, set="enabled"),
rk.XML.connect(governor=anova.gov.data, client=caseID, set="enabled"),
rk.XML.connect(governor=anova.gov.show.wvars, client=caseID, set="required"),
rk.XML.connect(governor=anova.gov.show.bvars, client=between, set="visible"),
rk.XML.connect(governor=anova.gov.show.wvars, client=within, set="visible"),
rk.XML.connect(governor=anova.gov.show.bvars, client=between, set="required"),
rk.XML.connect(governor=anova.gov.show.wvars, client=within, set="required"),
# observed data
rk.XML.connect(governor=anova.gov.data, client=tab2.observed, set="enabled"),
rk.XML.connect(governor=dataSelected, client=data2, get="available", set="root")
)
## JavaScript
js.calc <- rk.paste.JS(
jsVarDv <- rk.JS.vars(dependend, modifiers="shortname", join=", "),
jsVarWid <- rk.JS.vars(caseID, modifiers="shortname", join=", "),
jsVarWithin <- rk.JS.vars(within, modifiers="shortname", join=", "),
jsVarBetween <- rk.JS.vars(between, modifiers="shortname", join=", "),
jsVarObserved <- rk.JS.vars(observed, modifiers="shortname", join=", "),
js(
if(sumOfSqType == 3){
R.comment("set contrasts for accurate type 3 ANOVA")
echo("\toptions(contrasts=c(\"contr.sum\",\"contr.poly\"))\n")
} else {},
if(caseID == "" && design == "between"){
R.comment("ezANOVA demands a subject identifier variable")
echo("\t", dataSelected, " <- cbind(", dataSelected ,", ez.subject.ID.dummy=factor(1:nrow(", dataSelected ,")))\n")
} else {}
),
echo("\tanova.results <- ezANOVA("),
js(
if(dataSelected){
echo("\n\t\tdata=", dataSelected)
} else {},
if(dependend){
echo(",\n\t\tdv=.(", jsVarDv ,")")
} else {},
if(caseID){
echo(",\n\t\twid=.(", jsVarWid ,")")
} else if(design == "between"){
echo(",\n\t\twid=.(ez.subject.ID.dummy)") # wid is needed anyway
} else {},
if(within != "" && design != "between"){
echo(",\n\t\twithin=.(", jsVarWithin ,")")
} else {},
if(between != "" && design != "within"){
echo(",\n\t\tbetween=.(", jsVarBetween ,")")
} else {},
if(observed){
echo(",\n\t\tobserved=.(", jsVarObserved ,")")
} else {},
if(sumOfSqType != 2){
echo(",\n\t\ttype=", sumOfSqType)
} else {},
if(hetScedCorrection != "false"){
echo(",\n\t\twhite.adjust=\"", hetScedCorrection, "\"")
} else {}
),
tf(showExtraInfo, opt="detailed"),
tf(aov, opt="return_aov"),
echo(")\n\n")
)
js.print <- rk.paste.JS(
echo("\trk.print(anova.results[[\"ANOVA\"]])\n"),
echo("\tif(\"Mauchly's Test for Sphericity\" %in% names(anova.results)){\n\t\t"),
rk.JS.header("Mauchly's Test for Sphericity", level=3),
echo("\t\trk.print(anova.results[[\"Mauchly's Test for Sphericity\"]])\n\t} else {}\n"),
echo("\tif(\"Sphericity Corrections\" %in% names(anova.results)){\n\t\t"),
rk.JS.header("Sphericity Corrections", level=3),
echo("\t\trk.print(anova.results[[\"Sphericity Corrections\"]])\n\t} else {}\n"),
echo("\tif(\"Levene's Test for Homgeneity\" %in% names(anova.results)){\n\t\t"),
rk.JS.header("Levene's Test for Homgeneity", level=3),
echo("\t\trk.print(anova.results[[\"Levene's Test for Homgeneity\"]])\n\t} else {}\n")
)
########
## prepare data
########
pdData <- rk.XML.varselector(
label="Select data",
id.name="pdData"
)
pdDataSelected <- rk.XML.varslot(
label="Select all variables from one data.frame",
source=pdData, classes="data.frame",
id.name="pdDataSelected"
)
pdResponse <- rk.XML.varslot(
label="Dependent/response vectors",
source=pdData, multi=TRUE, min=2, required=TRUE,
id.name="pdResponse"
)
pdNameDependend <- rk.XML.input(
label="Name for dependent variable",
initial="response", required=TRUE,
id.name="pdNameDependend"
)
pdNameCondition <- rk.XML.input(
label="Name for experimental condition",
initial="condition",
required=TRUE,
id.name="pdNameCondition"
)
pdGenCaseID <- rk.XML.cbox(
label="Automatic case/subject identifier",
chk=TRUE,
id.name="pdGenCaseID"
)
pdNameCaseID <- rk.XML.input(
label="Name for case/subject identifier",
initial="case",
required=TRUE,
id.name="pdNameCaseID"
)
pdCaseID <- rk.XML.varslot(
label="Case/subject identifier",
source=pdData,
required=TRUE,
id.name="pdCaseID"
)
pdBetween <- rk.XML.varslot(
label="Between subject variables",
source=pdData,
multi=TRUE,
id.name="pdBetween"
)
pdSaveResults <- rk.XML.saveobj(
label="Save results to workspace",
initial="anova.data",
chk=TRUE,
id.name="pdSaveResults"
)
pd.full.dialog <- rk.XML.dialog(
rk.XML.row(
pdData,
rk.XML.col(
pdDataSelected,
pdResponse,
pdNameDependend,
pdNameCondition,
pdGenCaseID,
pdNameCaseID,
pdCaseID,
pdBetween,
pdSaveResults
)
),
label="Prepare within subject data"
)
## logic section to tie the varslot to the data.frame
pd.lgc.sect <- rk.XML.logic(
rk.XML.connect(governor="current_object", client=pdDataSelected, set="available"),
rk.XML.connect(governor=pdDataSelected, client=pdData, get="available", set="root"),
# pd.gov.data <- rk.XML.convert(sources=list(available=pdDataSelected), mode=c(notequals="")),
# rk.XML.connect(governor=pd.gov.data, client=pdResponse, set="enabled"),
# rk.XML.connect(governor=pd.gov.data, client=pdNameDependend, set="enabled"),
# rk.XML.connect(governor=pd.gov.data, client=pdNameCondition, set="enabled"),
# rk.XML.connect(governor=pd.gov.data, client=pdGenCaseID, set="enabled"),
rk.XML.connect(governor=pdGenCaseID, client=pdNameCaseID, set="visible"),
rk.XML.connect(governor=pdGenCaseID, client=pdCaseID, set="visible", not=TRUE)#,
# rk.XML.connect(governor=pd.gov.data, client=pdNameCaseID, set="enabled"),
# rk.XML.connect(governor=pd.gov.data, client=pdCaseID, set="enabled"),
# rk.XML.connect(governor=pd.gov.data, client=pdBetween, set="enabled")
)
## JavaScript
pd.js.calc <- rk.paste.JS(
pd.js.dep.names <- rk.JS.vars(pdResponse, modifiers="shortname", join="\\\", \\\""),
pd.js.dep <- rk.JS.vars(pdResponse, join=",\\n\\t\\t\\t"),
pd.js.wid <- rk.JS.vars(pdCaseID, modifiers="shortname"),
pd.js.between.short <- rk.JS.vars(pdBetween, modifiers="shortname"),
pd.js.between <- rk.JS.vars(pdBetween, join=",\\n\\t\\t\\t", var.prefix="lng"),
js(
if(pdDataSelected){
echo("\tnum.cases <- nrow(", pdDataSelected,")\n")
} else {
echo("\tnum.cases <- unique(sapply(list(\n\t\t\t", pd.js.dep)
if(!pdGenCaseID && pdCaseID){
echo(",\n\t\t\t", pdCaseID)
} else {}
if(pdBetween){
echo(",\n\t\t\t", pd.js.between)
} else {}
echo("),\n\t\tlength))\n\tif(length(num.cases) > 1) {",
"\n\t\tstop(simpleError(", i18n("Can't determine number of cases, variables don't have equal length!"), "))",
"\n\t}\n"
)
},
if(pdResponse){
echo("\tanova.conditions <- c(\"", pd.js.dep.names, "\")\n\tnum.conditions <- length(anova.conditions)\n\n")
} else {},
if(pdBetween){
js("var betweenVarsNames = ", pd.js.between.short, ".split(\"\\n\");", linebreaks=FALSE)
js("var betweenVars = ", pdBetween, ".split(\"\\n\");", linebreaks=FALSE)
} else {
rk.paste.JS("var betweenVars = \"\";", level=3)
}
),
echo("\tanova.data <- data.frame("),
js(
if(pdResponse){
echo("\n\t\t", pdNameDependend, "=c(\n\t\t\t", pd.js.dep, ")",
",\n\t\t", pdNameCondition, "=factor(rep(anova.conditions, each=num.cases))")
} else {},
if(pdGenCaseID && pdNameCaseID){
echo(",\n\t\t", pdNameCaseID, "=factor(rep(1:num.cases, times=num.conditions))")
} else {},
if(!pdGenCaseID && pdCaseID){
echo(",\n\t\t", pd.js.wid, "=factor(rep(", pdCaseID, ", times=num.conditions))")
} else {},
if(pdBetween){
js(
"for (var i=0, len=betweenVarsNames.length; i<len; ++i ){",
" echo(\",\\n\\t\\t\" + betweenVarsNames[i] + \"=factor(rep(\" + betweenVars[i] + \", times=num.conditions))\");",
"}",
level=3
)
} else {}
),
echo(",\n\t\tstringsAsFactors=FALSE)\n\n")
)
pd.js.print <- rk.paste.JS(
echo("\trk.print(summary(anova.data))\n")
)
## make a whole component of the data preparation
pdata.component <- rk.plugin.component(
"Prepare within subject data",
xml=list(
logic=pd.lgc.sect,
dialog=pd.full.dialog),
js=list(
calculate=pd.js.calc,
printout=pd.js.print,
results.header="Prepare within subject data"
),
guess.getter=guess.getter,
hierarchy=list("data", "ANOVA"),
create=c("xml", "js"),
gen.info="$SRC/inst/rkward/rkwarddev_ANOVA_plugin_script.R"
)
########
## pairwise t-tests
########
ptData <- rk.XML.varselector(
label="Select data",
id.name="ptData"
)
ptDataFormat <- rk.XML.radio(
label="Data format",
options=list(
"Single (grouped) vector"=c(val="one", chk=TRUE),
"Separate variables"=c(val="group")
),
id.name="ptDataFormat"
)
ptResponse <- rk.XML.varslot(
label="Response vector",
source=ptData,
id.name="ptResponse"
)
ptGroup <- rk.XML.varslot(
label="Grouping vector or factor",
source=ptData,
id.name="ptGroup"
)
ptSepResponses <- rk.XML.varslot(
label="Separate response vectors (>= 3)",
source=ptData,
multi=TRUE,
min=3,
id.name="ptSepResponses"
)
ptAdjustP <- rk.XML.dropdown(
label="Method for adjusting p values",
options=list(
"none"=c(val="none"),
"Bonferroni"=c(val="bonferroni"),
"Holm"=c(val="holm", chk=TRUE),
"Benjamini & Hochberg (fdr)"=c(val="BH"),
"Benjamini & Yekutieli"=c(val="BY"),
"Hochberg"=c(val="hochberg"),
"Hommel"=c(val="hommel")
),
id.name="ptAdjustP"
)
ptPooledSD <- rk.XML.cbox(
label="Pooled SD for all groups",
value="true",
id.name="ptPooledSD"
)
ptPaired <- rk.XML.cbox(
label="Paired t-Tests",
value="true",
chk=TRUE,
id.name="ptPaired"
)
ptHypothesis <- rk.XML.radio(
label="Alternative hypothesis",
options=list(
"Two-sided"=c(val="two.sided"),
"First is greater"=c(val="greater"),
"Second is greater"=c(val="less")
),
id.name="ptHypothesis"
)
pt.full.dialog <- rk.XML.dialog(
rk.XML.row(
ptData,
rk.XML.col(
ptDataFormat,
rk.XML.frame(
ptResponse,
ptGroup,
ptSepResponses,
label="Data"
),
rk.XML.frame(
ptAdjustP,
label="Alpha error correction"
),
rk.XML.frame(
ptPooledSD,
ptPaired
),
ptHypothesis
)
),
label="Pairwise t-Tests"
)
## logic
pt.lgc.sect <- rk.XML.logic(
rk.XML.connect(governor=ptPooledSD, client=ptPaired, set="enabled", not=TRUE),
rk.XML.connect(governor=ptPaired, client=ptPooledSD, set="enabled", not=TRUE),
pt.gov.onevar <- rk.XML.convert(sources=list(string=ptDataFormat), mode=c(equals="one")),
rk.XML.connect(governor=pt.gov.onevar, client=ptResponse, set="visible"),
rk.XML.connect(governor=pt.gov.onevar, client=ptResponse, set="required"),
rk.XML.connect(governor=pt.gov.onevar, client=ptGroup, set="visible"),
rk.XML.connect(governor=pt.gov.onevar, client=ptGroup, set="required"),
rk.XML.connect(governor=pt.gov.onevar, client=ptSepResponses, set="visible", not=TRUE),
rk.XML.connect(governor=pt.gov.onevar, client=ptSepResponses, set="required", not=TRUE)
)
## JavaScript
pt.vars.to.group <- rk.JS.vars(ptSepResponses, join=", ")
pt.js.calc <- rk.paste.JS(
js(
if(ptDataFormat == "one"){
echo("\tpair.t.results <- pairwise.t.test(\n\t\t")
if(ptResponse){
echo("x=", ptResponse)
} else {}
if(ptGroup){
echo(",\n\t\tg=", ptGroup)
} else {}
} else {
js(pt.vars.to.group, " = getValue(", idq(ptSepResponses), ").split(\"\\n\").join(\", \");", linebreaks=FALSE)
R.comment("simple helper function to get the names of the objects")
echo("\tgrouping.vector <- function(...){\n\tunlist(lapply(match.call()[-1], function(x){rep(deparse(x), length(eval(x)))}))\n}\n")
if(ptSepResponses){
R.comment("create data and grouping vectors")
echo("\tdata <- c(", pt.vars.to.group, ")\n\tgroup <- grouping.vector(", pt.vars.to.group, ")\n\n")
} else {}
R.comment("the actual pairwise t-tests, using the prepared data")
echo("\tpair.t.results <- pairwise.t.test(\n\t\t")
if(ptSepResponses){
echo("x=data,\n\t\tg=group")
} else {}
},
if(ptAdjustP){
echo(",\n\t\tp.adjust.method=\"", ptAdjustP, "\"")
} else {}
),
tf(ptPooledSD, opt="pool.sd"),
tf(ptPaired, opt="paired"),
js(
if(ptHypothesis != "two.sided"){
echo(",\n\t\talternative=\"", ptHypothesis, "\"")
} else {}
),
echo(")\n\n")
)
pt.js.print <- rk.paste.JS(
echo("rk.print(pair.t.results)\n")
)
## make a whole component of the t-test
pttest.component <- rk.plugin.component(
"Pairwise t-Tests",
xml=list(
logic=pt.lgc.sect,
dialog=pt.full.dialog
),
js=list(
calculate=pt.js.calc,
printout=pt.js.print,
results.header="Pairwise t-Tests"
),
guess.getter=guess.getter,
hierarchy=list("analysis", "means", "t-tests"),
create=c("xml", "js"),
gen.info="$SRC/inst/rkward/rkwarddev_ANOVA_plugin_script.R"
)
###########
## interaction plot
###########
ipData <- rk.XML.varselector(
label="Select data",
id.name="ipData"
)
ipFactor <- rk.XML.varslot(
label="Factor (x axis)",
source=ipData,
required=TRUE,
id.name="ipFactor"
)
ipResponse <- rk.XML.varslot(
label="Response vector",
source=ipData,
required=TRUE,
id.name="ipResponse"
)
ipGroups <- rk.XML.varslot(
label="Grouping factor (traces)",
source=ipData,
id.name="ipGroups"
)
ipPlotType <- rk.XML.radio(
label="Plot type",
options=list(
"Lineplot"=c(val="line", chk=TRUE),
"Bargraph"=c(val="bar")
),
id.name="ipPlotType"
)
ipPlotElements <- rk.XML.radio(
label="Elements",
options=list(
"Lines + points"=c(val="b", chk=TRUE),
"Lines only"=c(val="l"),
"Points only"=c(val="p")
),
id.name="ipPlotElements"
)
ipPlotBars <- rk.XML.radio(
label="Bars",
options=list(
"Grouped bars"=c(val="group", chk=TRUE),
"Split bars"=c(val="split")
),
id.name="ipPlotBars"
)
ipClipping <- rk.XML.dropdown(
label="Clipping",
options=list(
"clip to plot (no bar outside region)"=c(val="plot", chk=TRUE), # xpd=FALSE
"clip to figure"=c(val="figure"), # xpd=TRUE
"clip to device"=c(val="device") # xpd=NA
),
id.name="ipClipping"
)
ipSE <- rk.XML.cbox(
label="Standard error",
chk=TRUE,
id.name="ipSE"
)
ipLegend <- rk.XML.frame(
ipLegendLabel <- rk.XML.input(
label="Legend label",
id.name="ipLegendLabel"
),
label="Legend",
checkable=TRUE,
chk=TRUE,
id.name="ipLegend"
)
ipDrawSE <- rk.XML.frame(
ipUpperError <- rk.XML.cbox(
label="Upper error",
chk=TRUE,
id.name="ipUpperError"
),
ipLowerError <- rk.XML.cbox(
label="Lower error",
chk=TRUE,
id.name="ipLowerError"
),
label="Draw standard error",
checkable=TRUE,
chk=TRUE,
id.name="ipDrawSE"
)
ip.plot.options <- rk.plotOptions()
ip.preview <- rk.XML.preview()
## logic
ip.lgc.sect <- rk.XML.logic(
ip.gov.lineplot <- rk.XML.convert(sources=list(string=ipPlotType), mode=c(equals="line")),
rk.XML.connect(governor=ip.gov.lineplot, client=ipPlotElements, set="visible"),
rk.XML.connect(governor=ip.gov.lineplot, client=ipPlotBars, set="visible", not=TRUE),
rk.XML.connect(governor=ip.gov.lineplot, client=ipClipping, set="visible", not=TRUE),
rk.XML.connect(governor=ip.gov.lineplot, client=ipUpperError, set="enabled", not=TRUE),
rk.XML.connect(governor=ip.gov.lineplot, client=ipLowerError, set="enabled", not=TRUE),
ip.gov.traces <- rk.XML.convert(sources=list(available=ipGroups), mode=c(notequals="")),
rk.XML.connect(governor=ip.gov.traces, client=ipPlotBars, set="enabled"),
rk.XML.connect(governor=ip.gov.traces, client=ipLegend, set="enabled"),
ip.gov.leglabel <- rk.XML.convert(sources=list(ip.gov.traces, checked=ipLegend), mode=c(and="")),
rk.XML.connect(governor=ip.gov.leglabel, client=ipLegendLabel, set="enabled"),
rk.XML.connect(governor=ipFactor, client=ip.plot.options, get="available", set="xvar"),
rk.XML.connect(governor=ipResponse, client=ip.plot.options, get="available", set="yvar"),
rk.XML.set(ip.plot.options, set="allow_type", to=FALSE)
)
ip.tab1 <- rk.XML.row(
ipData,
rk.XML.col(
rk.XML.frame(ipFactor, ipResponse, ipGroups,
label="Data"
),
rk.XML.stretch()
)
)
ip.tab2.options <- rk.XML.col(
rk.XML.row(
rk.XML.frame(
rk.XML.row(
rk.XML.col(ipPlotType, rk.XML.stretch()),
rk.XML.col(ipPlotElements, ipPlotBars, ipClipping, rk.XML.stretch())
)
)
),
rk.XML.row(
rk.XML.col(
ipLegend
),
rk.XML.col(
ipDrawSE
)
),
ip.plot.options,
ip.preview
)
ip.full.dialog <- rk.XML.dialog(
rk.XML.tabbook(
label="Interaction plot",
tabs=list(
"Data"=ip.tab1,
"Options"=ip.tab2.options
),
),
label="Interaction plot"
)
## JavaScript
# see if frames are checked
ip.js.frm.legend <- rk.JS.vars(ipLegend, modifiers="checked")
ip.js.frm.se <- rk.JS.vars(ipDrawSE, modifiers="checked")
ip.js.prnt <- rk.paste.JS.graph(
ip.js.frm.legend,
ip.js.frm.se,
js(
if(ipPlotType == "line"){
echo("\t\tlineplot.CI(")
} else {
echo("\t\tbargraph.CI(")
},
if(ipFactor){
echo("\n\t\t\tx.factor=", ipFactor)
} else {},
if(ipResponse){
echo(",\n\t\t\tresponse=", ipResponse)
} else {},
if(ipGroups){
echo(",\n\t\t\tgroup=", ipGroups)
} else {},
if(ipPlotType == "line"){
if(ipPlotElements != "b"){
echo(",\n\t\t\ttype=\"", ipPlotElements, "\"")
} else {}
if(!ip.js.frm.legend && ipGroups != ""){
echo(",\n\t\t\tlegend=FALSE")
} else {}
if(!ip.js.frm.se){
echo(",\n\t\t\tci.fun=function(x)c(mean(x, na.rm=TRUE), mean(x, na.rm=TRUE))")
} else {}
} else {
if(ipPlotBars == "split"){
echo(",\n\t\t\tsplit=TRUE")
} else {}
if(ip.js.frm.legend && ipGroups != ""){
echo(",\n\t\t\tlegend=TRUE")
} else {}
if(!ip.js.frm.se){
echo(",\n\t\t\tuc=FALSE,\n\t\t\tlc=FALSE")
} else {}
if(ip.js.frm.se && !ipUpperError){
echo(",\n\t\t\tuc=FALSE")
} else {}
if(ip.js.frm.se && !ipLowerError){
echo(",\n\t\t\tlc=FALSE")
} else {}
if(ipClipping == "figure"){
echo(",\n\t\t\txpd=TRUE")
} else if(ipClipping == "device"){
echo(",\n\t\t\txpd=NA")
} else {}
},
if(ip.js.frm.legend && ipGroups != "" && ipLegendLabel != ""){
echo(",\n\t\t\tleg.lab=\"", ipLegendLabel, "\"")
} else {}
),
rkwarddev::id("echo(", ip.plot.options, ".replace(/, /g, \",\\n\\t\\t\\t\"));"),
echo("\n\t\t)"),
plotOpts=ip.plot.options
)
## make a whole component of the interaction plot
plot.component <- rk.plugin.component(
"Interaction plot",
xml=list(
logic=ip.lgc.sect,
dialog=ip.full.dialog),
js=list(
results.header="Interaction plot",
require="sciplot",
printout=ip.js.prnt),
guess.getter=guess.getter,
hierarchy=list("plots"),
create=c("xml", "js"),
gen.info="$SRC/inst/rkward/rkwarddev_ANOVA_plugin_script.R"
)
#############
## if you run the following function call, files will be written to tempdir!
#############
# this is where it get's serious, that is, here all of the above is put together into one plugin
rk.ANOVA.dir <<- rk.plugin.skeleton(
about.info,
path=output.dir,
guess.getter=guess.getter,
xml=list(
logic=lgc.sect,
dialog=full.dialog
),
js=list(
require="ez",
calculate=js.calc,
printout=js.print,
load.silencer=noLoadMsg,
results.header="ANOVA results"
),
pluginmap=list(name="ANOVA", hierarchy=list("analysis", "ANOVA")),
components=list(pttest.component, plot.component, pdata.component),
dependencies=dependencies.info,
create=c("pmap", "xml", "js", "desc"),
overwrite=overwrite,
gen.info="$SRC/inst/rkward/rkwarddev_ANOVA_plugin_script.R",
tests=FALSE,
# edit=TRUE,
load=TRUE,
# show=TRUE,
hints=FALSE
)
if(isTRUE(update.translations)){
rk.updatePluginMessages(file.path(output.dir,"rk.ANOVA","inst","rkward","rk.ANOVA.pluginmap"))
} else {}
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.