# BiodiversityR
# Biodiversity Analysis Functions for R
# Developed by Roeland Kindt
#
# This software accompanies Kindt R and Coe R. 2005. Tree Diversity Analysis. A manual
# and software for some common statistical methods for biodiversity and ecological
# analysis. World Agroforestry Centre (ICRAF), Nairobi. vi+196 pp. This is also the suggested citation
# for this software.
#
# Many of the user interface functions were based on John Fox's R Commander (Rcmdr)
# Other functions are often based on the vegan package (Oksanen, Kindt, Legendre & O'Hara)
#
# To use most of the BiodiversityR functions, a community and an environmental dataset need to be identified first.
# Both datasets have the same number of rows (= number of sample units)
# Columns in the community dataset usually represent species
# Columns in the environmental represent environmental characteristics of sample units
#
# Roeland Kindt takes no liability for any direct, special, indirect or consequential damages resulting
# from loss of use, data or profits arising in connection with the use or performance of this software.
#
# The software can be quoted or reproduced without charge, provided the source is
# acknowledged. You must adhere to conditions of copyright of R software documented in
# rw2011\COPYING. Use the citation() or loaded.citations() function for acknowledgments in publications for
# any package that you made use of.
# library(Rcmdr, quietly=TRUE)
Rcmdr::putRcmdr(".communityDataSet", NULL)
Rcmdr::putRcmdr("operatorFont", tkfont.create(family="courier", size=Rcmdr::getRcmdr("log.font.size")))
#changed based on R Commander 1.9-6 (data-Menu.R)
selectCommunityDataSet <- function(){
dataSets <- listDataSets()
.communityDataSet <- CommunityDataSet()
if ((length(dataSets) == 1) && !is.null(.communityDataSet)) {
Message(message=gettextRcmdr("There is only one dataset in memory."),
type="warning")
tkfocus(CommanderWindow())
return()
}
if (length(dataSets) == 0){
Message(message=gettextRcmdr("There are no data sets from which to choose."),
type="error")
tkfocus(CommanderWindow())
return()
}
initializeDialog(title=gettextRcmdr("Select Community Data Set"))
dataSetsBox <- variableListBox(top, dataSets, title=gettextRcmdr("Data Sets (pick one)"),
initialSelection=if (is.null(.communityDataSet)) NULL else which(.communityDataSet == dataSets) - 1)
onOK <- function(){
communityDataSet(getSelection(dataSetsBox))
closeDialog()
tkfocus(CommanderWindow())
}
OKCancelHelp()
tkgrid(getFrame(dataSetsBox), sticky="nw")
tkgrid(buttonsFrame, sticky="w")
dialogSuffix(rows=2, columns=1)
}
#changed based on R Commander 1.9-6 (utilities.R)
communityDataSet <- function(dsname, flushModel=TRUE, flushDialogMemory=TRUE){
.communityDataSet <- CommunityDataSet()
if (missing(dsname)) {
if (is.null(.communityDataSet)){
Message(message=gettextRcmdr("There is no community data set."), type="error")
return(FALSE)
}
else return(.communityDataSet)
}
if (!is.data.frame(ds <- get(dsname, envir=.GlobalEnv))){
if (!exists.method("as.data.frame", ds, default=FALSE)){
Message(message=paste(dsname, gettextRcmdr(" is not a data frame and cannot be attached."),
sep=""), type="error")
tkfocus(CommanderWindow())
return()
}
command <- paste(dsname, " <- as.data.frame(", dsname, ")", sep="")
justDoIt(command)
logger(command)
Message(message=paste(dsname, gettextRcmdr(" has been coerced to a data frame"), sep=""),
type="warning")
}
varnames <- names(get(dsname, envir=.GlobalEnv))
newnames <- make.names(varnames)
badnames <- varnames != newnames
if (any(badnames)){
command <- paste("names(", dsname, ") <- make.names(names(",
dsname, "))", sep="")
doItAndPrint(command)
}
if (!is.null(.communityDataSet) && Rcmdr::getRcmdr("attach.data.set")
&& (length(grep(.communityDataSet, search())) !=0)) {
detach(pos = match(.communityDataSet, search()))
logger(paste("detach(", .communityDataSet, ")", sep=""))
}
if (flushModel) {
Rcmdr::putRcmdr(".activeModel", NULL)
RcmdrTclSet("modelName", gettextRcmdr("<No active model>"))
if (!is.SciViews()) tkconfigure(Rcmdr::getRcmdr("modelLabel"), foreground="red") else refreshStatus()
}
if (flushDialogMemory) Rcmdr::putRcmdr("dialog.values", list())
# -PhG tkconfigure(.modelLabel, foreground="red")
CommunityDataSet(dsname)
Message(sprintf(gettextRcmdr("The dataset %s has %d rows and %d columns."), dsname,
nrow(get(dsname, envir=.GlobalEnv)), ncol(get(dsname, envir=.GlobalEnv))), type="note")
if (any(badnames)) Message(message=paste(dsname, gettextRcmdr(" contains non-standard variable names:\n"),
paste(varnames[badnames], collapse=", "),
gettextRcmdr("\nThese have been changed to:\n"), paste(newnames[badnames], collapse=", "),
sep=""), type="warning")
CVariables(listCVariables())
# Numeric(listNumeric())
# Factors(listFactors())
# TwoLevelFactors(listTwoLevelFactors())
# changed 2014 all to #
# RcmdrTclSet("dataSetName", paste(" ", dsname, " "))
# -PhG tkconfigure(.dataSetLabel, foreground="blue")
# if (!is.SciViews()) tkconfigure(Rcmdr::getRcmdr("dataSetLabel"), foreground="blue") else refreshStatus() # +PhG
# if (Rcmdr::getRcmdr("attach.data.set")){
# attach(get(dsname, envir=.GlobalEnv), name=dsname)
# logger(paste("attach(", dsname, ")", sep=""))
# }
# if (is.SciViews()) refreshStatus() else if (flushModel) tkconfigure(Rcmdr::getRcmdr("modelLabel"), foreground="red") # +PhG (& J.Fox, 25Dec04)
activateMenus()
dsname
}
# changed based on R Commander 1.9-6 (utilities.R)
checkCommunityDataSet <- function(){
if (communityDataSet() == FALSE) {
tkfocus(CommanderWindow())
FALSE
}
else TRUE
}
# changed based on R Commander 1.9-6 (utilities.R)
CommunityDataSet <- function(name){
if (missing(name)) {
temp <- Rcmdr::getRcmdr(".communityDataSet")
if (is.null(temp))
return(NULL)
else
if (!exists(temp) || !is.data.frame(get(temp,envir=.GlobalEnv))) {
Message(sprintf(gettextRcmdr("the dataset %s is no longer available"),
temp), type="error")
Rcmdr::putRcmdr(".communityDataSet", NULL)
RcmdrTclSet("dataSetName", gettextRcmdr("<No active dataset>"))
Rcmdr::putRcmdr(".activeModel", NULL)
RcmdrTclSet("modelName", gettextRcmdr("<No active model>"))
if (!is.SciViews()) {
tkconfigure(Rcmdr::getRcmdr("dataSetLabel"), foreground="red")
tkconfigure(Rcmdr::getRcmdr("modelLabel"), foreground="red")
}
else refreshStatus()
activateMenus()
if (Rcmdr::getRcmdr("suppress.menus") && RExcelSupported()) return(NULL)
}
return(temp)
}
else Rcmdr::putRcmdr(".communityDataSet", name)
}
CVariables <- function(cnames){
if (missing(cnames)) Rcmdr::getRcmdr("cvariables")
else Rcmdr::putRcmdr("cvariables", cnames)
}
listCVariables <- function(dataSet=CommunityDataSet()) {
cvars <- eval(parse(text=paste("names(", dataSet,")")), envir=.GlobalEnv)
if (Rcmdr::getRcmdr("sort.names")) sort(cvars) else cvars
}
communityDataSetP <- function() !is.null(CommunityDataSet())
data(dune)
data(dune.env)
dune2 <- dune
dune.env2 <- dune.env
seq <- c(2,13,4,16,6,1,8,5,17,15,10,11,9,18,3,20,14,19,12,7)
dune2[seq,] <- dune[1:20,]
dune.env2[seq,] <- dune.env[1:20,]
rownames(dune2)[seq] <- rownames(dune)[1:20]
rownames(dune.env2)[seq] <- rownames(dune)[1:20]
dune3 <- dune2
seq <- order(colnames(dune2))
dune3[,1:30] <- dune2[,seq]
colnames(dune3)[1:30] <- colnames(dune2)[seq]
dune <- dune3
dune.env <- dune.env2
rownames(dune) <- rownames(dune.env) <- c("X01", "X02", "X03", "X04", "X05", "X06", "X07", "X08", "X09", "X10",
"X11", "X12", "X13", "X14", "X15", "X16", "X17", "X18", "X19", "X20")
remove(dune2, dune3, dune.env2)
makecommunityGUI <- function(){
top <- tktoplevel()
tkwm.title(top, "Make community matrix")
.activeDataSet <- ActiveDataSet()
.fvariables <- Factors()
fvariables <- paste(.fvariables, ifelse(is.element(.fvariables, Factors()), "[factor]", ""))
.nvariables <- Numeric()
nvariables <- paste(.nvariables)
modelName <- tclVar("Community.1")
modelFrame <- tkframe(top, relief="groove", borderwidth=2)
model <- tkentry(modelFrame, width=40, textvariable=modelName)
siteFrame <- tkframe(top, relief="groove", borderwidth=2)
siteBox <- tklistbox(siteFrame, width=27, height=5,
selectmode="single", background="white", exportselection="FALSE")
siteScroll <- tkscrollbar(siteFrame, repeatinterval=5, command=function(...) tkyview(siteBox, ...))
tkconfigure(siteBox, yscrollcommand=function(...) tkset(siteScroll, ...))
for (x in fvariables) tkinsert(siteBox, "end", x)
specFrame <- tkframe(top, relief="groove", borderwidth=2)
specBox <- tklistbox(specFrame, width=27, height=5,
selectmode="single", background="white", exportselection="FALSE")
specScroll <- tkscrollbar(specFrame, repeatinterval=5, command=function(...) tkyview(specBox, ...))
tkconfigure(specBox, yscrollcommand=function(...) tkset(specScroll, ...))
for (x in fvariables) tkinsert(specBox, "end", x)
valueFrame <- tkframe(top, relief="groove", borderwidth=2)
valueBox <- tklistbox(valueFrame, width=27, height=5,
selectmode="single", background="white", exportselection="FALSE")
valueScroll <- tkscrollbar(valueFrame, repeatinterval=5, command=function(...) tkyview(valueBox, ...))
tkconfigure(valueBox, yscrollcommand=function(...) tkset(valueScroll, ...))
for (x in nvariables) tkinsert(valueBox, "end", x)
subsetFrame <- tkframe(top, relief="groove", borderwidth=2)
subset1Frame <- tkframe(subsetFrame)
subset2Frame <- tkframe(subsetFrame)
subsetBox <- tklistbox(subset1Frame, width=27, height=5,
selectmode="single", background="white", exportselection="FALSE")
subsetScroll <- tkscrollbar(subset1Frame, repeatinterval=5, command=function(...) tkyview(subsetBox, ...))
tkconfigure(subsetBox, yscrollcommand=function(...) tkset(subsetScroll, ...))
variables <- c("all",fvariables)
for (x in variables) tkinsert(subsetBox, "end", x)
subset <- tclVar("")
subsetEntry <- tkentry(subset2Frame, width=10, textvariable=subset)
onOK <- function(){
modelValue <- tclvalue(modelName)
site <- .fvariables[as.numeric(tkcurselection(siteBox))+1]
spec <- .fvariables[as.numeric(tkcurselection(specBox))+1]
value <- .nvariables[as.numeric(tkcurselection(valueBox))+1]
var <- variables[as.numeric(tkcurselection(subsetBox))+1]
sub <- tclvalue(subset)
if (var == "all") {
command <- paste("makecommunitydataset(", .activeDataSet, ", row='", site, "', column='", spec, "', value='", value, "')", sep="")
}else{
var <- .fvariables[as.numeric(tkcurselection(subsetBox))]
command <- paste("makecommunitydataset(", .activeDataSet, ", row='", site, "', column='", spec, "', value='", value, "', factor='", var, "', level='", sub, "')", sep="")
}
logger(paste(modelValue, " <- ", command, sep=""))
assign(modelValue, justDoIt(command), envir=.GlobalEnv)
communityDataSet(modelValue)
}
onCancel <- function() {
tkgrab.release(top)
tkfocus(CommanderWindow())
tkdestroy(top)
}
buttonsFrame <- tkframe(top)
onHelp <- function() {
if (.Platform$OS.type != "windows") tkgrab.release(top)
doItAndPrint(paste("help('makecommunitydataset', help_type='html')", sep=""))
}
helpButton <- tkbutton(buttonsFrame, text="Help", width="12", command=onHelp)
OKbutton <- tkbutton(buttonsFrame, text="OK", width="12", command=onOK, default="active")
cancelButton <- tkbutton(buttonsFrame, text="Cancel", width="12", command=onCancel)
tkgrid(tklabel(modelFrame, text="Save result as: ", width=15), model, sticky="w")
tkgrid(modelFrame, sticky="w")
tkgrid(tklabel(siteFrame, text="Site variable (rows)"), sticky="w")
tkgrid(siteBox, siteScroll, sticky="w")
tkgrid(siteFrame, sticky="w")
tkgrid(tklabel(specFrame, text="Species variable (columns)"), sticky="w")
tkgrid(specBox, specScroll, sticky="w")
tkgrid(specFrame, sticky="w")
tkgrid(tklabel(valueFrame, text="Abundance variable"), sticky="w")
tkgrid(valueBox, valueScroll, sticky="w")
tkgrid(valueFrame, sticky="w")
tkgrid(tklabel(subsetFrame, text="Subset options"), sticky="w")
tkgrid(subsetBox, subsetScroll, sticky="w")
tkgrid(tklabel(subset2Frame, text="subset: ", width=15), subsetEntry, sticky="w")
tkgrid(subset1Frame, sticky="w")
tkgrid(subset2Frame, sticky="w")
tkgrid(subsetFrame, sticky="w")
tkgrid(OKbutton, cancelButton, helpButton)
tkgrid(buttonsFrame, sticky="w")
tkgrid.configure(subsetScroll, sticky="ns")
tkgrid.configure(siteScroll, sticky="ns")
tkgrid.configure(specScroll, sticky="ns")
tkgrid.configure(valueScroll, sticky="ns")
tkselection.set(subsetBox, 0)
tkselection.set(siteBox, 0)
tkselection.set(specBox, 0)
tkselection.set(valueBox, 0)
for (row in 0:6) tkgrid.rowconfigure(top, row, weight=0)
for (col in 0:0) tkgrid.columnconfigure(top, col, weight=0)
.Tcl("update idletasks")
tkwm.resizable(top, 0, 0)
tkwm.deiconify(top)
tkgrab.set(top)
tkfocus(siteBox)
tkwait.window(top)
}
importfromExcelGUI2 <- function() {
initializeDialog(title="Read Community and Environmental data From Excel")
optionsFrame <- tkframe(top, relief="groove", borderwidth=2)
comdsname <- tclVar("CommunityData")
entrycomDsname <- tkentry(optionsFrame, width="20", textvariable=comdsname)
envdsname <- tclVar("EnvironmentalData")
entryenvDsname <- tkentry(optionsFrame, width="20", textvariable=envdsname)
dsites <- tclVar("sites")
entrysites <- tkentry(optionsFrame, width="20", textvariable=dsites)
stackedFrame <- tkframe(top, relief="groove", borderwidth=2)
stackedVariable <- tclVar("0")
stackedCheckBox <- tkcheckbutton(stackedFrame, variable=stackedVariable)
scolumn <- tclVar("species")
entrycol <- tkentry(stackedFrame, width="20", textvariable=scolumn)
sval <- tclVar("abundance")
entryval <- tkentry(stackedFrame, width="20", textvariable=sval)
sfactor <- tclVar("all")
entryfactor <- tkentry(stackedFrame, width="20", textvariable=sfactor)
slevel <- tclVar("all")
entrylevel <- tkentry(stackedFrame, width="20", textvariable=slevel)
onOK <- function(){
closeDialog()
comdsnameValue <- tclvalue(comdsname)
envdsnameValue <- tclvalue(envdsname)
sitesValue <- tclvalue(dsites)
colValue <- tclvalue(scolumn)
valValue <- tclvalue(sval)
factorValue <- tclvalue(sfactor)
levelValue <- tclvalue(slevel)
file <- tclvalue(tkgetOpenFile(filetypes='{"Excel Files" {".xls" ".xlsx" ".XLS" ".XLSX"}} {"All Files" {"*"}}'))
if (file == "") {
if (Rcmdr::getRcmdr("grab.focus")) tkgrab.release(top)
tkdestroy(top)
return()
}
justDoIt(paste("library(RODBC)", sep=""))
logger(paste("library(RODBC)", sep=""))
stacked <- tclvalue(stackedVariable) == "1"
if (stacked==F) {
command <- paste("import.with.readxl('", file, "', data.type='community', sheet='community', sitenames='", sitesValue, "', cepnames=F, write.csv=F, csv.file='community.csv')", sep="")
}else{
if (factorValue=="all") {
command <- paste("import.with.readxl('", file, "', data.type='stacked', sheet='stacked', sitenames='", sitesValue, "', column='", colValue, "', value='", valValue, "', cepnames=F, write.csv=F, csv.file='community.csv')", sep="")
}else{
command <- paste("import.with.readxl('", file, "', data.type='stacked', sheet='stacked', sitenames='", sitesValue, "', column='", colValue, "', value='", valValue, "', factor='", factorValue, "', level='", levelValue, "', cepnames=F, write.csv=F, csv.file='community.csv')", sep="")
}
}
logger(paste(comdsnameValue, " <- ", command, sep=""))
assign(comdsnameValue, justDoIt(command), envir=.GlobalEnv)
communityDataSet(comdsnameValue)
command <- paste("import.with.readxl('", file, "', data.type='environmental', sheet='environmental', sitenames='", sitesValue, "', write.csv=F, csv.file='environmental.csv')", sep="")
logger(paste(envdsnameValue, " <- ", command, sep=""))
assign(envdsnameValue, justDoIt(command), envir=.GlobalEnv)
activeDataSet(envdsnameValue)
tkfocus(CommanderWindow())
}
onCancel <- function() {
tkgrab.release(top)
tkfocus(CommanderWindow())
tkdestroy(top)
}
buttonsFrame <- tkframe(top)
onHelp <- function() {
if (.Platform$OS.type != "windows") tkgrab.release(top)
doItAndPrint(paste("help('import.from.Excel', help_type='html')", sep=""))
}
helpButton <- tkbutton(buttonsFrame, text="Help", width="12", command=onHelp)
OKbutton <- tkbutton(buttonsFrame, text="OK", width="12", command=onOK, default="active")
cancelButton <- tkbutton(buttonsFrame, text="Cancel", width="12", command=onCancel)
tkgrid(tklabel(optionsFrame, text="Names for new datasets"), sticky="w")
tkgrid(tklabel(optionsFrame, text="Enter name for community data set:"), entrycomDsname, sticky="w")
tkgrid(tklabel(optionsFrame, text="Enter name for environmental data set:"), entryenvDsname, sticky="w")
tkgrid(tklabel(optionsFrame, text="Enter name for variable with sites:"), entrysites, sticky="w")
tkgrid(optionsFrame, sticky="w")
tkgrid(tklabel(stackedFrame, text="Options for stacked data entry"), sticky="w")
tkgrid(tklabel(stackedFrame, text="Import community dataset from stacked format:"), stackedCheckBox, sticky="w")
tkgrid(tklabel(stackedFrame, text="Enter variable for species:"), entrycol, sticky="w")
tkgrid(tklabel(stackedFrame, text="Enter variable for abundance:"), entryval, sticky="w")
tkgrid(tklabel(stackedFrame, text="Enter factor for subset:"), entryfactor, sticky="w")
tkgrid(tklabel(stackedFrame, text="Enter level for subset:"), entrylevel, sticky="w")
tkgrid(stackedFrame, sticky="w")
tkgrid(OKbutton, cancelButton, helpButton)
tkgrid(buttonsFrame, sticky="w")
dialogSuffix(rows=4, columns=1)
}
importfromExcelGUI <- function() {
initializeDialog(title="Read Community and Environmental data From Excel")
optionsFrame <- tkframe(top, relief="groove", borderwidth=2)
comdsname <- tclVar("CommunityData")
entrycomDsname <- tkentry(optionsFrame, width="20", textvariable=comdsname)
envdsname <- tclVar("EnvironmentalData")
entryenvDsname <- tkentry(optionsFrame, width="20", textvariable=envdsname)
dsites <- tclVar("sites")
entrysites <- tkentry(optionsFrame, width="20", textvariable=dsites)
stackedFrame <- tkframe(top, relief="groove", borderwidth=2)
stackedVariable <- tclVar("0")
stackedCheckBox <- tkcheckbutton(stackedFrame, variable=stackedVariable)
scolumn <- tclVar("species")
entrycol <- tkentry(stackedFrame, width="20", textvariable=scolumn)
sval <- tclVar("abundance")
entryval <- tkentry(stackedFrame, width="20", textvariable=sval)
sfactor <- tclVar("all")
entryfactor <- tkentry(stackedFrame, width="20", textvariable=sfactor)
slevel <- tclVar("all")
entrylevel <- tkentry(stackedFrame, width="20", textvariable=slevel)
onOK <- function(){
closeDialog()
comdsnameValue <- tclvalue(comdsname)
envdsnameValue <- tclvalue(envdsname)
sitesValue <- tclvalue(dsites)
colValue <- tclvalue(scolumn)
valValue <- tclvalue(sval)
factorValue <- tclvalue(sfactor)
levelValue <- tclvalue(slevel)
file <- tclvalue(tkgetOpenFile(filetypes='{"Excel Files" {".xls" ".XLS"}} {"All Files" {"*"}}'))
if (file == "") {
if (Rcmdr::getRcmdr("grab.focus")) tkgrab.release(top)
tkdestroy(top)
return()
}
justDoIt(paste("library(RODBC)", sep=""))
logger(paste("library(RODBC)", sep=""))
stacked <- tclvalue(stackedVariable) == "1"
if (stacked==F) {
command <- paste("import.from.Excel('", file, "', data.type='community', sheet='community', sitenames='", sitesValue, "', cepnames=F, write.csv=F, csv.file='community.csv')", sep="")
}else{
if (factorValue=="all") {
command <- paste("import.from.Excel('", file, "', data.type='stacked', sheet='stacked', sitenames='", sitesValue, "', column='", colValue, "', value='", valValue, "', cepnames=F, write.csv=F, csv.file='community.csv')", sep="")
}else{
command <- paste("import.from.Excel('", file, "', data.type='stacked', sheet='stacked', sitenames='", sitesValue, "', column='", colValue, "', value='", valValue, "', factor='", factorValue, "', level='", levelValue, "', cepnames=F, write.csv=F, csv.file='community.csv')", sep="")
}
}
logger(paste(comdsnameValue, " <- ", command, sep=""))
assign(comdsnameValue, justDoIt(command), envir=.GlobalEnv)
communityDataSet(comdsnameValue)
command <- paste("import.from.Excel('", file, "', data.type='environmental', sheet='environmental', sitenames='", sitesValue, "', write.csv=F, csv.file='environmental.csv')", sep="")
logger(paste(envdsnameValue, " <- ", command, sep=""))
assign(envdsnameValue, justDoIt(command), envir=.GlobalEnv)
activeDataSet(envdsnameValue)
tkfocus(CommanderWindow())
}
onCancel <- function() {
tkgrab.release(top)
tkfocus(CommanderWindow())
tkdestroy(top)
}
buttonsFrame <- tkframe(top)
onHelp <- function() {
if (.Platform$OS.type != "windows") tkgrab.release(top)
doItAndPrint(paste("help('import.from.Excel', help_type='html')", sep=""))
}
helpButton <- tkbutton(buttonsFrame, text="Help", width="12", command=onHelp)
OKbutton <- tkbutton(buttonsFrame, text="OK", width="12", command=onOK, default="active")
cancelButton <- tkbutton(buttonsFrame, text="Cancel", width="12", command=onCancel)
tkgrid(tklabel(optionsFrame, text="Names for new datasets"), sticky="w")
tkgrid(tklabel(optionsFrame, text="Enter name for community data set:"), entrycomDsname, sticky="w")
tkgrid(tklabel(optionsFrame, text="Enter name for environmental data set:"), entryenvDsname, sticky="w")
tkgrid(tklabel(optionsFrame, text="Enter name for variable with sites:"), entrysites, sticky="w")
tkgrid(optionsFrame, sticky="w")
tkgrid(tklabel(stackedFrame, text="Options for stacked data entry"), sticky="w")
tkgrid(tklabel(stackedFrame, text="Import community dataset from stacked format:"), stackedCheckBox, sticky="w")
tkgrid(tklabel(stackedFrame, text="Enter variable for species:"), entrycol, sticky="w")
tkgrid(tklabel(stackedFrame, text="Enter variable for abundance:"), entryval, sticky="w")
tkgrid(tklabel(stackedFrame, text="Enter factor for subset:"), entryfactor, sticky="w")
tkgrid(tklabel(stackedFrame, text="Enter level for subset:"), entrylevel, sticky="w")
tkgrid(stackedFrame, sticky="w")
tkgrid(OKbutton, cancelButton, helpButton)
tkgrid(buttonsFrame, sticky="w")
dialogSuffix(rows=4, columns=1)
}
importfromExcel2007GUI <- function() {
initializeDialog(title="Read Community and Environmental data From Excel 2007")
optionsFrame <- tkframe(top, relief="groove", borderwidth=2)
comdsname <- tclVar("CommunityData")
entrycomDsname <- tkentry(optionsFrame, width="20", textvariable=comdsname)
envdsname <- tclVar("EnvironmentalData")
entryenvDsname <- tkentry(optionsFrame, width="20", textvariable=envdsname)
dsites <- tclVar("sites")
entrysites <- tkentry(optionsFrame, width="20", textvariable=dsites)
stackedFrame <- tkframe(top, relief="groove", borderwidth=2)
stackedVariable <- tclVar("0")
stackedCheckBox <- tkcheckbutton(stackedFrame, variable=stackedVariable)
scolumn <- tclVar("species")
entrycol <- tkentry(stackedFrame, width="20", textvariable=scolumn)
sval <- tclVar("abundance")
entryval <- tkentry(stackedFrame, width="20", textvariable=sval)
sfactor <- tclVar("all")
entryfactor <- tkentry(stackedFrame, width="20", textvariable=sfactor)
slevel <- tclVar("all")
entrylevel <- tkentry(stackedFrame, width="20", textvariable=slevel)
onOK <- function(){
closeDialog()
comdsnameValue <- tclvalue(comdsname)
envdsnameValue <- tclvalue(envdsname)
sitesValue <- tclvalue(dsites)
colValue <- tclvalue(scolumn)
valValue <- tclvalue(sval)
factorValue <- tclvalue(sfactor)
levelValue <- tclvalue(slevel)
file <- tclvalue(tkgetOpenFile(filetypes='{"Excel Files" {".xlsx" ".XLSX"}} {"All Files" {"*"}}'))
if (file == "") {
if (Rcmdr::getRcmdr("grab.focus")) tkgrab.release(top)
tkdestroy(top)
return()
}
justDoIt(paste("library(RODBC)", sep=""))
logger(paste("library(RODBC)", sep=""))
stacked <- tclvalue(stackedVariable) == "1"
if (stacked==F) {
command <- paste("import.from.Excel2007('", file, "', data.type='community', sheet='community', sitenames='", sitesValue, "', cepnames=F, write.csv=F, csv.file='community.csv')", sep="")
}else{
if (factorValue=="all") {
command <- paste("import.from.Excel2007('", file, "', data.type='stacked', sheet='stacked', sitenames='", sitesValue, "', column='", colValue, "', value='", valValue, "', cepnames=F, write.csv=F, csv.file='community.csv')", sep="")
}else{
command <- paste("import.from.Excel2007('", file, "', data.type='stacked', sheet='stacked', sitenames='", sitesValue, "', column='", colValue, "', value='", valValue, "', factor='", factorValue, "', level='", levelValue, "', cepnames=F, write.csv=F, csv.file='community.csv')", sep="")
}
}
logger(paste(comdsnameValue, " <- ", command, sep=""))
assign(comdsnameValue, justDoIt(command), envir=.GlobalEnv)
communityDataSet(comdsnameValue)
command <- paste("import.from.Excel2007('", file, "', data.type='environmental', sheet='environmental', sitenames='", sitesValue, "', write.csv=F, csv.file='environmental.csv')", sep="")
logger(paste(envdsnameValue, " <- ", command, sep=""))
assign(envdsnameValue, justDoIt(command), envir=.GlobalEnv)
activeDataSet(envdsnameValue)
tkfocus(CommanderWindow())
}
onCancel <- function() {
tkgrab.release(top)
tkfocus(CommanderWindow())
tkdestroy(top)
}
buttonsFrame <- tkframe(top)
onHelp <- function() {
if (.Platform$OS.type != "windows") tkgrab.release(top)
doItAndPrint(paste("help('import.from.Excel', help_type='html')", sep=""))
}
helpButton <- tkbutton(buttonsFrame, text="Help", width="12", command=onHelp)
OKbutton <- tkbutton(buttonsFrame, text="OK", width="12", command=onOK, default="active")
cancelButton <- tkbutton(buttonsFrame, text="Cancel", width="12", command=onCancel)
tkgrid(tklabel(optionsFrame, text="Names for new datasets"), sticky="w")
tkgrid(tklabel(optionsFrame, text="Enter name for community data set:"), entrycomDsname, sticky="w")
tkgrid(tklabel(optionsFrame, text="Enter name for environmental data set:"), entryenvDsname, sticky="w")
tkgrid(tklabel(optionsFrame, text="Enter name for variable with sites:"), entrysites, sticky="w")
tkgrid(optionsFrame, sticky="w")
tkgrid(tklabel(stackedFrame, text="Options for stacked data entry"), sticky="w")
tkgrid(tklabel(stackedFrame, text="Import community dataset from stacked format:"), stackedCheckBox, sticky="w")
tkgrid(tklabel(stackedFrame, text="Enter variable for species:"), entrycol, sticky="w")
tkgrid(tklabel(stackedFrame, text="Enter variable for abundance:"), entryval, sticky="w")
tkgrid(tklabel(stackedFrame, text="Enter factor for subset:"), entryfactor, sticky="w")
tkgrid(tklabel(stackedFrame, text="Enter level for subset:"), entrylevel, sticky="w")
tkgrid(stackedFrame, sticky="w")
tkgrid(OKbutton, cancelButton, helpButton)
tkgrid(buttonsFrame, sticky="w")
dialogSuffix(rows=4, columns=1)
}
importfromAccessGUI <- function() {
initializeDialog(title="Read Community and Environmental data From Access")
optionsFrame <- tkframe(top, relief="groove", borderwidth=2)
comdsname <- tclVar("CommunityData")
entrycomDsname <- tkentry(optionsFrame, width="20", textvariable=comdsname)
envdsname <- tclVar("EnvironmentalDataset")
entryenvDsname <- tkentry(optionsFrame, width="20", textvariable=envdsname)
dsites <- tclVar("sites")
entrysites <- tkentry(optionsFrame, width="20", textvariable=dsites)
stackedFrame <- tkframe(top, relief="groove", borderwidth=2)
stackedVariable <- tclVar("0")
stackedCheckBox <- tkcheckbutton(stackedFrame, variable=stackedVariable)
scolumn <- tclVar("species")
entrycol <- tkentry(stackedFrame, width="20", textvariable=scolumn)
sval <- tclVar("abundance")
entryval <- tkentry(stackedFrame, width="20", textvariable=sval)
sfactor <- tclVar("all")
entryfactor <- tkentry(stackedFrame, width="20", textvariable=sfactor)
slevel <- tclVar("all")
entrylevel <- tkentry(stackedFrame, width="20", textvariable=slevel)
onOK <- function(){
closeDialog()
comdsnameValue <- tclvalue(comdsname)
envdsnameValue <- tclvalue(envdsname)
sitesValue <- tclvalue(dsites)
colValue <- tclvalue(scolumn)
valValue <- tclvalue(sval)
factorValue <- tclvalue(sfactor)
levelValue <- tclvalue(slevel)
file <- tclvalue(tkgetOpenFile(filetypes='{"Access Files" {".mdb" ".MDB"}} {"All Files" {"*"}}'))
if (file == "") {
if (Rcmdr::getRcmdr("grab.focus")) tkgrab.release(top)
tkdestroy(top)
return()
}
justDoIt(paste("library(RODBC)", sep=""))
logger(paste("library(RODBC)", sep=""))
stacked <- tclvalue(stackedVariable) == "1"
if (stacked==F) {
command <- paste("import.from.Access('", file, "', data.type='community', table='community',sitenames='", sitesValue, "')", sep="")
}else{
if (factorValue=="all") {
command <- paste("import.from.Access('", file, "', data.type='stacked', table='stacked', sitenames='", sitesValue, "',column='", colValue, "',value='", valValue, "')", sep="")
}else{
command <- paste("import.from.Access('", file, "', data.type='stacked', table='stacked', sitenames='", sitesValue, "',column='", colValue, "',value='", valValue, "',factor='", factorValue, "',level='", levelValue, "')", sep="")
}
}
logger(paste(comdsnameValue, " <- ", command, sep=""))
assign(comdsnameValue, justDoIt(command), envir=.GlobalEnv)
communityDataSet(comdsnameValue)
command <- paste("import.from.Access('", file, "', data.type='environmental', table='environmental',sitenames='", sitesValue, "')", sep="")
logger(paste(envdsnameValue, " <- ", command, sep=""))
assign(envdsnameValue, justDoIt(command), envir=.GlobalEnv)
activeDataSet(envdsnameValue)
tkfocus(CommanderWindow())
}
onCancel <- function() {
tkgrab.release(top)
tkfocus(CommanderWindow())
tkdestroy(top)
}
buttonsFrame <- tkframe(top)
onHelp <- function() {
if (.Platform$OS.type != "windows") tkgrab.release(top)
doItAndPrint(paste("help('import.from.Access', help_type='html')", sep=""))
}
helpButton <- tkbutton(buttonsFrame, text="Help", width="12", command=onHelp)
OKbutton <- tkbutton(buttonsFrame, text="OK", width="12", command=onOK, default="active")
cancelButton <- tkbutton(buttonsFrame, text="Cancel", width="12", command=onCancel)
tkgrid(tklabel(optionsFrame, text="Names for new datasets"), sticky="w")
tkgrid(tklabel(optionsFrame, text="Enter name for community data set:"), entrycomDsname, sticky="w")
tkgrid(tklabel(optionsFrame, text="Enter name for environmental data set:"), entryenvDsname, sticky="w")
tkgrid(tklabel(optionsFrame, text="Enter name for variable with sites:"), entrysites, sticky="w")
tkgrid(optionsFrame, sticky="w")
tkgrid(tklabel(stackedFrame, text="Options for stacked data entry"), sticky="w")
tkgrid(tklabel(stackedFrame, text="Import community dataset from stacked format:"), stackedCheckBox, sticky="w")
tkgrid(tklabel(stackedFrame, text="Enter variable for species:"), entrycol, sticky="w")
tkgrid(tklabel(stackedFrame, text="Enter variable for abundance:"), entryval, sticky="w")
tkgrid(tklabel(stackedFrame, text="Enter factor for subset:"), entryfactor, sticky="w")
tkgrid(tklabel(stackedFrame, text="Enter level for subset:"), entrylevel, sticky="w")
tkgrid(stackedFrame, sticky="w")
tkgrid(OKbutton, cancelButton, helpButton)
tkgrid(buttonsFrame, sticky="w")
dialogSuffix(rows=4, columns=1)
}
importfromAccess2007GUI <- function() {
initializeDialog(title="Read Community and Environmental data From Access 2007")
optionsFrame <- tkframe(top, relief="groove", borderwidth=2)
comdsname <- tclVar("CommunityData")
entrycomDsname <- tkentry(optionsFrame, width="20", textvariable=comdsname)
envdsname <- tclVar("EnvironmentalData")
entryenvDsname <- tkentry(optionsFrame, width="20", textvariable=envdsname)
dsites <- tclVar("sites")
entrysites <- tkentry(optionsFrame, width="20", textvariable=dsites)
stackedFrame <- tkframe(top, relief="groove", borderwidth=2)
stackedVariable <- tclVar("0")
stackedCheckBox <- tkcheckbutton(stackedFrame, variable=stackedVariable)
scolumn <- tclVar("species")
entrycol <- tkentry(stackedFrame, width="20", textvariable=scolumn)
sval <- tclVar("abundance")
entryval <- tkentry(stackedFrame, width="20", textvariable=sval)
sfactor <- tclVar("all")
entryfactor <- tkentry(stackedFrame, width="20", textvariable=sfactor)
slevel <- tclVar("all")
entrylevel <- tkentry(stackedFrame, width="20", textvariable=slevel)
onOK <- function(){
closeDialog()
comdsnameValue <- tclvalue(comdsname)
envdsnameValue <- tclvalue(envdsname)
sitesValue <- tclvalue(dsites)
colValue <- tclvalue(scolumn)
valValue <- tclvalue(sval)
factorValue <- tclvalue(sfactor)
levelValue <- tclvalue(slevel)
file <- tclvalue(tkgetOpenFile(filetypes='{"Access Files" {".mdbx" ".MDBX"}} {"All Files" {"*"}}'))
if (file == "") {
if (Rcmdr::getRcmdr("grab.focus")) tkgrab.release(top)
tkdestroy(top)
return()
}
justDoIt(paste("library(RODBC)", sep=""))
logger(paste("library(RODBC)", sep=""))
stacked <- tclvalue(stackedVariable) == "1"
if (stacked==F) {
command <- paste("import.from.Access2007('", file, "', data.type='community', table='community',sitenames='", sitesValue, "')", sep="")
}else{
if (factorValue=="all") {
command <- paste("import.from.Access2007('", file, "', data.type='stacked', table='stacked', sitenames='", sitesValue, "',column='", colValue, "',value='", valValue, "')", sep="")
}else{
command <- paste("import.from.Access2007('", file, "', data.type='stacked', table='stacked', sitenames='", sitesValue, "',column='", colValue, "',value='", valValue, "',factor='", factorValue, "',level='", levelValue, "')", sep="")
}
}
logger(paste(comdsnameValue, " <- ", command, sep=""))
assign(comdsnameValue, justDoIt(command), envir=.GlobalEnv)
communityDataSet(comdsnameValue)
command <- paste("import.from.Access2007('", file, "', data.type='environmental', table='environmental', sitenames='", sitesValue, "')", sep="")
logger(paste(envdsnameValue, " <- ", command, sep=""))
assign(envdsnameValue, justDoIt(command), envir=.GlobalEnv)
activeDataSet(envdsnameValue)
tkfocus(CommanderWindow())
}
onCancel <- function() {
tkgrab.release(top)
tkfocus(CommanderWindow())
tkdestroy(top)
}
buttonsFrame <- tkframe(top)
onHelp <- function() {
if (.Platform$OS.type != "windows") tkgrab.release(top)
doItAndPrint(paste("help('import.from.Access', help_type='html')", sep=""))
}
helpButton <- tkbutton(buttonsFrame, text="Help", width="12", command=onHelp)
OKbutton <- tkbutton(buttonsFrame, text="OK", width="12", command=onOK, default="active")
cancelButton <- tkbutton(buttonsFrame, text="Cancel", width="12", command=onCancel)
tkgrid(tklabel(optionsFrame, text="Names for new datasets"), sticky="w")
tkgrid(tklabel(optionsFrame, text="Enter name for community data set:"), entrycomDsname, sticky="w")
tkgrid(tklabel(optionsFrame, text="Enter name for environmental data set:"), entryenvDsname, sticky="w")
tkgrid(tklabel(optionsFrame, text="Enter name for variable with sites:"), entrysites, sticky="w")
tkgrid(optionsFrame, sticky="w")
tkgrid(tklabel(stackedFrame, text="Options for stacked data entry"), sticky="w")
tkgrid(tklabel(stackedFrame, text="Import community dataset from stacked format:"), stackedCheckBox, sticky="w")
tkgrid(tklabel(stackedFrame, text="Enter variable for species:"), entrycol, sticky="w")
tkgrid(tklabel(stackedFrame, text="Enter variable for abundance:"), entryval, sticky="w")
tkgrid(tklabel(stackedFrame, text="Enter factor for subset:"), entryfactor, sticky="w")
tkgrid(tklabel(stackedFrame, text="Enter level for subset:"), entrylevel, sticky="w")
tkgrid(stackedFrame, sticky="w")
tkgrid(OKbutton, cancelButton, helpButton)
tkgrid(buttonsFrame, sticky="w")
dialogSuffix(rows=4, columns=1)
}
samesitesGUI <- function(){
top <- tktoplevel()
tkwm.title(top, "Same rows for community and environmental")
.activeDataSet <- ActiveDataSet()
.communityDataSet <- CommunityDataSet()
saveFrame <- tkframe(top, relief="groove", borderwidth=2)
saveVariable <- tclVar("1")
saveCheckBox <- tkcheckbutton(saveFrame, variable=saveVariable)
onOK <- function(){
doItAndPrint(paste("check.datasets(", .communityDataSet, ", ", .activeDataSet, ")", sep=""))
sav <- tclvalue(saveVariable) == "1"
if (sav==T) {
DataSet <- eval(parse(text=paste(.communityDataSet, sep="")), envir=.GlobalEnv)
newname <- paste(.communityDataSet, ".orig", sep="")
logger(paste(newname, " <- ", .communityDataSet, sep=""))
assign(newname,DataSet, envir=.GlobalEnv)
}
logger(paste(.communityDataSet, " <- ", "same.sites(", .communityDataSet, ", " , .activeDataSet, ")", sep=""))
assign(.communityDataSet, justDoIt(paste("same.sites(", .communityDataSet, ", ", .activeDataSet, ")", sep="")), envir=.GlobalEnv)
communityDataSet(.communityDataSet)
}
onCancel <- function() {
tkgrab.release(top)
tkfocus(CommanderWindow())
tkdestroy(top)
}
buttonsFrame <- tkframe(top)
onHelp <- function() {
if (.Platform$OS.type != "windows") tkgrab.release(top)
doItAndPrint(paste("help('same.sites', help_type='html')", sep=""))
}
helpButton <- tkbutton(buttonsFrame, text="Help", width="12", command=onHelp)
OKbutton <- tkbutton(buttonsFrame, text="OK", width="12", command=onOK, default="active")
cancelButton <- tkbutton(buttonsFrame, text="Cancel", width="12", command=onCancel)
tkgrid(saveCheckBox, tklabel(saveFrame, text="save original community matrix"), sticky="w")
tkgrid(saveFrame, sticky="w")
tkgrid(OKbutton, cancelButton, helpButton)
tkgrid(buttonsFrame, sticky="w")
for (row in 0:6) tkgrid.rowconfigure(top, row, weight=0)
for (col in 0:0) tkgrid.columnconfigure(top, col, weight=0)
.Tcl("update idletasks")
tkwm.resizable(top, 0, 0)
tkwm.deiconify(top)
tkgrab.set(top)
tkwait.window(top)
}
removezeroes <- function(){
.communityDataSet <- CommunityDataSet()
command <- paste("removezerospecies(", .communityDataSet, ")", sep="")
logger(paste(.communityDataSet, " <- ", command, sep=""))
assign(.communityDataSet, justDoIt(command), envir=.GlobalEnv)
communityDataSet(.communityDataSet)
invisible()
}
replaceNAs <- function(){
.communityDataSet <- CommunityDataSet()
command <- paste("replaceNAcomm(", .communityDataSet, ")", sep="")
logger(paste(.communityDataSet, " <- ", command, sep=""))
assign(.communityDataSet, justDoIt(command), envir=.GlobalEnv)
communityDataSet(.communityDataSet)
invisible()
}
vegemite.table <- function(){
.communityDataSet <- CommunityDataSet()
command <- paste("vegemite(", .communityDataSet, ", use=cca(", .communityDataSet, "), scale='Braun.Blanquet')", sep="")
doItAndPrint(paste(command))
}
tabasco.table <- function(){
.communityDataSet <- CommunityDataSet()
command <- paste("tabasco(", .communityDataSet, ", use=cca(", .communityDataSet, "))", sep="")
doItAndPrint(paste(command))
}
beals.smoothing <- function(){
.communityDataSet <- CommunityDataSet()
command <- paste("beals(", .communityDataSet, ", include=F)", sep="")
doItAndPrint(paste(command))
}
ind.power <- function(){
.communityDataSet <- CommunityDataSet()
command <- paste("indpower(", .communityDataSet, ", type=0)", sep="")
doItAndPrint(paste(command))
}
nested.checks <- function(){
.communityDataSet <- CommunityDataSet()
doItAndPrint(paste("nestedchecker(", .communityDataSet, ")", sep=""))
doItAndPrint(paste("nestedtemp(", .communityDataSet, ")", sep=""))
doItAndPrint(paste("nestednodf(", .communityDataSet, ")", sep=""))
doItAndPrint(paste("nestedbetasor(", .communityDataSet, ")", sep=""))
doItAndPrint(paste("nestedbetajac(", .communityDataSet, ")", sep=""))
}
#viewcommunity <- function(){
# command <- justDoIt(paste("invisible(edit(", communityDataSet(), "))", sep=""))
#}
#editcommunity <- function(){
# .communityDataSet <- CommunityDataSet()
# justDoIt(paste("fix(", .communityDataSet, ")", sep=""))
# communityDataSet(.communityDataSet)
# invisible()
#}
# view based on R-Commander View button
viewcommunity <- function(){
# if (packageAvailable("relimp")) Library("relimp", rmd=FALSE)
if (communityDataSet() == FALSE) {
tkfocus(CommanderWindow())
return()
}
suppress <- if(getRcmdr("suppress.X11.warnings")) ", suppress.X11.warnings=FALSE" else ""
view.height <- max(getRcmdr("output.height") + getRcmdr("log.height"), 10)
dim <- dim(get(CommunityDataSet()))
nrows <- dim[1]
ncols <- dim[2]
threshold <- getRcmdr("showData.threshold")
command <- if (nrows <= threshold[1] && ncols <= threshold[2]){
paste("showData(", CommunityDataSet(), ", placement='-20+200', font=getRcmdr('logFont'), maxwidth=",
getRcmdr("log.width"), ", maxheight=", view.height, suppress, ")", sep="")
}
else paste("View(", CommunityDataSet(), ")", sep="")
window <- justDoIt(command)
if (!is.null(window)){
open.showData.windows <- getRcmdr("open.showData.windows")
open.window <- open.showData.windows[[CommunityDataSet()]]
if (!is.null(open.window)) tkdestroy(open.window)
open.showData.windows[[CommunityDataSet()]] <- window
putRcmdr("open.showData.windows", open.showData.windows)
}
}
# edit based on R-Commander Edit button
editcommunity <- function(){
if (communityDataSet() == FALSE) {
tkfocus(CommanderWindow())
return()
}
dsnameValue <- CommunityDataSet()
size <- eval(parse(text=paste("prod(dim(", dsnameValue, "))", sep=""))) # prod(dim(save.dataset))
if (size < 1 || size > getRcmdr("editDataset.threshold")){
save.dataset <- get(dsnameValue, envir=.GlobalEnv)
command <- paste("fix(", dsnameValue, ")", sep="")
result <- justDoIt(command)
if (class(result)[1] != "try-error"){
if (nrow(get(dsnameValue)) == 0){
errorCondition(window=NULL, message=gettextRcmdr("empty data set."))
justDoIt(paste(dsnameValue, "<- save.dataset"))
return()
}
else{
logger(command, rmd=FALSE)
communityDataSet(dsnameValue)
}
}
else{
errorCondition(window=NULL, message=gettextRcmdr("data set edit error."))
return()
}
}
else {
command <- paste("editDataset(", dsnameValue, ")", sep="")
result <- justDoIt(command)
if (class(result)[1] != "try-error"){
logger(command, rmd=FALSE)
}
else{
errorCondition(window=NULL, message=gettextRcmdr("data set edit error."))
return()
}
}
tkwm.deiconify(CommanderWindow())
tkfocus(CommanderWindow())
}
#viewenvironmental <- function(){
# justDoIt(paste("invisible(edit(", ActiveDataSet(), "))", sep=""))
#}
#editenvironmental <- function(){
# .activeDataSet <- ActiveDataSet()
# justDoIt(paste("fix(", .activeDataSet, ")", sep=""))
# activeDataSet(.activeDataSet)
# invisible()
#}
# environmental view same as for R-Commander View button
viewenvironmental <- function(){
# if (packageAvailable("relimp")) Library("relimp", rmd=FALSE)
if (activeDataSet() == FALSE) {
tkfocus(CommanderWindow())
return()
}
suppress <- if(getRcmdr("suppress.X11.warnings")) ", suppress.X11.warnings=FALSE" else ""
view.height <- max(getRcmdr("output.height") + getRcmdr("log.height"), 10)
dim <- dim(get(ActiveDataSet()))
nrows <- dim[1]
ncols <- dim[2]
threshold <- getRcmdr("showData.threshold")
command <- if (nrows <= threshold[1] && ncols <= threshold[2]){
paste("showData(", ActiveDataSet(), ", placement='-20+200', font=getRcmdr('logFont'), maxwidth=",
getRcmdr("log.width"), ", maxheight=", view.height, suppress, ")", sep="")
}
else paste("View(", ActiveDataSet(), ")", sep="")
window <- justDoIt(command)
if (!is.null(window)){
open.showData.windows <- getRcmdr("open.showData.windows")
open.window <- open.showData.windows[[ActiveDataSet()]]
if (!is.null(open.window)) tkdestroy(open.window)
open.showData.windows[[ActiveDataSet()]] <- window
putRcmdr("open.showData.windows", open.showData.windows)
}
}
# environmental edit same for as for R-Commander Edit button
editenvironmental <- function(){
if (activeDataSet() == FALSE) {
tkfocus(CommanderWindow())
return()
}
dsnameValue <- ActiveDataSet()
size <- eval(parse(text=paste("prod(dim(", dsnameValue, "))", sep=""))) # prod(dim(save.dataset))
if (size < 1 || size > getRcmdr("editDataset.threshold")){
save.dataset <- get(dsnameValue, envir=.GlobalEnv)
command <- paste("fix(", dsnameValue, ")", sep="")
result <- justDoIt(command)
if (class(result)[1] != "try-error"){
if (nrow(get(dsnameValue)) == 0){
errorCondition(window=NULL, message=gettextRcmdr("empty data set."))
justDoIt(paste(dsnameValue, "<- save.dataset"))
return()
}
else{
logger(command, rmd=FALSE)
activeDataSet(dsnameValue)
}
}
else{
errorCondition(window=NULL, message=gettextRcmdr("data set edit error."))
return()
}
}
else {
command <- paste("editDataset(", dsnameValue, ")", sep="")
result <- justDoIt(command)
if (class(result)[1] != "try-error"){
logger(command, rmd=FALSE)
}
else{
errorCondition(window=NULL, message=gettextRcmdr("data set edit error."))
return()
}
}
tkwm.deiconify(CommanderWindow())
tkfocus(CommanderWindow())
}
checkdatasets <- function(){
.activeDataSet <- ActiveDataSet()
.communityDataSet <- CommunityDataSet()
doItAndPrint(paste("check.datasets(", .communityDataSet, ", ", .activeDataSet, ")", sep=""))
}
removeNAGUI <- function(){
top <- tktoplevel()
tkwm.title(top, "remove NA cases")
.activeDataSet <- ActiveDataSet()
.communityDataSet <- CommunityDataSet()
.variables <- Variables()
variables <- paste(.variables, ifelse(is.element(.variables, Factors()), "[factor]", ""))
varFrame <- tkframe(top, relief="groove", borderwidth=2)
subsetBox <- tklistbox(varFrame, width=27, height=7,
selectmode="single", background="white", exportselection="FALSE")
subsetScroll <- tkscrollbar(varFrame, repeatinterval=5, command=function(...) tkyview(subsetBox, ...))
tkconfigure(subsetBox, yscrollcommand=function(...) tkset(subsetScroll, ...))
for (x in variables) tkinsert(subsetBox, "end", x)
onOK <- function(){
doItAndPrint(paste("check.datasets(", .communityDataSet, ", ", .activeDataSet, ")", sep=""))
var <- .variables[as.numeric(tkcurselection(subsetBox))+1]
command <- paste("removeNAcomm(", .communityDataSet, ", ", .activeDataSet, ",'", var, "')", sep="")
logger(paste(.communityDataSet, " <- ", command, sep=""))
assign(.communityDataSet, justDoIt(command), envir=.GlobalEnv)
command <- paste("removezerospecies(", .communityDataSet, ")", sep="")
logger(paste(.communityDataSet, " <- ", command, sep=""))
assign(.communityDataSet, justDoIt(command), envir=.GlobalEnv)
command <- paste("removeNAenv(", .activeDataSet, ",'", var, "')", sep="")
logger(paste(.activeDataSet, " <- ", command, sep=""))
assign(.activeDataSet, justDoIt(command), envir=.GlobalEnv)
activeDataSet(.activeDataSet)
communityDataSet(.communityDataSet)
}
onCancel <- function() {
tkgrab.release(top)
tkfocus(CommanderWindow())
tkdestroy(top)
}
buttonsFrame <- tkframe(top)
OKbutton <- tkbutton(buttonsFrame, text="OK", width="12", command=onOK, default="active")
cancelButton <- tkbutton(buttonsFrame, text="Cancel", width="12", command=onCancel)
tkgrid(tklabel(varFrame, text="Select variable"), sticky="w")
tkgrid(subsetBox, subsetScroll, sticky="w")
tkgrid(varFrame, sticky="w")
tkgrid(OKbutton, tklabel(buttonsFrame, text=" "), cancelButton)
tkgrid(buttonsFrame, sticky="w")
tkgrid.configure(subsetScroll, sticky="ns")
tkselection.set(subsetBox, 0)
for (row in 0:6) tkgrid.rowconfigure(top, row, weight=0)
for (col in 0:0) tkgrid.columnconfigure(top, col, weight=0)
.Tcl("update idletasks")
tkwm.resizable(top, 0, 0)
tkwm.deiconify(top)
tkgrab.set(top)
tkfocus(subsetBox)
tkwait.window(top)
}
disttransGUI <- function(){
top <- tktoplevel()
tkwm.title(top, "Community matrix transformation")
.activeDataSet <- ActiveDataSet()
.communityDataSet <- CommunityDataSet()
methodFrame <- tkframe(top, relief="groove", borderwidth=2)
methodBox <- tklistbox(methodFrame, width=50, height=5,
selectmode="single", background="white", exportselection="FALSE")
methodScroll <- tkscrollbar(methodFrame, repeatinterval=5, command=function(...) tkyview(methodBox, ...))
tkconfigure(methodBox, yscrollcommand=function(...) tkset(methodScroll, ...))
methods <- c("hellinger", "chord", "profiles", "chi.square", "log", "square", "pa",
"Braun.Blanquet", "Domin", "Hult", "Hill", "fix", "coverscale.log", "dispweight")
for (x in methods) tkinsert(methodBox, "end", x)
saveFrame <- tkframe(top, relief="groove", borderwidth=2)
saveVariable <- tclVar("1")
saveCheckBox <- tkcheckbutton(saveFrame, variable=saveVariable)
onOK <- function(){
method <- methods[as.numeric(tkcurselection(methodBox))+1]
sav <- tclvalue(saveVariable) == "1"
if (sav==T) {
DataSet <- eval(parse(text=paste(.communityDataSet, sep="")), envir=.GlobalEnv)
newname <- paste(.communityDataSet, ".orig", sep="")
logger(paste(newname, " <- ", .communityDataSet, sep=""))
assign(newname,DataSet, envir=.GlobalEnv)
}
logger(paste(.communityDataSet, " <- ", "disttransform(", .communityDataSet, ", method='", method, "')", sep=""))
assign(.communityDataSet, justDoIt(paste("disttransform(", .communityDataSet, ", method='", method, "')", sep="")), envir=.GlobalEnv)
communityDataSet(.communityDataSet)
}
onCancel <- function() {
tkgrab.release(top)
tkfocus(CommanderWindow())
tkdestroy(top)
}
buttonsFrame <- tkframe(top)
OKbutton <- tkbutton(buttonsFrame, text="OK", width="12", command=onOK, default="active")
cancelButton <- tkbutton(buttonsFrame, text="Cancel", width="12", command=onCancel)
tkgrid(tklabel(methodFrame, text="Method"), sticky="w")
tkgrid(methodBox, methodScroll,sticky="w")
tkgrid(methodFrame, sticky="w")
tkgrid(saveCheckBox, tklabel(saveFrame, text="save original community matrix"), sticky="w")
tkgrid(saveFrame, sticky="w")
tkgrid(OKbutton, cancelButton)
tkgrid(buttonsFrame, sticky="w")
tkgrid.configure(methodScroll, sticky="ns")
tkselection.set(methodBox, 0)
for (row in 0:6) tkgrid.rowconfigure(top, row, weight=0)
for (col in 0:0) tkgrid.columnconfigure(top, col, weight=0)
.Tcl("update idletasks")
tkwm.resizable(top, 0, 0)
tkwm.deiconify(top)
tkgrab.set(top)
tkfocus(methodBox)
tkwait.window(top)
}
# BiodiversityR 2.3 reload .activeDataSet
envirosummaryGUI <- function(){
top <- tktoplevel()
tkwm.title(top, "Summary of environmental variables")
.activeDataSet <- ActiveDataSet()
.variables <- Variables()
variables <- paste(.variables, ifelse(is.element(.variables, Factors()), "[factor]", ""))
varFrame <- tkframe(top, relief="groove", borderwidth=2)
subsetBox <- tklistbox(varFrame, width=27, height=7,
selectmode="single", background="white", exportselection="FALSE")
subsetScroll <- tkscrollbar(varFrame, repeatinterval=5, command=function(...) tkyview(subsetBox, ...))
tkconfigure(subsetBox, yscrollcommand=function(...) tkset(subsetScroll, ...))
variables <- c("all",variables)
for (x in variables) tkinsert(subsetBox, "end", x)
onOK <- function(){
var <- variables[as.numeric(tkcurselection(subsetBox))+1]
if (var == "all") {
doItAndPrint(paste("summary(", .activeDataSet, ")", sep=""))
doItAndPrint(paste("str(", .activeDataSet, ")", sep=""))
}else{
var <- .variables[as.numeric(tkcurselection(subsetBox))]
doItAndPrint(paste("summary(", .activeDataSet, "$", var, ")", sep=""))
}
}
onPlot <- function(){
var <- variables[as.numeric(tkcurselection(subsetBox))+1]
if (var == "all") {
doItAndPrint(paste("pairs(", .activeDataSet, ")", sep=""))
}else{
var <- .variables[as.numeric(tkcurselection(subsetBox))]
varfactor <- eval(parse(text=paste("is.factor(", .activeDataSet, "$", var, ")", sep="")), envir=.GlobalEnv)
if (varfactor==T) {
doItAndPrint(paste("plot(", .activeDataSet, "$", var,",xlab='", var, "',ylab='n')",sep=""))
}else{
doItAndPrint(paste("boxplot(", .activeDataSet, "$", var,",xlab='", var, "')", sep=""))
doItAndPrint(paste("points(mean(", .activeDataSet, "$", var,"), pch=19, cex=1.5)",sep=""))
}
}
}
onCancel <- function() {
tkgrab.release(top)
tkfocus(CommanderWindow())
tkdestroy(top)
}
buttonsFrame <- tkframe(top)
OKbutton <- tkbutton(buttonsFrame, text="OK", width="12", command=onOK, default="active")
plotButton <- tkbutton(buttonsFrame, text="Plot", width="12", command=onPlot)
cancelButton <- tkbutton(buttonsFrame, text="Cancel", width="12", command=onCancel)
tkgrid(tklabel(varFrame, text="Select variable"), sticky="w")
tkgrid(subsetBox, subsetScroll, sticky="w")
tkgrid(varFrame, sticky="w")
tkgrid(OKbutton, plotButton, tklabel(buttonsFrame, text=" "), cancelButton)
tkgrid(buttonsFrame, sticky="w")
tkgrid.configure(subsetScroll, sticky="ns")
tkselection.set(subsetBox, 0)
for (row in 0:6) tkgrid.rowconfigure(top, row, weight=0)
for (col in 0:0) tkgrid.columnconfigure(top, col, weight=0)
.Tcl("update idletasks")
tkwm.resizable(top, 0, 0)
tkwm.deiconify(top)
tkgrab.set(top)
tkfocus(subsetBox)
tkwait.window(top)
}
boxcoxGUI <- function(){
top <- tktoplevel()
tkwm.title(top, "Box-Cox transformation")
.activeDataSet <- ActiveDataSet()
.variables <- Variables()
variables <- paste(.variables, ifelse(is.element(.variables, Factors()), "[factor]", ""))
varFrame <- tkframe(top, relief="groove", borderwidth=2)
subsetBox <- tklistbox(varFrame, width=27, height=7,
selectmode="single", background="white", exportselection="FALSE")
subsetScroll <- tkscrollbar(varFrame, repeatinterval=5, command=function(...) tkyview(subsetBox, ...))
tkconfigure(subsetBox, yscrollcommand=function(...) tkset(subsetScroll, ...))
for (x in variables) tkinsert(subsetBox, "end", x)
onOK <- function(){
var <- .variables[as.numeric(tkcurselection(subsetBox))+1]
doItAndPrint(paste("par(mfrow=c(1,2))", sep=""))
doItAndPrint(paste("qqPlot(", .activeDataSet, "$", var, ")", sep=""))
doItAndPrint(paste("shapiro.test(", .activeDataSet, "$", var, ")", sep=""))
doItAndPrint(paste("ks.test(", .activeDataSet, "$", var, ",pnorm)", sep=""))
doItAndPrint(paste("summary(powerTransform(na.omit(", .activeDataSet, ")$", var, "))", sep=""))
justDoIt(paste(.activeDataSet, "$", var, ".boxcox <- ", .activeDataSet, "$", var, "^ powerTransform(na.omit(", .activeDataSet, ")$", var, ")$lambda", sep=""))
logger(paste(.activeDataSet, "$", var, ".boxcox <- ", .activeDataSet, "$", var, "^ powerTransform(na.omit(", .activeDataSet, ")$", var, ")$lambda", sep=""))
activeDataSet(.activeDataSet)
doItAndPrint(paste("qqPlot(", .activeDataSet, "$", var, ".boxcox)", sep=""))
doItAndPrint(paste("shapiro.test(", .activeDataSet, "$", var, ".boxcox)", sep=""))
doItAndPrint(paste("ks.test(", .activeDataSet, "$", var, ".boxcox, pnorm)", sep=""))
doItAndPrint(paste("par(mfrow=c(1,1))", sep=""))
}
onCancel <- function() {
tkgrab.release(top)
tkfocus(CommanderWindow())
tkdestroy(top)
}
buttonsFrame <- tkframe(top)
OKbutton <- tkbutton(buttonsFrame, text="OK", width="12", command=onOK, default="active")
cancelButton <- tkbutton(buttonsFrame, text="Cancel", width="12", command=onCancel)
tkgrid(tklabel(varFrame, text="Select variable"), sticky="w")
tkgrid(subsetBox, subsetScroll, sticky="w")
tkgrid(varFrame, sticky="w")
tkgrid(OKbutton, tklabel(buttonsFrame, text=" "), cancelButton)
tkgrid(buttonsFrame, sticky="w")
tkgrid.configure(subsetScroll, sticky="ns")
tkselection.set(subsetBox, 0)
for (row in 0:6) tkgrid.rowconfigure(top, row, weight=0)
for (col in 0:0) tkgrid.columnconfigure(top, col, weight=0)
.Tcl("update idletasks")
tkwm.resizable(top, 0, 0)
tkwm.deiconify(top)
tkgrab.set(top)
tkfocus(subsetBox)
tkwait.window(top)
}
accumGUI <- function(){
top <- tktoplevel()
tkwm.title(top, "Species accumulation curves")
.activeDataSet <- ActiveDataSet()
.communityDataSet <- CommunityDataSet()
.variables <- Factors()
variables <- paste(.variables, ifelse(is.element(.variables, Factors()), "[factor]", ""))
.svariables <- Numeric()
svariables <- paste(.svariables)
.cvariables <- CVariables()
cvariables <- paste(.cvariables)
modelName <- tclVar("Accum.1")
modelFrame <- tkframe(top, relief="groove", borderwidth=2)
model <- tkentry(modelFrame, width=40, textvariable=modelName)
choicesFrame <- tkframe(top, relief="groove", borderwidth=2)
methodFrame <- tkframe(choicesFrame)
method1Frame <- tkframe(methodFrame)
method2Frame <- tkframe(methodFrame)
methodBox <- tklistbox(method1Frame, width=27, height=5,
selectmode="single", background="white", exportselection="FALSE")
methodScroll <- tkscrollbar(method1Frame, repeatinterval=5, command=function(...) tkyview(methodBox, ...))
tkconfigure(methodBox, yscrollcommand=function(...) tkset(methodScroll, ...))
methods <- c("exact", "exact (unconditioned)", "random", "rarefaction", "coleman", "collector",
"arrhenius", "gleason", "gitay", "lomolino", "asymp", "gompertz", "michaelis-menten", "logis", "weibull",
"specslope", "poolaccum", "estaccumR", "rarefy", "drarefy", "rareslope", "rarecurve")
permVariable <- tclVar("999")
permutation <- tkentry(method2Frame, width=10, textvariable=permVariable)
for (x in methods) tkinsert(methodBox, "end", x)
optionFrame <- tkframe(choicesFrame)
ggplotVariable <- tclVar("0")
ggplotCheckBox <- tkcheckbutton(optionFrame, variable=ggplotVariable)
addVariable <- tclVar("0")
addCheckBox <- tkcheckbutton(optionFrame, variable=addVariable)
xlist <- tclVar("")
xEntry <- tkentry(optionFrame, width=10, textvariable=xlist)
ylist <- tclVar("")
yEntry <- tkentry(optionFrame, width=10, textvariable=ylist)
symbol <- tclVar("1")
symbolEntry <- tkentry(optionFrame, width=10, textvariable=symbol)
cia <- tclVar("2")
ciEntry <- tkentry(optionFrame, width=10, textvariable=cia)
cexa <- tclVar("1")
cexEntry <- tkentry(optionFrame, width=10, textvariable=cexa)
colour <- tclVar("blue")
colourEntry <- tkentry(optionFrame, width=10, textvariable=colour)
option2Frame <- tkframe(choicesFrame)
scaleBox <- tklistbox(option2Frame, width=27, height=6,
selectmode="single", background="white", exportselection="FALSE")
scaleScroll <- tkscrollbar(option2Frame, repeatinterval=5, command=function(...) tkyview(scaleBox, ...))
tkconfigure(scaleBox, yscrollcommand=function(...) tkset(scaleScroll, ...))
svariables <- c("sites",svariables)
for (x in svariables) tkinsert(scaleBox, "end", x)
subsetFrame <- tkframe(choicesFrame)
subset1Frame <- tkframe(subsetFrame)
subset2Frame <- tkframe(subsetFrame)
subsetBox <- tklistbox(subset1Frame, width=27, height=8,
selectmode="single", background="white", exportselection="FALSE")
subsetScroll <- tkscrollbar(subset1Frame, repeatinterval=5, command=function(...) tkyview(subsetBox, ...))
tkconfigure(subsetBox, yscrollcommand=function(...) tkset(subsetScroll, ...))
variables <- c("all",variables)
for (x in variables) tkinsert(subsetBox, "end", x)
subset <- tclVar(".")
subsetEntry <- tkentry(subset2Frame, width=10, textvariable=subset)
onOK <- function(){
doItAndPrint(paste("check.datasets(", .communityDataSet, ", ", .activeDataSet, ")", sep=""))
modelValue <- tclvalue(modelName)
method <- methods[as.numeric(tkcurselection(methodBox))+1]
var <- variables[as.numeric(tkcurselection(subsetBox))+1]
sub <- tclvalue(subset)
xlim <- tclvalue(xlist)
if (xlim != "") {xlim <- paste(", xlim=c(", xlim, ")", sep="")}
ylim <- tclvalue(ylist)
if (ylim != "") {ylim <- paste(", ylim=c(", ylim, ")", sep="")}
perm <- as.numeric(tclvalue(permVariable))
ci <- tclvalue(cia)
cex <- tclvalue(cexa)
var2 <- svariables[as.numeric(tkcurselection(scaleBox))+1]
col <- tclvalue(colour)
if (var2 == "sites") {
scale <- paste(", scale=''", sep="")
xlab <- paste(", xlab='sites'", sep="")
}else{
var2 <- .svariables[as.numeric(tkcurselection(scaleBox))]
scale <- paste(", scale='", var2, "'", sep="")
xlab <- paste(", xlab='", var2, "'", sep="")
}
if (method %in% c("exact", "exact (unconditioned)", "random", "rarefaction", "coleman", "collector")) {
if (var == "all") {
if (method == "exact (unconditioned)") {
command <- paste("accumresult(", .communityDataSet, ", y=", .activeDataSet, ", method='exact', conditioned =F, gamma = 'boot', permutations=", perm, scale, ")", sep="")
}else{
command <- paste("accumresult(", .communityDataSet, ", y=", .activeDataSet, ", method='", method, "', conditioned =T, gamma = 'boot', permutations=", perm, scale, ")", sep="")
}
}else{
var <- .variables[as.numeric(tkcurselection(subsetBox))]
if (sub == ".") {
if (method == "exact (unconditioned)") {
command <- paste("accumcomp(", .communityDataSet, ", y=", .activeDataSet, ", factor='", var, "', method='exact', conditioned =F, gamma = 'boot', permutations=", perm, ", legend=F, rainbow=T, ci=", ci, ", ci.type='bar', cex=", cex, xlab, xlim, ylim, scale, ", cex.lab=0.9, cex.axis=0.7)", sep="")
}else{
command <- paste("accumcomp(", .communityDataSet, ", y=", .activeDataSet, ", factor='", var, "', method='", method, "', conditioned =T, gamma = 'boot', permutations=", perm, ", legend=F, rainbow=T, ci=", ci, ", ci.type='bar', cex=", cex, xlab, xlim, ylim, scale, ", cex.lab=0.9, cex.axis=0.7)", sep="")
}
}else{
if (method == "exact (unconditioned)") {
command <- paste("accumresult(", .communityDataSet, ", y=", .activeDataSet, ", factor='", var, "', level='", sub, "', method='exact', conditioned =F, gamma = 'boot' , permutations=", perm , scale, ")", sep="")
}else{
command <- paste("accumresult(", .communityDataSet, ", y=", .activeDataSet, ", factor='", var, "', level='", sub, "', method='", method, "', conditioned =T, gamma = 'boot' , permutations=", perm , scale, ")", sep="")
}
}
}
}
if (method == "arrhenius") {
command <- paste("fitspecaccum(specaccum(", .communityDataSet, ", method='exact'), model='arrhenius')", sep="")
}
if (method == "gleason") {
command <- paste("fitspecaccum(specaccum(", .communityDataSet, ", method='exact'), model='gleason')", sep="")
}
if (method == "gitay") {
command <- paste("fitspecaccum(specaccum(", .communityDataSet, ", method='exact'), model='gleason')", sep="")
}
if (method == "lomolino") {
command <- paste("fitspecaccum(specaccum(", .communityDataSet, ", method='exact'), model='lomolino')", sep="")
}
if (method == "asymp") {
command <- paste("fitspecaccum(specaccum(", .communityDataSet, ", method='exact'), model='asymp')", sep="")
}
if (method == "gompertz") {
command <- paste("fitspecaccum(specaccum(", .communityDataSet, ", method='exact'), model='gompertz')", sep="")
}
if (method == "michaelis-menten") {
command <- paste("fitspecaccum(specaccum(", .communityDataSet, ", method='exact'), model='michaelis-menten')", sep="")
}
if (method == "logis") {
command <- paste("fitspecaccum(specaccum(", .communityDataSet, ", method='exact'), model='logis')", sep="")
}
if (method == "weibull") {
command <- paste("fitspecaccum(specaccum(", .communityDataSet, ", method='exact'), model='weibull')", sep="")
}
if (method == "specslope") {
command <- paste("specslope(specaccum(", .communityDataSet, ", method='exact'), at=5)", sep="")
}
if (method == "poolaccum") {
command <- paste("poolaccum(", .communityDataSet, ", permutations=", perm, ", minsize=2)", sep="")
}
if (method == "estaccumR") {
command <- paste("estaccumR(", .communityDataSet, ", permutations=", perm, ")", sep="")
}
if (method == "rarefy") {
command <- paste("rarefy(", .communityDataSet, ", sample=min(rowSums(", .communityDataSet, ")))", sep="")
}
if (method == "drarefy") {
command <- paste("drarefy(", .communityDataSet, ", sample=min(rowSums(", .communityDataSet, ")))", sep="")
}
if (method == "rareslope") {
command <- paste("rareslope(", .communityDataSet, ", sample=min(rowSums(", .communityDataSet, ")))", sep="")
}
if (method == "rarecurve") {
command <- paste("rarecurve(", .communityDataSet, ", sample=min(rowSums(", .communityDataSet, ")), col='", col, "')", sep="")
}
logger(paste(modelValue, " <- ", command, sep=""))
assign(modelValue, justDoIt(command), envir=.GlobalEnv)
doItAndPrint(paste(modelValue))
if (method %in% c("arrhenius", "gleason", "gitay", "lomolino", "asymp", "gompertz", "michaelis-menten", "logis", "weibull")){
doItAndPrint(paste("coef(", modelValue, ")", sep=""))
doItAndPrint(paste("fitted(", modelValue, ")", sep=""))
}
}
onPlot <- function(){
modelValue <- tclvalue(modelName)
method <- methods[as.numeric(tkcurselection(methodBox))+1]
ggplotit <- tclvalue(ggplotVariable) == "1"
if (ggplotit==T) {
logger(paste(" "))
logger(paste("Please note that plotting requires a result from function 'accumcomp'."))
logger(paste("Such results are obtained when selecting a factor from the Subset options."))
logger(paste(" "))
justDoIt(paste("library(ggplot2)", sep=""))
logger(paste("library(ggplot2)", sep=""))
doItAndPrint("BioR.theme <- theme(panel.background = element_blank(), panel.border = element_blank(), panel.grid = element_blank(), axis.line = element_line('gray25'), text = element_text(size = 12), axis.text = element_text(size = 10, colour = 'gray25'), axis.title = element_text(size = 14, colour = 'gray25'), legend.title = element_text(size = 14), legend.text = element_text(size = 14), legend.key = element_blank() )")
doItAndPrint(paste("plotgg1 <- ggplot(data=accumcomp.long(", modelValue, "), aes(x = Sites, y = Richness, ymax = UPR, ymin= LWR)) + scale_x_continuous(expand=c(0, 1), sec.axis = dup_axis(labels=NULL, name=NULL)) + scale_y_continuous(sec.axis = dup_axis(labels=NULL, name=NULL)) + geom_line(aes(colour=Grouping), size=2) + geom_point(aes(colour=Grouping, shape=Grouping), size=5) + geom_ribbon(aes(colour=Grouping), alpha=0.2, show.legend=FALSE) + BioR.theme + scale_color_brewer(palette = 'Set1') + labs(x = 'Sites', y = 'Species', colour = 'Factor', shape= 'Factor')", sep=""))
doItAndPrint("plotgg1")
}else{
addit <- tclvalue(addVariable) == "1"
xlim <- tclvalue(xlist)
if (xlim != "") {xlim <- paste(", xlim=c(", xlim, ")", sep="")}
ylim <- tclvalue(ylist)
if (ylim != "") {ylim <- paste(", ylim=c(", ylim, ")", sep="")}
pch <- tclvalue(symbol)
ci <- tclvalue(cia)
cex <- tclvalue(cexa)
col <- tclvalue(colour)
sub <- tclvalue(subset)
if (sub == ".") {sub <- ""}
var2 <- svariables[as.numeric(tkcurselection(scaleBox))+1]
if (var2 == "sites") {
xlab <- paste(", xlab='sites'", sep="")
}else{
xlab <- paste(", xlab='", var2, "'", sep="")
}
if (method %in% c("exact", "exact (unconditioned)", "random", "rarefaction", "coleman", "collector")) {
doItAndPrint(paste("accumplot(", modelValue, ", addit=", addit, ", col='", col, "', ci=", ci, ", , ci.col='black', ci.lty=3, ci.length=0.1, cex=", cex, xlab, ", ylab='species richness'", xlim, ylim, ", pch=", pch, ", labels='", sub ,"', cex.lab=0.9, cex.axis=0.7)", sep=""))
}
if (method %in% c("poolaccum", "estaccumR")) {
doItAndPrint(paste("plot(", modelValue, ")", sep=""))
}
if (method %in% c("arrhenius", "gleason", "gitay", "lomolino", "asymp", "gompertz", "michaelis-menten", "logis", "weibull")){
if (addit == F) {
doItAndPrint(paste("plot(", modelValue, "$richness ~ Accum.1$sites, col='black', cex=", cex, xlab, ", ylab='species richness'", xlim, ylim, ", pch=1)", sep=""))
doItAndPrint(paste("points(fitted(", modelValue, ") ~ Accum.1$sites, col='", col, "', pch=", pch, ")", sep=""))
}else{
doItAndPrint(paste("points(fitted(", modelValue, ") ~ Accum.1$sites, col='", col, "', pch=", pch, ")", sep=""))
}
}
if (method %in% c("rarefy", "drarefy", "rareslope", "rarecurve")) {
doItAndPrint(paste("rarecurve(", .communityDataSet, ", sample=min(rowSums(", .communityDataSet, ")), col='", col, "')", sep=""))
}
} # ggplotit
activateMenus()
tkfocus(CommanderWindow())
}
onCancel <- function() {
tkgrab.release(top)
tkfocus(CommanderWindow())
tkdestroy(top)
}
buttonsFrame <- tkframe(top)
onHelp <- function() {
if (.Platform$OS.type != "windows") tkgrab.release(top)
doItAndPrint(paste("help('accumresult', help_type='html')", sep=""))
}
helpButton <- tkbutton(buttonsFrame, text="Help", width="12", command=onHelp)
OKbutton <- tkbutton(buttonsFrame, text="OK", width="12", command=onOK, default="active")
plotButton <- tkbutton(buttonsFrame, text="Plot", width="12", command=onPlot)
cancelButton <- tkbutton(buttonsFrame, text="Cancel", width="12", command=onCancel)
tkgrid(tklabel(modelFrame, text="Save result as: ", width=15), model, sticky="w")
tkgrid(modelFrame, sticky="w")
tkgrid(tklabel(method1Frame, text="Accumulation method"), sticky="w")
tkgrid(methodBox, methodScroll,sticky="w")
tkgrid(tklabel(method2Frame, text="permutations", width=10), permutation, sticky="w")
tkgrid(method1Frame, sticky="w")
tkgrid(method2Frame, sticky="w")
tkgrid(tklabel(option2Frame, text="scale of x axis"), sticky="w")
tkgrid(scaleBox, scaleScroll, sticky="w")
tkgrid(tklabel(subsetFrame, text="Subset options"), sticky="w")
tkgrid(subsetBox, subsetScroll, sticky="w")
tkgrid(tklabel(subset2Frame, text="subset: ", width=15), subsetEntry, sticky="w")
tkgrid(subset1Frame, sticky="w")
tkgrid(subset2Frame, sticky="w")
tkgrid(tklabel(optionFrame, text="Plot options"), sticky="w")
tkgrid(ggplotCheckBox, tklabel(optionFrame, text="ggplot (accumcomp) "), sticky="e")
tkgrid(addCheckBox, tklabel(optionFrame, text="add plot "), sticky="e")
tkgrid(tklabel(optionFrame, text="x limits: ", width=10), xEntry, sticky="w")
tkgrid(tklabel(optionFrame, text="y limits: ", width=10), yEntry, sticky="w")
tkgrid(tklabel(optionFrame, text="ci: ", width=10), ciEntry, sticky="w")
tkgrid(tklabel(optionFrame, text="symbol: ", width=10), symbolEntry, sticky="w")
tkgrid(tklabel(optionFrame, text="cex: ", width=10), cexEntry, sticky="w")
tkgrid(tklabel(optionFrame, text="colour: ", width=10), colourEntry, sticky="w")
tkgrid(methodFrame, tklabel(choicesFrame, text="", width=1), option2Frame, sticky="w")
tkgrid(subsetFrame, tklabel(choicesFrame, text="", width=1), optionFrame, sticky="w")
tkgrid(choicesFrame, sticky="w")
tkgrid(OKbutton, plotButton, tklabel(buttonsFrame, text=" "), cancelButton, helpButton)
tkgrid(buttonsFrame, sticky="w")
tkgrid.configure(methodScroll, sticky="ns")
tkgrid.configure(subsetScroll, sticky="ns")
tkgrid.configure(scaleScroll, sticky="ns")
tkselection.set(methodBox, 0)
tkselection.set(subsetBox, 0)
tkselection.set(scaleBox, 0)
for (row in 0:6) tkgrid.rowconfigure(top, row, weight=0)
for (col in 0:0) tkgrid.columnconfigure(top, col, weight=0)
.Tcl("update idletasks")
tkwm.resizable(top, 0, 0)
tkwm.deiconify(top)
tkgrab.set(top)
tkfocus(methodBox)
tkwait.window(top)
}
diversityGUI <- function(){
top <- tktoplevel()
tkwm.title(top, "Diversity calculation")
.activeDataSet <- ActiveDataSet()
.communityDataSet <- CommunityDataSet()
.variables <- Factors()
variables <- paste(.variables)
.cvariables <- CVariables()
cvariables <- paste(.cvariables)
modelName <- tclVar("Diversity.1")
modelFrame <- tkframe(top, relief="groove", borderwidth=2)
model <- tkentry(modelFrame, width=40, textvariable=modelName)
choicesFrame <- tkframe(top, relief="groove", borderwidth=2)
indexFrame <- tkframe(choicesFrame)
indexBox <- tklistbox(indexFrame, width=27, height=5,
selectmode="single", background="white", exportselection="FALSE")
indexScroll <- tkscrollbar(indexFrame, repeatinterval=5, command=function(...) tkyview(indexBox, ...))
tkconfigure(indexBox, yscrollcommand=function(...) tkset(indexScroll, ...))
indices <- c("richness", "abundance", "Shannon", "Simpson", "inverseSimpson", "simpson.unb", "simpson.unb.inverse", "Logalpha", "Berger", "Jevenness", "Eevenness",
"jack1", "jack2", "chao", "boot", "richness (contribdiv)", "simpson (contribdiv)", "eventstar")
for (x in indices) tkinsert(indexBox, "end", x)
methodFrame <- tkframe(choicesFrame)
methodBox <- tklistbox(methodFrame, width=27, height=5,
selectmode="single", background="white", exportselection="FALSE")
methodScroll <- tkscrollbar(methodFrame, repeatinterval=5, command=function(...) tkyview(methodBox, ...))
tkconfigure(methodBox, yscrollcommand=function(...) tkset(methodScroll, ...))
methods <- c("pooled", "each site", "mean", "sd", "jackknife")
for (x in methods) tkinsert(methodBox, "end", x)
optionFrame <- tkframe(choicesFrame)
dataVariable <- tclVar("0")
dataCheckBox <- tkcheckbutton(optionFrame, variable=dataVariable)
sortVariable <- tclVar("0")
sortCheckBox <- tkcheckbutton(optionFrame, variable=sortVariable)
labelVariable <- tclVar("0")
labelCheckBox <- tkcheckbutton(optionFrame, variable=labelVariable)
addVariable <- tclVar("0")
addCheckBox <- tkcheckbutton(optionFrame, variable=addVariable)
ylist <- tclVar("0,5")
yEntry <- tkentry(optionFrame, width=10, textvariable=ylist)
symbol <- tclVar("1")
symbolEntry <- tkentry(optionFrame, width=10, textvariable=symbol)
subsetFrame <- tkframe(choicesFrame)
subset1Frame <- tkframe(subsetFrame)
subset2Frame <- tkframe(subsetFrame)
subsetBox <- tklistbox(subset1Frame, width=27, height=7,
selectmode="multiple", background="white", exportselection="FALSE")
subsetScroll <- tkscrollbar(subset1Frame, repeatinterval=5, command=function(...) tkyview(subsetBox, ...))
tkconfigure(subsetBox, yscrollcommand=function(...) tkset(subsetScroll, ...))
variables <- c("(none)", variables)
for (x in variables) tkinsert(subsetBox, "end", x)
subset <- tclVar(".")
subsetEntry <- tkentry(subset2Frame, width=10, textvariable=subset)
onOK <- function(){
doItAndPrint(paste("check.datasets(", .communityDataSet, ", ", .activeDataSet, ")", sep=""))
modelValue <- tclvalue(modelName)
index <- indices[as.numeric(tkcurselection(indexBox))+1]
method <- methods[as.numeric(tkcurselection(methodBox))+1]
data1 <- tclvalue(dataVariable) == "1"
sortit <- tclvalue(sortVariable) == "1"
if (data1==T) {sortit <- F}
var <- variables[as.numeric(tkcurselection(subsetBox))+1]
if (length(var) > 2) {
logger(paste("more than 2 factors selected, whereas only 1 or 2 allowed"))
logger(paste("only first 2 will be used"))
var <- var[c(1:2)]
}
if ("(none)" %in% var) {var <- "(none)"}
sub <- tclvalue(subset)
if (index %in% c("richness", "abundance", "Shannon", "Simpson", "inverseSimpson", "simpson.unb", "simpson.unb.inverse", "Logalpha", "Berger", "Jevenness", "Eevenness",
"jack1", "jack2", "chao", "boot")) {
if (var[1] == "(none)") {
command <- paste("diversityresult(", .communityDataSet, ", index='", index,
"' ,method='", method, "', sortit=", sortit, ", digits=6)", sep="")
}else{
if (length(var) == 1) {
if (sub == ".") {
command <- paste("diversitycomp(", .communityDataSet, ", y=", .activeDataSet, ", factor1='", var, "', index='", index,
"' , method='", method, "', sortit=", sortit, ", digits=6)", sep="")
}else{
command <- paste("diversityresult(", .communityDataSet, ", y=", .activeDataSet, ", factor='", var, "', level='", sub, "', index='", index,
"' , method='", method, "', sortit=", sortit, ", digits=6)", sep="")
}
}
if (length(var) == 2) {
command <- paste("diversitycomp(", .communityDataSet, ", y=", .activeDataSet, ", factor1='", var[1], "', factor2='", var[2], "', index='", index,
"' , method='", method, "', sortit=", sortit, ", digits=6)", sep="")
}
}
}
if (index == "richness (contribdiv)") {
command <- paste("contribdiv(", .communityDataSet, ", index='richness')", sep="")
}
if (index == "simpson (contribdiv)") {
command <- paste("contribdiv(", .communityDataSet, ", index='simpson')", sep="")
}
if (index == "eventstar") {
command <- paste("eventstar(", .communityDataSet, ", qmax=5)", sep="")
}
logger(paste(modelValue, " <- ", command, sep=""))
assign(modelValue, justDoIt(command), envir=.GlobalEnv)
doItAndPrint(paste(modelValue))
if (data1==T && method=="each site" && index %in% c("richness", "abundance", "Shannon", "Simpson", "inverseSimpson", "simpson.unb", "simpson.unb.inverse", "Logalpha", "Berger", "Jevenness", "Eevenness", "jack1", "jack2", "chao", "boot")) {
justDoIt(paste(.activeDataSet, "$", index, " <- diversityresult(", .communityDataSet, ", index='", index,"', method='each site')[,1]", sep=""))
logger(paste(.activeDataSet, "$", index, " <- diversityresult(", .communityDataSet, ", index='", index,"', method='each site')[,1]", sep=""))
activeDataSet(.activeDataSet)
}
}
onPlot <- function() {
modelValue <- tclvalue(modelName)
index <- indices[as.numeric(tkcurselection(indexBox))+1]
method <- methods[as.numeric(tkcurselection(methodBox))+1]
if (method == "all (pooled)") {method <- "all"}
var <- variables[as.numeric(tkcurselection(subsetBox))+1]
labelit <- tclvalue(labelVariable) == "1"
addit <- tclvalue(addVariable) == "1"
ylim <- tclvalue(ylist)
if (ylim != "") {ylim <- paste(", ylim=c(", ylim, ")", sep="")}
pch <- tclvalue(symbol)
sub <- tclvalue(subset)
if (index %in% c("richness", "abundance", "Shannon", "Simpson", "inverseSimpson", "simpson.unb", "simpson.unb.inverse", "Logalpha", "Berger", "Jevenness", "Eevenness")) {
if (var!="all" && sub=="." && method!="separate per site") {
if (addit==F) {
justDoIt(paste("plot(rep(-90, nrow(", modelValue, ")) ~ as.factor(rownames(", modelValue, ")), xlab='", method, "', ylab=colnames(", modelValue, "), type='n'", ylim, ")", sep=""))
logger(paste("plot(rep(-90, nrow(", modelValue, ")) ~ as.factor(rownames(", modelValue, ")), xlab='", method, "', ylab=colnames(", modelValue, "), type='n'", ylim, ")", sep=""))
}
doItAndPrint(paste("points(", modelValue, "[,2] ~ c(1:nrow(", modelValue, ")), pch=", pch, ")", sep=""))
if (labelit==T) {doItAndPrint(paste("text(c(1:nrow(", modelValue, "))," , modelValue, "[,2], labels=rownames(", modelValue, "), pos=3)", sep="")) }
if (labelit==T) {doItAndPrint(paste("text(c(1:nrow(", modelValue, "))," , modelValue, "[,2], labels=", modelValue, "[,1], pos=1)", sep="")) }
}
}
if (index %in% c("richness (contribdiv)", "simpson (contribdiv)")) {
doItAndPrint(paste("plot(", modelValue, ")", sep=""))
}
}
onCancel <- function() {
tkgrab.release(top)
tkfocus(CommanderWindow())
tkdestroy(top)
}
buttonsFrame <- tkframe(top)
onHelp <- function() {
if (.Platform$OS.type != "windows") tkgrab.release(top)
doItAndPrint(paste("help('diversityresult', help_type='html')", sep=""))
}
helpButton <- tkbutton(buttonsFrame, text="Help", width="12", command=onHelp)
OKbutton <- tkbutton(buttonsFrame, text="OK", width="12", command=onOK, default="active")
plotButton <- tkbutton(buttonsFrame, text="Plot", width="12", command=onPlot)
cancelButton <- tkbutton(buttonsFrame, text="Cancel", width="12", command=onCancel)
tkgrid(tklabel(modelFrame, text="Save result as: ", width=15), model, sticky="w")
tkgrid(modelFrame, sticky="w")
tkgrid(tklabel(indexFrame, text="Diversity index"), sticky="w")
tkgrid(indexBox, indexScroll,sticky="w")
tkgrid(tklabel(methodFrame, text="Calculation method"), sticky="w")
tkgrid(methodBox, methodScroll,sticky="w")
tkgrid(tklabel(subsetFrame, text="Subset options"), sticky="w")
tkgrid(subsetBox, subsetScroll, sticky="w")
tkgrid(tklabel(subset2Frame, text="subset: ", width=15), subsetEntry, sticky="w")
tkgrid(subset1Frame, sticky="w")
tkgrid(subset2Frame, sticky="w")
tkgrid(tklabel(optionFrame, text="Output options"), sticky="w")
tkgrid(dataCheckBox, tklabel(optionFrame, text="save results"), sticky="w")
tkgrid(sortCheckBox, tklabel(optionFrame, text="sort results"), sticky="w")
tkgrid(labelCheckBox, tklabel(optionFrame, text="label results"), sticky="w")
tkgrid(addCheckBox, tklabel(optionFrame, text="add plot"), sticky="w")
tkgrid(tklabel(optionFrame, text="y limits: ", width=20), yEntry, sticky="w")
tkgrid(tklabel(optionFrame, text="symbol: ", width=20), symbolEntry, sticky="w")
tkgrid(indexFrame, tklabel(choicesFrame, text="", width=1), methodFrame, sticky="w")
tkgrid(subsetFrame, tklabel(choicesFrame, text="", width=1), optionFrame, sticky="w")
tkgrid(choicesFrame, sticky="w")
tkgrid(OKbutton, plotButton, tklabel(buttonsFrame, text=" "), cancelButton, helpButton)
tkgrid(buttonsFrame, sticky="w")
tkgrid.configure(indexScroll, sticky="ns")
tkgrid.configure(methodScroll, sticky="ns")
tkgrid.configure(subsetScroll, sticky="ns")
tkselection.set(methodBox, 0)
tkselection.set(indexBox, 0)
tkselection.set(subsetBox, 0)
for (row in 0:6) tkgrid.rowconfigure(top, row, weight=0)
for (col in 0:0) tkgrid.columnconfigure(top, col, weight=0)
.Tcl("update idletasks")
tkwm.resizable(top, 0, 0)
tkwm.deiconify(top)
tkgrab.set(top)
tkfocus(methodBox)
tkwait.window(top)
}
diversityvars <- function(){
.communityDataSet <- CommunityDataSet()
.activeDataSet <- ActiveDataSet()
justDoIt(paste(.activeDataSet, " <- diversityvariables(", .communityDataSet, ", ", .activeDataSet, ")", sep=""))
logger(paste(.activeDataSet, " <- diversityvariables(", .communityDataSet, ", ", .activeDataSet, ")", sep=""))
activeDataSet(.activeDataSet)
}
rankabunGUI <- function(){
top <- tktoplevel()
tkwm.title(top, "Rank abundance curves")
.activeDataSet <- ActiveDataSet()
.communityDataSet <- CommunityDataSet()
.variables <- Factors()
variables <- paste(.variables, ifelse(is.element(.variables, Factors()), "[factor]", ""))
.cvariables <- CVariables()
cvariables <- paste(.cvariables)
modelName <- tclVar("RankAbun.1")
modelFrame <- tkframe(top, relief="groove", borderwidth=2)
model <- tkentry(modelFrame, width=40, textvariable=modelName)
choicesFrame <- tkframe(top, relief="groove", borderwidth=2)
optionFrame <- tkframe(choicesFrame)
option1Frame <- tkframe(optionFrame)
option2Frame <- tkframe(optionFrame)
scaleBox <- tklistbox(option1Frame, width=27, height=5,
selectmode="single", background="white", exportselection="FALSE")
scaleScroll <- tkscrollbar(option1Frame, repeatinterval=5, command=function(...) tkyview(scaleBox, ...))
tkconfigure(scaleBox, yscrollcommand=function(...) tkset(scaleScroll, ...))
scales <- c("abundance", "proportion", "logabun", "accumfreq")
for (x in scales) tkinsert(scaleBox, "end", x)
ggplotVariable <- tclVar("0")
ggplotCheckBox <- tkcheckbutton(option2Frame, variable=ggplotVariable)
radVariable <- tclVar("0")
radCheckBox <- tkcheckbutton(option2Frame, variable=radVariable)
addVariable <- tclVar("0")
addCheckBox <- tkcheckbutton(option2Frame, variable=addVariable)
xlist <- tclVar("")
xEntry <- tkentry(option2Frame, width=10, textvariable=xlist)
ylist <- tclVar("")
yEntry <- tkentry(option2Frame, width=10, textvariable=ylist)
subsetFrame <- tkframe(choicesFrame)
subset1Frame <- tkframe(subsetFrame)
subset2Frame <- tkframe(subsetFrame)
subsetBox <- tklistbox(subset1Frame, width=27, height=9,
selectmode="single", background="white", exportselection="FALSE")
subsetScroll <- tkscrollbar(subset1Frame, repeatinterval=5, command=function(...) tkyview(subsetBox, ...))
tkconfigure(subsetBox, yscrollcommand=function(...) tkset(subsetScroll, ...))
variables <- c("all",variables)
for (x in variables) tkinsert(subsetBox, "end", x)
subset <- tclVar(".")
subsetEntry <- tkentry(subset2Frame, width=10, textvariable=subset)
onOK <- function(){
doItAndPrint(paste("check.datasets(", .communityDataSet, ", ", .activeDataSet, ")", sep=""))
modelValue <- tclvalue(modelName)
var <- variables[as.numeric(tkcurselection(subsetBox))+1]
sub <- tclvalue(subset)
scale <- scales[as.numeric(tkcurselection(scaleBox))+1]
xlim <- tclvalue(xlist)
if (xlim != "") {xlim <- paste(", xlim=c(", xlim, ")", sep="")}
ylim <- tclvalue(ylist)
if (ylim != "") {ylim <- paste(", ylim=c(", ylim, ")", sep="")}
if (var == "all") {
command <- paste("rankabundance(", .communityDataSet, ")", sep="")
}else{
var <- .variables[as.numeric(tkcurselection(subsetBox))]
if (sub == ".") {
command <- paste("rankabuncomp(", .communityDataSet, ", y=", .activeDataSet, ", factor='", var, "', scale='", scale, "'", xlim, ylim, ", legend=F, rainbow=T)", sep="")
}else{
command <- paste("rankabundance(", .communityDataSet, ", y=", .activeDataSet, ", factor='", var, "', level='", sub, "')", sep="")
}
}
logger(paste(modelValue, " <- ", command, sep=""))
assign(modelValue, justDoIt(command), envir=.GlobalEnv)
doItAndPrint(paste(modelValue))
}
onPlot <- function(){
modelValue <- tclvalue(modelName)
var <- variables[as.numeric(tkcurselection(subsetBox))+1]
ggplotit <- tclvalue(ggplotVariable) == "1"
if (ggplotit==T) {
logger(paste(" "))
logger(paste("Please note that plotting requires a result from function 'rankabuncomp'."))
logger(paste("Such results are obtained when selecting a factor from the Subset options."))
logger(paste(" "))
justDoIt(paste("library(ggplot2)", sep=""))
logger(paste("library(ggplot2)", sep=""))
doItAndPrint("BioR.theme <- theme(panel.background = element_blank(), panel.border = element_blank(), panel.grid = element_blank(), axis.line = element_line('gray25'), text = element_text(size = 12), axis.text = element_text(size = 10, colour = 'gray25'), axis.title = element_text(size = 14, colour = 'gray25'), legend.title = element_text(size = 14), legend.text = element_text(size = 14), legend.key = element_blank() )")
doItAndPrint(paste("plotgg1 <- ggplot(data=", modelValue, ", aes(x = rank, y = abundance)) + scale_x_continuous(expand=c(0, 1), sec.axis = dup_axis(labels=NULL, name=NULL)) + scale_y_continuous(expand=c(0, 1), sec.axis = dup_axis(labels=NULL, name=NULL)) + geom_line(aes(colour=Grouping), size=1) + geom_point(aes(colour=Grouping, shape=Grouping), size=5, alpha=0.5) + BioR.theme + scale_color_brewer(palette = 'Set1') + labs(x = 'rank', y = 'abundance', colour = 'Factor', shape= 'Factor')", sep=""))
doItAndPrint("plotgg1")
}else{
radfit <- tclvalue(radVariable) == "1"
addit <- tclvalue(addVariable) == "1"
scale <- scales[as.numeric(tkcurselection(scaleBox))+1]
xlim <- tclvalue(xlist)
if (xlim != "") {xlim <- paste(", xlim=c(", xlim, ")", sep="")}
ylim <- tclvalue(ylist)
if (ylim != "") {ylim <- paste(", ylim=c(", ylim, ")", sep="")}
sub <- tclvalue(subset)
if (radfit==T) {
if (var == "all") {
doItAndPrint(paste("radfitresult(", .communityDataSet, ")", sep=""))
}else{
var <- .variables[as.numeric(tkcurselection(subsetBox))]
doItAndPrint(paste("radfitresult(", .communityDataSet, ", y=", .activeDataSet, ", factor='", var, "', level='", sub, "')", sep=""))
}
}else{
if (sub == ".") {
doItAndPrint(paste("rankabunplot(", modelValue, ",scale='", scale, "', addit=", addit, xlim, ylim, ", specnames=c(1,2,3))", sep=""))
}else{
doItAndPrint(paste("rankabunplot(", modelValue, ",scale='", scale, "', addit=", addit, ", labels='", sub, "'", xlim, ylim, ", specnames=c(1,2,3))", sep=""))
}
}
} # ggplotit
}
onCancel <- function() {
tkgrab.release(top)
tkfocus(CommanderWindow())
tkdestroy(top)
}
buttonsFrame <- tkframe(top)
onHelp <- function() {
if (.Platform$OS.type != "windows") tkgrab.release(top)
doItAndPrint(paste("help('rankabundance', help_type='html')", sep=""))
}
helpButton <- tkbutton(buttonsFrame, text="Help", width="12", command=onHelp)
OKbutton <- tkbutton(buttonsFrame, text="OK", width="12", command=onOK, default="active")
plotButton <- tkbutton(buttonsFrame, text="Plot", width="12", command=onPlot)
cancelButton <- tkbutton(buttonsFrame, text="Cancel", width="12", command=onCancel)
tkgrid(tklabel(modelFrame, text="Save result as: ", width=15), model, sticky="w")
tkgrid(modelFrame, sticky="w")
tkgrid(tklabel(subsetFrame, text="Subset options"), sticky="w")
tkgrid(subsetBox, subsetScroll, sticky="w")
tkgrid(tklabel(subset2Frame, text="subset: ", width=15), subsetEntry, sticky="w")
tkgrid(subset1Frame, sticky="w")
tkgrid(subset2Frame, sticky="w")
tkgrid(tklabel(option1Frame, text="Plot options"), sticky="w")
tkgrid(scaleBox, scaleScroll,sticky="w")
tkgrid(ggplotCheckBox, tklabel(option2Frame, text="ggplot (rankabuncomp) "), sticky="e")
tkgrid(radCheckBox, tklabel(option2Frame, text="fit RAD"), sticky="e")
tkgrid(addCheckBox, tklabel(option2Frame, text="add plot"), sticky="e")
tkgrid(tklabel(option2Frame, text="x limits: ", width=10), xEntry, sticky="w")
tkgrid(tklabel(option2Frame, text="y limits: ", width=10), yEntry, sticky="w")
tkgrid(option1Frame, sticky="w")
tkgrid(option2Frame, sticky="w")
tkgrid(subsetFrame, tklabel(choicesFrame, text="", width=1), optionFrame, sticky="w")
tkgrid(choicesFrame, sticky="w")
tkgrid(OKbutton, plotButton, tklabel(buttonsFrame, text=" "), cancelButton, helpButton)
tkgrid(buttonsFrame, sticky="w")
tkgrid.configure(scaleScroll, sticky="ns")
tkgrid.configure(subsetScroll, sticky="ns")
tkselection.set(scaleBox, 0)
tkselection.set(subsetBox, 0)
for (row in 0:6) tkgrid.rowconfigure(top, row, weight=0)
for (col in 0:0) tkgrid.columnconfigure(top, col, weight=0)
.Tcl("update idletasks")
tkwm.resizable(top, 0, 0)
tkwm.deiconify(top)
tkgrab.set(top)
tkwait.window(top)
}
renyiGUI <- function(){
top <- tktoplevel()
tkwm.title(top, "Renyi diversity profile")
.activeDataSet <- ActiveDataSet()
.communityDataSet <- CommunityDataSet()
.variables <- Factors()
variables <- paste(.variables)
.cvariables <- CVariables()
cvariables <- paste(.cvariables)
modelName <- tclVar("Renyi.1")
modelFrame <- tkframe(top, relief="groove", borderwidth=2)
model <- tkentry(modelFrame, width=40, textvariable=modelName)
choicesFrame <- tkframe(top, relief="groove", borderwidth=2)
methodFrame <- tkframe(choicesFrame)
methodBox <- tklistbox(methodFrame, width=27, height=5,
selectmode="single", background="white", exportselection="FALSE")
methodScroll <- tkscrollbar(methodFrame, repeatinterval=3, command=function(...) tkyview(methodBox, ...))
tkconfigure(methodBox, yscrollcommand=function(...) tkset(methodScroll, ...))
methods <- c("renyiall", "renyi separate per site", "renyi accumulation", "tsallis", "tsallis accumulation")
for (x in methods) tkinsert(methodBox, "end", x)
scalelist <- tclVar("0, 0.25, 0.5, 1, 2, 4, 8, Inf")
scaleFrame <- tkframe(choicesFrame)
scaleEntry <- tkentry(scaleFrame, width=40, textvariable=scalelist)
permVariable <- tclVar("999")
permutation <- tkentry(scaleFrame, width=10, textvariable=permVariable)
optionFrame <- tkframe(choicesFrame)
evenVariable <- tclVar("0")
evenCheckBox <- tkcheckbutton(optionFrame, variable=evenVariable)
ggplotVariable <- tclVar("0")
ggplotCheckBox <- tkcheckbutton(optionFrame, variable=ggplotVariable)
addVariable <- tclVar("0")
addCheckBox <- tkcheckbutton(optionFrame, variable=addVariable)
ylist <- tclVar("")
yEntry <- tkentry(optionFrame, width=40, textvariable=ylist)
symbol <- tclVar("1")
symbolEntry <- tkentry(optionFrame, width=40, textvariable=symbol)
colour <- tclVar("1")
colourEntry <- tkentry(optionFrame, width=40, textvariable=colour)
cexa <- tclVar("1")
cexEntry <- tkentry(optionFrame, width=40, textvariable=cexa)
subsetFrame <- tkframe(choicesFrame)
subset1Frame <- tkframe(subsetFrame)
subset2Frame <- tkframe(subsetFrame)
subsetBox <- tklistbox(subset1Frame, width=27, height=7,
selectmode="single", background="white", exportselection="FALSE")
subsetScroll <- tkscrollbar(subset1Frame, repeatinterval=5, command=function(...) tkyview(subsetBox, ...))
tkconfigure(subsetBox, yscrollcommand=function(...) tkset(subsetScroll, ...))
variables <- c("(none)", variables)
for (x in variables) tkinsert(subsetBox, "end", x)
subset <- tclVar(".")
subsetEntry <- tkentry(subset2Frame, width=10, textvariable=subset)
onOK <- function(){
doItAndPrint(paste("check.datasets(", .communityDataSet, ", ", .activeDataSet, ")", sep=""))
modelValue <- tclvalue(modelName)
method <- methods[as.numeric(tkcurselection(methodBox))+1]
method1 <- method
if (method1 == "renyiall") {method1 <- "all"}
if (method1 == "renyi separate per site") {method1 <- "s"}
scales <- tclvalue(scalelist)
evenness <- tclvalue(evenVariable) == "1"
ylim <- tclvalue(ylist)
if (ylim != "") {ylim <- paste(", ylim=c(", ylim, ")", sep="")}
var <- variables[as.numeric(tkcurselection(subsetBox))+1]
sub <- tclvalue(subset)
perm <- as.numeric(tclvalue(permVariable))
if (method %in% c("renyiall", "renyi separate per site", "renyi accumulation")) {
if (var == "(none)") {
if (method=="renyi accumulation") {
command <- paste("renyiaccum(", .communityDataSet, ", scales=c(", scales, "), permutations=", perm, ")", sep="")
}else{
command <- paste("renyiresult(", .communityDataSet, ", scales=c(", scales, "), method='", method1, "')", sep="")
}
}else{
var <- .variables[as.numeric(tkcurselection(subsetBox))]
if (sub == ".") {
command <- paste("renyicomp(", .communityDataSet, ", evenness=", evenness, ", y=", .activeDataSet, ", factor='", var, "', scales=c(", scales, "), permutations=", perm, ylim, ", legend=F)", sep="")
}else{
if (method=="renyi accumulation") {
command <- paste("renyiaccumresult(", .communityDataSet, ", y=", .activeDataSet, ", factor='", var, "', level='", sub, "', scales=c(", scales, "), permutations=", perm, ")", sep="")
}else{
command <- paste("renyiresult(", .communityDataSet, ", y=", .activeDataSet, ", factor='", var, "', level='", sub, "', scales=c(", scales, "), method='", method1, "')", sep="")
}
}
}
}
if (method=="tsallis") {
command <- paste("tsallis(", .communityDataSet, ", scales=c(0, 0.25, 0.5, 1, 2, 4))", sep="")
}
if (method=="tsallis accumulation") {
command <- paste("tsallisaccum(", .communityDataSet, ", scales=c(0, 0.25, 0.5, 1, 2, 4), permutations=", perm, ")", sep="")
}
logger(paste(modelValue, " <- ", command, sep=""))
assign(modelValue, justDoIt(command), envir=.GlobalEnv)
doItAndPrint(paste(modelValue))
}
onPlot <- function(){
modelValue <- tclvalue(modelName)
method <- methods[as.numeric(tkcurselection(methodBox))+1]
evenness <- tclvalue(evenVariable) == "1"
ggplotit <- tclvalue(ggplotVariable) == "1"
addit <- tclvalue(addVariable) == "1"
ylim <- tclvalue(ylist)
if (ylim != "") {ylim <- paste(", ylim=c(", ylim, ")", sep="")}
pch <- tclvalue(symbol)
col <- tclvalue(colour)
cex <- tclvalue(cexa)
var <- variables[as.numeric(tkcurselection(subsetBox))+1]
sub <- tclvalue(subset)
if (ggplotit==T) {
logger(paste(" "))
logger(paste("Please note that plotting requires a result from function 'renyicomp'."))
logger(paste("Such results are obtained when selecting a factor from the Subset options and the 'renyi accumulation' method from the Methods options."))
logger(paste(" "))
justDoIt(paste("library(ggplot2)", sep=""))
logger(paste("library(ggplot2)", sep=""))
doItAndPrint("BioR.theme <- theme(panel.background = element_blank(), panel.border = element_blank(), panel.grid = element_blank(), axis.line = element_line('gray25'), text = element_text(size = 12), axis.text = element_text(size = 10, colour = 'gray25'), axis.title = element_text(size = 14, colour = 'gray25'), legend.title = element_text(size = 14), legend.text = element_text(size = 14), legend.key = element_blank() )")
doItAndPrint(paste("plotgg1 <- ggplot(data=renyicomp.long(", modelValue, "), aes(x = Scales, y = Diversity, ymax = UPR, ymin= LWR)) + scale_x_discrete() + scale_y_continuous(sec.axis = dup_axis(labels=NULL, name=NULL)) + geom_line(data=renyicomp.long(", modelValue, "), aes(x=Obs, colour=Grouping), size=2) + geom_point(aes(colour=Grouping, shape=Grouping), size=5) + geom_ribbon(data=renyicomp.long(", modelValue, "), aes(x=Obs, colour=Grouping), alpha=0.2, show.legend=FALSE) + BioR.theme + scale_color_brewer(palette = 'Set1') + labs(x = expression(alpha), y = 'Diversity', colour = 'Factor', shape= 'Factor')", sep=""))
doItAndPrint("plotgg1")
}else{
if (method=="renyi accumulation" || method=="tsallis accumulation") {
justDoIt(paste("persp(", modelValue, ")", sep=""))
logger(paste("persp(", modelValue, ")", sep=""))
logger(paste("for interactive 3d plot, use vegan3d::rgl.renyiaccum", sep=""))
}
if (method=="renyi" || method=="renyi separate per site") {
if (var != "none" || sub != ".") {
if (evenness == F) {
justDoIt(paste("renyiplot(", modelValue, ", xlab='alpha', ylab='H-alpha', evenness=F, addit=", addit, ", rainbow=T, legend=F, pch=", pch, ",col='", col, "', cex=", cex, ylim, ")", sep=""))
logger(paste("renyiplot(", modelValue, ", xlab='alpha', ylab='H-alpha', evenness=F, addit=", addit, ", rainbow=T, legend=F, pch=", pch, ",col='", col, "', cex=", cex, ylim, ")", sep=""))
}else{
justDoIt(paste("renyiplot(", modelValue, ", xlab='alpha', ylab='E-alpha', evenness=T, addit=", addit, ", rainbow=T, legend=F, pch=", pch, ",col='", col, "', cex=", cex, ylim, ")", sep=""))
logger(paste("renyiplot(", modelValue, ", xlab='alpha', ylab='H-alpha', evenness=T, addit=", addit, ", rainbow=T, legend=F, pch=", pch, ",col='", col, "', cex=", cex, ylim, ")", sep=""))
}
}
}
if (method=="tsallis") {
doItAndPrint(paste("dev.new()", sep=""))
justDoIt(paste("plot(", modelValue, ")", sep=""))
logger(paste("plot(", modelValue, ")", sep=""))
}
} # ggplotit
}
onCancel <- function() {
tkgrab.release(top)
tkfocus(CommanderWindow())
tkdestroy(top)
}
buttonsFrame <- tkframe(top)
onHelp <- function() {
if (.Platform$OS.type != "windows") tkgrab.release(top)
doItAndPrint(paste("help('renyiresult', help_type='html')", sep=""))
}
helpButton <- tkbutton(buttonsFrame, text="Help", width="12", command=onHelp)
OKbutton <- tkbutton(buttonsFrame, text="OK", width="12", command=onOK, default="active")
plotButton <- tkbutton(buttonsFrame, text="Plot", width="12", command=onPlot)
cancelButton <- tkbutton(buttonsFrame, text="Cancel", width="12", command=onCancel)
tkgrid(tklabel(modelFrame, text="Save result as: ", width=15), model, sticky="w")
tkgrid(modelFrame, sticky="w")
tkgrid(tklabel(methodFrame, text="Calculation method"), sticky="w")
tkgrid(methodBox, methodScroll,sticky="w")
tkgrid(tklabel(scaleFrame, text=" "), sticky="w")
tkgrid(tklabel(scaleFrame, text="scale parameters: ", width=20), scaleEntry, sticky="w")
tkgrid(tklabel(scaleFrame, text="permutations", width=10), permutation, sticky="w")
tkgrid(tklabel(subsetFrame, text="Subset options"), sticky="w")
tkgrid(subsetBox, subsetScroll, sticky="w")
tkgrid(tklabel(subset2Frame, text="subset: ", width=15), subsetEntry, sticky="w")
tkgrid(subset1Frame, sticky="w")
tkgrid(subset2Frame, sticky="w")
tkgrid(tklabel(optionFrame, text="Plot options"), sticky="w")
tkgrid(ggplotCheckBox, tklabel(optionFrame, text="ggplot (renyicomp)"), sticky="w")
tkgrid(evenCheckBox, tklabel(optionFrame, text="evenness profile"), sticky="w")
tkgrid(addCheckBox, tklabel(optionFrame, text="add plot"), sticky="w")
tkgrid(tklabel(optionFrame, text="y limits: ", width=10), yEntry, sticky="w")
tkgrid(tklabel(optionFrame, text="symbol: ", width=10), symbolEntry, sticky="w")
tkgrid(tklabel(optionFrame, text="colour: ", width=10), colourEntry, sticky="w")
tkgrid(tklabel(optionFrame, text="cex: ", width=10), cexEntry, sticky="w")
tkgrid(methodFrame, tklabel(choicesFrame, text="", width=1), scaleFrame, sticky="w")
tkgrid(subsetFrame, tklabel(choicesFrame, text="", width=1), optionFrame, sticky="w")
tkgrid(choicesFrame, sticky="w")
tkgrid(OKbutton, plotButton, tklabel(buttonsFrame, text=" "), cancelButton, helpButton)
tkgrid(buttonsFrame, sticky="w")
tkgrid.configure(methodScroll, sticky="ns")
tkgrid.configure(subsetScroll, sticky="ns")
tkselection.set(methodBox, 0)
tkselection.set(subsetBox, 0)
for (row in 0:6) tkgrid.rowconfigure(top, row, weight=0)
for (col in 0:0) tkgrid.columnconfigure(top, col, weight=0)
.Tcl("update idletasks")
tkwm.resizable(top, 0, 0)
tkwm.deiconify(top)
tkgrab.set(top)
tkfocus(methodBox)
tkwait.window(top)
}
countGUI <- function(){
contrasts <- c("contr.treatment", "contr.poly")
checkAddOperator <- function(rhs){
rhs.chars <- rev(strsplit(rhs, "")[[1]])
if (length(rhs.chars) < 1) return(FALSE)
check.char <- if ((rhs.chars[1] != " ") || (length(rhs.chars) == 1))
rhs.chars[1] else rhs.chars[2]
!is.element(check.char, c("+", "*", ":", "/", "-", "^", "(", "%"))
}
top <- tktoplevel()
tkwm.title(top, "Analysis of species abundance")
.activeDataSet <- ActiveDataSet()
.communityDataSet <- CommunityDataSet()
.variables <- Variables()
variables <- paste(.variables, ifelse(is.element(.variables, Factors()), "[factor]", ""))
allvars <- ""
if (length(.variables) > 1) {
for (i in 1:(length(.variables)-1)) {
allvars <- paste(allvars, .variables[i], "+")
}
allvars <- paste(allvars, .variables[length(.variables)])
}else{
allvars <- paste(allvars, .variables[1])
}
.cvariables <- CVariables()
cvariables <- paste(.cvariables)
xFrame <- tkframe(top, relief="groove", borderwidth=2)
x1Frame <- tkframe(xFrame)
x4Frame <- tkframe(xFrame)
x2Frame <- tkframe(x4Frame)
x3Frame <- tkframe(x4Frame)
xBox <- tklistbox(x2Frame, width=28, height=5,
selectmode="single", background="white", exportselection="FALSE")
xScroll <- tkscrollbar(x2Frame, repeatinterval=5, command=function(...) tkyview(xBox, ...))
tkconfigure(xBox, yscrollcommand=function(...) tkset(xScroll, ...))
for (x in variables) tkinsert(xBox, "end", x)
resFrame <- tkframe(top, relief="groove", borderwidth=2)
yFrame <- tkframe(resFrame)
yBox <- tklistbox(yFrame, width=27, height=5,
selectmode="single", background="white", exportselection="FALSE")
yScroll <- tkscrollbar(yFrame, repeatinterval=5, command=function(...) tkyview(yBox, ...), width=18)
tkconfigure(yBox, yscrollcommand=function(...) tkset(yScroll, ...))
for (x in cvariables) tkinsert(yBox, "end", x)
lhsVariable <- tclVar("")
lhsFrame <- tkframe(resFrame)
lhsEntry <- tkentry(lhsFrame, width=28, textvariable=lhsVariable)
rhsVariable <- tclVar("")
rhsEntry <- tkentry(x1Frame, width=60, textvariable=rhsVariable)
modelName <- tclVar("Count.model1")
modelFrame <- tkframe(top, relief="groove", borderwidth=2)
model <- tkentry(modelFrame, width=40, textvariable=modelName)
subsetVariable <- tclVar("")
subsetFrame <- tkframe(top, relief="groove", borderwidth=2)
subsetEntry <- tkentry(subsetFrame, width=40, textvariable=subsetVariable)
plotFrame <- tkframe(top, relief="groove", borderwidth=2)
plot1Frame <- tkframe(plotFrame)
plot2Frame <- tkframe(plotFrame)
typeBox <- tklistbox(plot1Frame, width=27, height=5,
selectmode="single", background="white", exportselection="FALSE")
typeScroll <- tkscrollbar(plot1Frame, repeatinterval=5, command=function(...) tkyview(typeBox, ...))
tkconfigure(typeBox, yscrollcommand=function(...) tkset(typeScroll, ...))
types <- c("diagnostic plots", "levene test (factor)", "term plot", "effect plot", "qq plot", "result plot (new)",
"result plot (add)", "result plot (interpolate)", "cr plot", "av plot", "influence plot", "multcomp (factor)", "rpart")
for (x in types) tkinsert(typeBox, "end", x)
axisBox <- tklistbox(plot2Frame, width=27, height=5,
selectmode="single", background="white", exportselection="FALSE")
axisScroll <- tkscrollbar(plot2Frame, repeatinterval=5, command=function(...) tkyview(axisBox, ...))
tkconfigure(axisBox, yscrollcommand=function(...) tkset(axisScroll, ...))
for (x in variables) tkinsert(axisBox, "end", x)
optionFrame <- tkframe(top, relief="groove", borderwidth=2)
option1Frame <- tkframe(optionFrame)
option2Frame <- tkframe(optionFrame)
optionBox <- tklistbox(option1Frame, width=27, height=5,
selectmode="single", background="white", exportselection="FALSE")
optionScroll <- tkscrollbar(option1Frame, repeatinterval=5, command=function(...) tkyview(optionBox, ...))
tkconfigure(optionBox, yscrollcommand=function(...) tkset(optionScroll, ...))
options <- c("summarySE", "linear model", "Poisson model", "quasi-Poisson model", "negative binomial model", "gam model",
"gam negbinom model", "glmmPQL", "rpart")
for (x in options) tkinsert(optionBox, "end", x)
standardVariable <- tclVar("0")
standardCheckBox <- tkcheckbutton(option2Frame, variable=standardVariable)
summaryVariable <- tclVar("1")
summaryCheckBox <- tkcheckbutton(option2Frame, variable=summaryVariable)
anovaVariable <- tclVar("0")
anovaCheckBox <- tkcheckbutton(option2Frame, variable=anovaVariable)
dataVariable <- tclVar("0")
dataCheckBox <- tkcheckbutton(option2Frame, variable=dataVariable)
onDoubleClick <- function(){
var <- as.character(tkget(xBox, "active"))[1]
tkfocus(rhsEntry)
rhs <- tclvalue(rhsVariable)
rhs.chars <- rev(strsplit(rhs, "")[[1]])
check.char <- if (length(rhs.chars) > 0){
if ((rhs.chars[1] != " ") || (length(rhs.chars) == 1))
rhs.chars[1] else rhs.chars[2]
}
else ""
tclvalue(rhsVariable) <- if (rhs == "" ||
is.element(check.char, c("+", "*", ":", "/", "-", "^", "(", "%")))
paste(rhs, var, sep="")
else paste(rhs, "+", var)
tkicursor(rhsEntry, "end")
tkxview.moveto(rhsEntry, "1")
}
onDoubleClick2 <- function(){
var <- as.character(tkget(yBox, "active"))[1]
lhs <- tclvalue(lhsVariable)
tclvalue(lhsVariable) <- var
}
onPlus <- function(){
rhs <- tclvalue(rhsVariable)
if (!checkAddOperator(rhs)) return()
tclvalue(rhsVariable) <- paste(rhs, "+ ")
tkicursor(rhsEntry, "end")
tkxview.moveto(rhsEntry, "1")
}
onTimes <- function(){
rhs <- tclvalue(rhsVariable)
if (!checkAddOperator(rhs)) return()
tclvalue(rhsVariable) <- paste(rhs, "*", sep="")
tkicursor(rhsEntry, "end")
tkxview.moveto(rhsEntry, "1")
}
onColon <- function(){
rhs <- tclvalue(rhsVariable)
if (!checkAddOperator(rhs)) return()
tclvalue(rhsVariable) <- paste(rhs, ":", sep="")
tkicursor(rhsEntry, "end")
tkxview.moveto(rhsEntry, "1")
}
onSlash <- function(){
rhs <- tclvalue(rhsVariable)
if (!checkAddOperator(rhs)) return()
tclvalue(rhsVariable) <- paste(rhs, "/", sep="")
tkicursor(rhsEntry, "end")
tkxview.moveto(rhsEntry, "1")
}
onIn <- function(){
rhs <- tclvalue(rhsVariable)
if (!checkAddOperator(rhs)) return()
tclvalue(rhsVariable) <- paste(rhs, "%in% ")
tkicursor(rhsEntry, "end")
tkxview.moveto(rhsEntry, "1")
}
onMinus <- function(){
rhs <- tclvalue(rhsVariable)
tclvalue(rhsVariable) <- paste(rhs, "+I(")
tkicursor(rhsEntry, "end")
tkxview.moveto(rhsEntry, "1")
}
onMinus2 <- function(){
rhs <- tclvalue(rhsVariable)
tclvalue(rhsVariable) <- paste(rhs, "s(")
tkicursor(rhsEntry, "end")
tkxview.moveto(rhsEntry, "1")
}
onPower <- function(){
rhs <- tclvalue(rhsVariable)
if (!checkAddOperator(rhs)) return()
tclvalue(rhsVariable) <- paste(rhs, "^", sep="")
tkicursor(rhsEntry, "end")
tkxview.moveto(rhsEntry, "1")
}
onLeftParen <- function(){
tkfocus(rhsEntry)
rhs <- tclvalue(rhsVariable)
tclvalue(rhsVariable) <- paste(rhs, "(", sep="")
tkicursor(rhsEntry, "end")
tkxview.moveto(rhsEntry, "1")
}
onRightParen <- function(){
rhs <- tclvalue(rhsVariable)
if (!checkAddOperator(rhs)) return()
tclvalue(rhsVariable) <- paste(rhs, ")", sep="")
tkicursor(rhsEntry, "end")
tkxview.moveto(rhsEntry, "1")
}
onOK <- function(){
doItAndPrint(paste("check.datasets(", .communityDataSet, ", ", .activeDataSet, ")", sep=""))
check.empty <-