# 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)
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 <- FALSE
about.info <- rk.XML.about(
name="rk.MPT",
author=c(
person(given="Meik", family="Michalke",
email="meik.michalke@hhu.de", role=c("aut","cre"))),
about=list(desc="RKWard GUI for multinomial processing tree (MPT) models",
version="0.01-3", 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="mpt"), c(name="MPTinR2"))
package=list(c(name="MPTinR2"))
)
############
## MPTinR2
############
var.select <- rk.XML.varselector(label="Select data")
var.data <- rk.XML.varslot(label="Data (vector, matrix or data.frame)", source=var.select, classes=c("vector", "data.frame", "matrix"), required=TRUE)
MPTinR2.model.format <- rk.XML.dropdown(label="Model format", options=list(
"Read model from file"=c(val="file", chk=TRUE),
"Object of class bmpt.model or mpt.model"=c(val="object")
))
MPTinR2.model.obj <- rk.XML.varslot(label="Model (bmpt.model or mpt.model)", source=var.select, classes=c("bmpt.model","mpt.model"), required=TRUE)
MPTinR2.model.file <- rk.XML.browser(label="Model file")
MPTinR2.model.type <- rk.XML.dropdown(label="Model type", options=list(
"Easy"=c(val="easy", chk=TRUE),
"EQN"=c(val="eqn"),
"EQN2"=c(val="eqn2")
))
MPTinR2.restr <- rk.XML.browser(label="Restrictions file", required=FALSE)
MPTinR2.optim <- rk.XML.spinbox(label="Number of optimization runs", min=1, initial=5, real=FALSE)
MPTinR2.optim.output <- rk.XML.cbox(label="Full optim results in output", value="true")
MPTinR2.conf <- rk.XML.spinbox(label="Confidence interval", min=0, max=100, initial=95, real=FALSE)
save.results <- rk.XML.saveobj("Save results to workspace", initial="MPTinR2.result")
# show options
MPTinR2.show.par <- rk.XML.cbox(label="Parameters", value="true", chk=TRUE)
MPTinR2.show.gof <- rk.XML.cbox(label="Goodness of fit", value="true", chk=TRUE)
MPTinR2.show.inf <- rk.XML.cbox(label="Information criteria", value="true", chk=TRUE)
tab.main <- rk.XML.row(
var.select,
rk.XML.col(
var.data,
MPTinR2.model.format,
MPTinR2.model.obj,
MPTinR2.model.file,
MPTinR2.model.type,
MPTinR2.restr,
rk.XML.stretch(),
save.results
)
)
tab.options <- rk.XML.row(
rk.XML.col(
rk.XML.frame(
rk.XML.row(
rk.XML.col(MPTinR2.optim),
rk.XML.col(MPTinR2.conf)
)
),
rk.XML.frame(
MPTinR2.show.par,
MPTinR2.show.gof,
MPTinR2.show.inf,
label="Show in output"),
rk.XML.stretch()
)
)
MPTinR2.full.dialog <- rk.XML.dialog(
rk.XML.tabbook(tabs=list(
"Model"=tab.main,
"Options"=tab.options
)),
label="Multinomial Processing Trees: MPTinR2")
## JavaScript
MPTinR2.js.calc <- rk.paste.JS(
echo("\tMPTinR2.result <- fit.mpt("),
ite(id(MPTinR2.model.format, " == \"file\" && ", MPTinR2.model.file), echo("\n\t\tmodel=\"", MPTinR2.model.file, "\"")),
ite(id(MPTinR2.model.format, " == \"object\" && ", MPTinR2.model.obj), echo("\n\t\tmodel=", MPTinR2.model.obj)),
ite(var.data, echo(",\n\t\tdata=", var.data)),
ite(MPTinR2.restr, echo(",\n\t\trestrictions.filename=\"", MPTinR2.restr, "\"")),
ite(id(MPTinR2.model.format, " == \"file\" && ", MPTinR2.model.type, " != \"easy\""), echo(",\n\t\tmodel.type=\"", MPTinR2.model.type, "\"")),
ite(id(MPTinR2.conf, " != 95"), echo(",\n\t\tci=", MPTinR2.conf)),
ite(id(MPTinR2.optim, " != 5"), echo(",\n\t\tn.optim=", MPTinR2.optim)),
echo("\n\t)\n"),
ite(MPTinR2.show.par, echo("\t# Get parameters\n\tMPTinR2.par <- parameters(MPTinR2.result)\n")),
ite(MPTinR2.show.gof, echo("\t# Goodness of fit\n\tMPTinR2.gof <- goodness.of.fit(MPTinR2.result)\n")),
ite(MPTinR2.show.inf, echo("\t# Information criteria\n\tMPTinR2.inf <- information.criteria(MPTinR2.result)\n")),
echo("\n")
)
MPTinR2.js.print <- rk.paste.JS(
rk.JS.vars(MPTinR2.show.par, MPTinR2.show.gof, MPTinR2.show.inf),
echo("\trk.header(\"Multinomial Processing Trees (MPTinR2)\",
parameters=list(
\"Number of trees\"=MPTinR2.result@model@check$n.trees,
\"Number of categories\"=MPTinR2.result@model@check$n.categories,
\"Number of free parameters\"=MPTinR2.result@model@check$n.free.parameters,
\"Number of fixed parameters\"=MPTinR2.result@model@check$n.fixed.parameters),
level=1)\n"),
echo("\trk.header(\"Degrees of freedom\", level=4)\n"),
echo("\trk.results(data.frame(t(MPTinR2.result@model@check$df)))\n"),
ite(MPTinR2.show.gof, rk.paste.JS(
echo("\n\trk.header(\"Goodness of fit\", level=4)\n"),
echo("\trk.print(\"Individual:\")\n"),
echo("\trk.results(data.frame(MPTinR2.gof$individual), print.rownames=TRUE)\n"),
echo("\trk.print(\"<br />Sum:\")\n"),
echo("\trk.results(data.frame(t(MPTinR2.gof$sum)))\n"),
echo("\trk.print(\"<br />Aggregated:\")\n"),
echo("\trk.results(data.frame(t(MPTinR2.gof$aggregated)))\n"), level=3)),
ite(MPTinR2.show.inf, rk.paste.JS(
echo("\n\trk.header(\"Information criteria\", level=4)\n"),
echo("\trk.print(\"Individual:\")\n"),
echo("\trk.results(data.frame(MPTinR2.inf$individual), print.rownames=TRUE)\n"),
echo("\trk.print(\"<br />Sum:\")\n"),
echo("\trk.results(data.frame(t(MPTinR2.inf$sum)))\n"),
echo("\trk.print(\"<br />Aggregated:\")\n"),
echo("\trk.results(data.frame(t(MPTinR2.inf$aggregated)))\n"), level=3)),
ite(MPTinR2.show.par, rk.paste.JS(
echo("\n\trk.header(\"Parameter estimates\", level=4)\n"),
echo("\trk.print(\"Individual:\")\n"),
echo("\trk.results(data.frame(MPTinR2.result@estimates), print.rownames=TRUE)\n"),
echo("\trk.print(\"<br />Mean values:\")\n"),
echo("\trk.results(data.frame(MPTinR2.par$mean))\n"),
echo("\trk.print(\"<br />Aggregated data:\")\n"),
echo("\trk.results(data.frame(MPTinR2.par$aggregated))\n\n"), level=3))
)
MPTinR2.logic <- rk.XML.logic(
govModelFromFile <- rk.XML.convert(sources=list(string=MPTinR2.model.format), mode=c(equals="file")),
rk.XML.connect(governor=govModelFromFile, client=MPTinR2.model.file, set="visible"),
rk.XML.connect(governor=govModelFromFile, client=MPTinR2.model.type, set="visible"),
rk.XML.connect(governor=govModelFromFile, client=MPTinR2.model.obj, set="visible", not=TRUE),
# some JavaScript magic to set model type to EQN automatically
rk.comment(id("
gui.addChangeCommand(\"", MPTinR2.model.file, ".selection\", \"modelChanged()\");
// this function is called whenever the model file name was changed
modelChanged = function(){
var modelName = gui.getValue(\"", MPTinR2.model.file, ".selection\");
if(modelName.match(/.*\\.eqn|.*\\.EQN/)){
gui.setValue(\"", MPTinR2.model.type, ".string\", \"eqn\");
} else {}
}", js=FALSE))
)
#############
## 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.plugin.skeleton(
about.info,
path=output.dir,
guess.getter=guess.getter,
xml=list(
dialog=MPTinR2.full.dialog,
logic=MPTinR2.logic),
js=list(results.header=NULL,
require="MPTinR2",
calculate=MPTinR2.js.calc,
printout=MPTinR2.js.print),
pluginmap=list(name="MPTinR2", hierarchy=list("analysis", "MPT")),
dependencies=dependencies.info,
create=c("pmap", "xml", "js", "desc"),
overwrite=overwrite,
tests=FALSE,
# edit=TRUE,
load=TRUE,
# show=TRUE,
hints=FALSE)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.