https://github.com/cran/robCompositions
Tip revision: 2cc9b1ae6488319f4ae1d1655243b80e72fdcbe8 authored by Matthias Templ on 04 May 2011, 00:00:00 UTC
version 1.5.0
version 1.5.0
Tip revision: 2cc9b1a
robGUI.R
#library(robCompositions)
#library(RGtk2)
robGUI = function() {
is.installed <- function(mypkg) is.element(mypkg, installed.packages()[,1])
if(!is.installed('RGtk2')) warning("RGtk2 have to be installed first.") else cat("\n ... the package RGtk2 has to be loaded.\n")
appendTexts = function(cont, texts) {
for(text in texts) cont$appendText(text)
}
boxObject = function(type, homogenous, spacing, children, expand, fill, padding) {
if(type == "h") box = gtkHBoxNew(homogenous, spacing)
else box = gtkVBoxNew(homogenous,spacing)
i = 1
for(child in children) {
box$packStart(child, expand[i], fill[i], padding[i])
i = i+1
}
box
}
align = function(object, xalign, yalign, xscale, yscale) {
alignment = gtkAlignmentNew(xalign, yalign, xscale, yscale)
alignment$add(object)
alignment
}
padding = function(object, top, bottom, left, right) {
alignment = gtkAlignmentNew()
alignment$add(object)
alignment$setPadding(top, bottom, left, right)
alignment
}
nonnull = function(value) { if(length(value)<1) return("") else return(value) }
setActiveText = function(combobox, text) {
iter = combobox$getModel()$iterChildren()
status = iter$retval
iter = iter$iter
while(status == TRUE) {
value = combobox$getModel()$getValue(iter, 0)$value
if(value == text) {
combobox$setActiveIter(iter)
return(TRUE)
}
status = combobox$getModel()$iterNext(iter)
}
combobox$setActive(-1)
return(FALSE)
}
setShown = function(object, show) {
if(show) object$show()
else object$hide()
}
helps = c("Choose composition",
"Closes compositions to sum up to a given constant (default 1),\nby dividing each part of a composition by its row sum.",
"The transformation moves D-part compositional data\nfrom the simplex into a (D-1)-dimensional real space.",
"Inverse log-ratio transformation,\noften called logistic transformation.",
"Computes the Aitchison distance\nbetween two observations or between two data sets.",
"Outlier detection for compositional data\nusing standard and robust statistical methods.",
"The compositional data set is transformed using the ilr\ntranformation. Afterwards, robust principal component analysis is\nperformed. Resulting loadings and scores are back-transformed to\nthe clr space where the compositional biplot can be shown."
)
# construction
window = gtkWindowNew(NULL, FALSE)
window$setTitle("robCompositions GUI")
window$setDefaultSize(400,400)
# composition frame
compositionFrame = gtkFrameNew("Composition")
compositionFrame$setBorderWidth(5)
composition = gtkComboBoxNewText()
composition$show()
appendTexts(composition, c("Closure operation", "Logratio transformation", "Inverse logration transformation", "Aitchison distance", "Outlier detection", "Robust principal component analysis"))
compositionVariant = gtkComboBoxNewText()
compositionVariant$show()
appendTexts(compositionVariant, c("additive", "centered", "isometric"))
compositionVariantBox = boxObject("h", F, 0, c(padding(gtkLabelNew("variant:"),0,0,10,5), compositionVariant), c(T,T), c(T,T), c(0,0))
compositionHelp = gtkLabelNew("napoveda")
compositionSelect = boxObject("h", F, 0, c(align(composition,0,0,1,0), align(compositionVariantBox,1,0,0,0)), c(T,F), c(T,F), c(0,0))
constSum = gtkEntryNew()
compositionConstSum = boxObject("h", F, 0, c(padding(gtkLabelNew("closure constant:"),0,0,0,5), constSum), c(F,F), c(F,T), c(0,0))
ivar = gtkEntryNew()
compositionIvar = boxObject("h", F, 0, c(padding(gtkLabelNew("index of the rationing part:"),0,0,0,5), ivar), c(F,T), c(F,T), c(0,0))
quantile = gtkEntryNew()
compositionQuantile = boxObject("h", F, 0, c(padding(gtkLabelNew("quantile:"),0,0,0,5), quantile), c(F,F), c(F,T), c(0,0))
methodRobust = gtkRadioButtonNewWithLabel(NULL, "robust")
methodStandard = gtkRadioButtonNewWithLabel(methodRobust$getGroup(), "standard")
methodBox = boxObject("h", F, 0, c(gtkLabelNew("method:"), methodRobust, methodStandard), c(F,T,T), c(F,F,F), c(0,0,0))
compositionBox = boxObject("v", F, 0, c(compositionSelect, padding(compositionConstSum,10,0,0,0), padding(compositionIvar,10,0,0,0), padding(compositionQuantile,10,0,0,0), methodBox, align(padding(compositionHelp,10,0,0,0),0,0,0,0)), c(F,T,T,T,T,F), c(F,T,T,T,T,F), c(0,0,0,0,0,0))
compositionBox$setBorderWidth(5)
compositionFrame$add(compositionBox)
# input
inputFrame = gtkFrameNew("Input")
inputFrame$setBorderWidth(5)
inputFileRadio <- gtkRadioButtonNewWithLabel(NULL, "File:")
inputBrowse = gtkButtonNewWithLabel("Browse")
inputVariableRadio <- gtkRadioButtonNewWithLabel(inputFileRadio$getGroup(), "Data:")
inputFile = gtkEntryNew()
inputVariable = gtkComboBoxEntryNewText()
inputVariable$show()
inputFileBox = boxObject("h", F, 0, c(inputFileRadio, inputFile, inputBrowse), c(F,T,F), c(F,T,F), c(0,0,0))
inputVariableBox = boxObject("h", F, 0, c(inputVariableRadio, inputVariable), c(F,T), c(F,T), c(0,0))
inputBox = boxObject("v", F, 0, c(inputFileBox,inputVariableBox), c(T,T), c(T,T), c(0,0))
inputBox$setBorderWidth(5)
inputFrame$add(inputBox)
# second input for aDist
input2Frame = gtkFrameNew("Input, second dataset")
input2Frame$setBorderWidth(5)
input2FileRadio <- gtkRadioButtonNewWithLabel(NULL, "File:")
input2Browse = gtkButtonNewWithLabel("Browse")
input2VariableRadio <- gtkRadioButtonNewWithLabel(input2FileRadio$getGroup(), "Data:")
input2File = gtkEntryNew()
input2Variable = gtkComboBoxEntryNewText()
input2Variable$show()
input2FileBox = boxObject("h", F, 0, c(input2FileRadio, input2File, input2Browse), c(F,T,F), c(F,T,F), c(0,0,0))
input2VariableBox = boxObject("h", F, 0, c(input2VariableRadio, input2Variable), c(F,T), c(F,T), c(0,0))
input2Box = boxObject("v", F, 0, c(input2FileBox,input2VariableBox), c(T,T), c(T,T), c(0,0))
input2Box$setBorderWidth(5)
input2Frame$add(input2Box)
# output
outputFrame = gtkFrameNew("Output")
outputFrame$setBorderWidth(5)
outputFileRadio <- gtkRadioButtonNewWithLabel(NULL, "File:")
outputBrowse = gtkButtonNewWithLabel("Browse")
outputVariableRadio <- gtkRadioButtonNewWithLabel(outputFileRadio$getGroup(), "Variable:")
outputConsoleRadio = gtkRadioButtonNewWithLabel(outputFileRadio$getGroup(), "Console")
outputFile = gtkEntryNew()
outputVariable = gtkEntryNew()
outputFileBox = boxObject("h", F, 0, c(outputFileRadio, outputFile, outputBrowse), c(F,T,F), c(F,T,F), c(0,0,0))
outputVariableBox = boxObject("h", F, 0, c(outputVariableRadio, outputVariable), c(F,T), c(F,T), c(0,0))
outputTypeCombo = gtkComboBoxNewText()
outputTypeCombo$show()
outputType = boxObject("h", F, 0, c(outputTypeCombo), c(T), c(T), c(0,0))
outputBox = boxObject("v", F, 0, c(padding(outputType,0,10,0,0),outputFileBox,outputVariableBox,outputConsoleRadio), c(T,T,F), c(T,T,F), c(0,0,0))
outputBox$setBorderWidth(5)
outputFrame$add(outputBox)
#auto switch radio
gSignalConnect(inputFile, "changed", function(d) {inputFileRadio$setActive(TRUE)})
gSignalConnect(inputVariable, "popup", function(d) {inputVariableRadio$setActive(TRUE)})
gSignalConnect(input2File, "changed", function(d) {input2FileRadio$setActive(TRUE)})
gSignalConnect(input2Variable, "popup", function(d) {input2VariableRadio$setActive(TRUE)})
gSignalConnect(outputFile, "changed", function(d) {outputFileRadio$setActive(TRUE)})
gSignalConnect(outputVariable, "changed", function(d) {outputVariableRadio$setActive(TRUE)})
# run button
runButton = gtkButtonNewWithLabel("Run")
buttonAlign = align(runButton,0,1,1,0)
# browse button logic
browseInputSignal = function(d) {
dialog <- gtkFileChooserDialogNew("Select input data file", NULL, "open",
"gtk-cancel", GtkResponseType["cancel"],
"gtk-open", GtkResponseType["accept"])
if (dialog$run() == GtkResponseType["accept"]) {
inputFile$setText(dialog$getFilename())
}
dialog$destroy()
}
gSignalConnect(inputBrowse, "clicked", browseInputSignal)
browseInput2Signal = function(d) {
dialog <- gtkFileChooserDialogNew("Select second input data file", NULL, "open",
"gtk-cancel", GtkResponseType["cancel"],
"gtk-open", GtkResponseType["accept"])
if (dialog$run() == GtkResponseType["accept"]) {
input2File$setText(dialog$getFilename())
}
dialog$destroy()
}
gSignalConnect(input2Browse, "clicked", browseInput2Signal)
browseOutputSignal <- function(d) {
dialog <- gtkFileChooserDialogNew("Select output data file", NULL, "save",
"gtk-cancel", GtkResponseType["cancel"],
"gtk-open", GtkResponseType["accept"])
if (dialog$run() == GtkResponseType["accept"]) {
outputFile$setText(dialog$getFilename())
}
dialog$destroy()
}
gSignalConnect(outputBrowse, "clicked", browseOutputSignal)
# hiding composition logic
compositionChanged = function(d) {
index = composition$getActive()
variantIndex = compositionVariant$getActive()
setShown(compositionVariantBox, index == 1 || index == 2)
setShown(compositionConstSum, index == 0)
setShown(compositionIvar, (index == 1 || index == 2) && variantIndex == 0)
setShown(compositionQuantile, index == 4)
setShown(methodBox, index == 4 || index == 5)
setShown(input2Frame, index == 3)
if(index >= 0) compositionHelp$setText(helps[index+2])
else compositionHelp$setText(helps[1])
while(outputTypeCombo$getModel()$iterNChildren() != 0) outputTypeCombo$removeText(0)
append = c()
if(index == 0) append = c("The data for which the row sums are equal to 'const'.")
else if(index == 1) {
if(variantIndex == 0) append = c("the transformed data", "the rationing variable")
else if(variantIndex == 1) append = c("clr transformed data", "the geometric means of the original composition")
else if(variantIndex == 2) append = c("the ilr transformed data")
} else if(index == 2) {
if(variantIndex == 0) append = c("the transformed data matrix")
else if(variantIndex == 1) append = c("the transformed data set")
else if(variantIndex == 2) append = c("the transformed data")
} else if(index == 3) append = c("the Aitchison distance.")
else if(index == 4) append = c("resulting Mahalanobis distance", "logical vector indicating outliers and non-outliers", "graph")
else if(index == 5) append = c("scores in clr space", "loadings in clr space", "eigenvalues of the clr covariance matrix", "graph")
appendTexts(outputTypeCombo, append)
if(length(append) > 0) outputTypeCombo$setActive(0)
}
gSignalConnect(composition, "changed", compositionChanged);
gSignalConnect(compositionVariant, "changed", compositionChanged);
# run button action, do all
error <- function(msg) {
dialog <- gtkMessageDialog(window, "destroy-with-parent", "error", "close", msg)
dialog$run()
dialog$destroy()
}
run <- function(d) {
input = NULL
input2 = NULL
result = NULL
if(inputFileRadio$getActive() == TRUE) {
if(nchar(inputFile$getText()) < 1) return(error("You must specify input file"))
input <- try(read.table(inputFile$getText()))
if(class(input) == "try-error") return(error("Error reading input file"))
} else if(inputVariableRadio$getActive() == TRUE) {
var = inputVariable$getActiveText()
if(nchar(var) < 1) return(error("You must choose a variable for input"))
if(!exists(var)) try(data(list=var))
input <- try(get(var))
if(class(input) == "try-error") return(error("Given variable for input not accessible"))
} else {
return(error("Input not specified"))
}
index <- composition$getActive()
variant = compositionVariant$getActive()
if(index == 3) {
if(input2FileRadio$getActive() == TRUE) {
if(nchar(input2File$getText()) < 1) return(error("You must specify second input file"))
input2 <- try(read.table(input2File$getText()))
if(class(input2) == "try-error") return(error("Error reading second input file"))
} else if(input2VariableRadio$getActive() == TRUE) {
if(length(input2Variable$getActiveText()) < 1) return(error("You must choose a variable for second input"))
try(data(input2Variable$getActiveText()))
input2 <- try(get(input2Variable$getActiveText()))
if(class(input2) == "try-error") return(error("Given variable for second input not accessible"))
} else {
return(error("second input not specified"))
}
}
if(index == 0) {
constant = constSum$getText()
if(nchar(constant)<1) result=try(constSum(input))
else result = try(constSum(input, as.numeric(constant)))
} else if(index == 1) {
if(variant == 0) {
indexVar = ivar$getText()
if(nchar(indexVar)<1) result = try(alr(input))
else result = try(alr(input, as.numeric(indexVar)))
}
else if(variant == 1) result = try(clr(input))
else if(variant == 2) result = try(ilr(input))
else return(error("Variant not specified"))
} else if(index == 2) {
if(variant == 0) {
indexVar = ivar$getText()
if(nchar(indexVar)<1) result = try(invalr(input))
else result = try(alr(input, as.numeric(indexVar)))
}
else if(variant == 1) result = try(invclr(input))
else if(variant == 2) result = try(invilr(input))
else return(error("Variant not specified"))
} else if(index == 3) {
result = try(aDist(input, input2))
} else if(index == 4) {
quant = quantile$getText()
if(methodRobust$getActive()) meth = "robust"
else meth = "standard"
if(nchar(quant)>0) result = try(outCoDa(input, quantile=as.numeric(quant), method=meth))
else result = try(outCoDa(input, method=meth))
} else if(index == 5) {
if(methodRobust$getActive()) meth = "robust"
else meth = "standard"
result = try(pcaCoDa(input, method=meth))
} else return(error("Composition not specified"))
if(class(result) == "try-error") return(error(result))
type = outputTypeCombo$getActive()
if(type<0) return(error("You must specify what do you want to output"))
graph = FALSE
if(index == 1) {
if(variant == 0) {
if(type == 0) result = result$x.alr
else result = result$varx
} else if(variant == 1) {
if(type == 0) result = result$x.clr
else result = result$gm
}
} else if(index == 4) {
if(type == 0) result = result$mahalDist
else if(type == 1) result = result$outlierIndex
else graph = TRUE
} else if(index == 5) {
if(type == 0) result = result$scores
else if(type == 1) result = result$loadings
else if(type == 2) result = result$eigenvalues
else graph = TRUE
}
if(graph) plot(result)
else if(outputFileRadio$getActive() == TRUE) {
outputFileName = outputFile$getText()
if(nchar(outputFileName)<1) return(error("You must specify output file"))
res <- try(write.table(result, outputFileName))
if(class(res) == "try-error") return(error("Error writing into file"))
else print("Data written into file")
} else if(outputVariableRadio$getActive() == TRUE) {
outputVariableName = outputVariable$getText()
if(nchar(outputVariableName)<1) return(error("You must specify output variable"))
res <- try(assign(outputVariableName, result, 1))
if(class(res) == "try-error") return(error("Cannot write data into given variable"))
else print("Data written into variable")
} else if(outputConsoleRadio$getActive() == TRUE) {
print(result)
} else {
return(error("Output not specified"))
}
}
gSignalConnect(runButton, "clicked", run)
outputTypeChange = function(d) {
sens = ((outputTypeCombo$getActive() != 2 || composition$getActive() != 4) && (composition$getActive() != 5 || outputTypeCombo$getActive() != 3))
outputFileRadio$setSensitive(sens)
outputVariableRadio$setSensitive(sens)
outputConsoleRadio$setSensitive(sens)
outputFile$setSensitive(sens)
outputVariable$setSensitive(sens)
outputBrowse$setSensitive(sens)
}
gSignalConnect(outputTypeCombo, "changed", outputTypeChange)
getLists = function() {
globals = c()
for(name in objects(".GlobalEnv")) {
obj = get(name)
if(is.matrix(obj) || is.data.frame(obj) || is.vector(obj)) globals = c(globals, name)
}
labels = unique(sort(c(globals, data()[3]$results[,3])))
labels
}
combovars = c()
combovars2 = c()
varcombo = function(d) {
labels = getLists()
if(!identical(combovars, labels)) {
for(i in 0:length(combovars)) inputVariable$removeText(0)
for(label in labels) inputVariable$appendText(label)
combovars <<- labels
}
}
varcombo2 = function(d) {
labels = getLists()
if(!identical(combovars2, labels)) {
for(i in 0:length(combovars2)) input2Variable$removeText(0)
for(label in labels) input2Variable$appendText(label)
combovars2 <<- labels
}
}
gSignalConnect(inputVariable, "popup", varcombo)
gSignalConnect(input2Variable, "popup", varcombo2)
# configuration
menubar = gtkMenuBarNew()
menuConfigItem <- gtkMenuItemNewWithLabel("Configuration")
menuConfig <- gtkMenuNew();
menuSaveItem <- gtkMenuItemNewWithLabel("save")
menuLoadItem <- gtkMenuItemNewWithLabel("load")
menubar$append(menuConfigItem)
menuConfigItem$setSubmenu(menuConfig)
menuConfig$append(menuSaveItem)
menuConfig$append(menuLoadItem)
saveConfig = function() {
methodRadio = if(methodRobust$getActive()) "robust" else "standard"
inputRadio = if(inputFileRadio$getActive()) "file" else "variable"
input2Radio = if(input2FileRadio$getActive()) "file" else "variable"
outputRadio = if(outputFileRadio$getActive()) "file" else
if(outputVariableRadio$getActive()) "variable" else "console"
c("robGUI configuration 001", nonnull(composition$getActiveText()), nonnull(compositionVariant$getActiveText()), constSum$getText(), ivar$getText(), quantile$getText(), methodRadio,
inputRadio, inputFile$getText(), nonnull(inputVariable$getActiveText()), input2Radio, input2File$getText(), nonnull(input2Variable$getActiveText()),
outputRadio, outputFile$getText(), outputVariable$getText(), nonnull(outputTypeCombo$getActiveText()))
}
loadConfig = function(config) {
config = config[,1]
if(config[1] != "robGUI configuration 001") return(error("this is not a valid robGUI config file"))
setActiveText(composition, config[2])
setActiveText(compositionVariant, config[3])
constSum$setText(config[4])
ivar$setText(config[5])
quantile$setText(config[6])
methodRobust$setActive(config[7] == "robust")
methodStandard$setActive(config[7] == "standard")
inputFileRadio$setActive(config[8] == "file")
inputVariableRadio$setActive(config[8] == "variable")
inputFile$setText(config[9])
inputVariable$getChild()$setText(config[10])
input2FileRadio$setActive(config[11] == "file")
input2VariableRadio$setActive(config[11] == "variable")
input2File$setText(config[12])
input2Variable$getChild()$setText(config[13])
outputFileRadio$setActive(config[14] == "file")
outputVariableRadio$setActive(config[14] == "variable")
outputConsoleRadio$setActive(config[14] == "console")
outputFile$setText(config[15])
outputVariable$setText(config[16])
compositionChanged(NULL)
setActiveText(outputTypeCombo, config[17])
}
saveClicked = function(d) {
dialog <- gtkFileChooserDialogNew("Select output configuration file", NULL, "save",
"gtk-cancel", GtkResponseType["cancel"],
"gtk-open", GtkResponseType["accept"])
if (dialog$run() == GtkResponseType["accept"]) {
result = try(write.table(saveConfig(),dialog$getFilename()))
if(class(result) == "try-error") error(result)
}
dialog$destroy()
}
gSignalConnect(menuSaveItem, "activate", saveClicked)
loadClicked = function(d) {
dialog <- gtkFileChooserDialogNew("Select input configuration file", NULL, "open",
"gtk-cancel", GtkResponseType["cancel"],
"gtk-open", GtkResponseType["accept"])
if (dialog$run() == GtkResponseType["accept"]) {
result = try(read.table(dialog$getFilename()))
if(class(result) == "try-error") error(result)
else loadConfig(result)
}
dialog$destroy()
}
gSignalConnect(menuLoadItem, "activate", loadClicked)
compositionChanged(NULL)
varcombo()
varcombo2()
# show all
allBox = boxObject("v", F, 0, c(menubar, compositionFrame, inputFrame, input2Frame, outputFrame, buttonAlign), c(F,F,F,F,F,T), c(F,F,F,F,F,T), c(0,0,0,0,0,0))
allBox$setSizeRequest(400,500)
window$add(allBox)
window$show()
window$move(window$getScreen()$getWidth()-500,100)
window$setResizable(FALSE)
}
#robGUI()