inst/rkward/rkwarddev_ANOVA_plugin_script.R

In rkward-community/rk.ANOVA: RKWard GUI to conduct ANOVAs (using the ez package), pairwise t-Tests and plot interactions.

# 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 &amp; Hochberg (fdr)"=c(val="BH"),
    "Benjamini &amp; 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 {}

})