https://github.com/cran/robCompositions
Raw File
Tip revision: 2849c21e86f029263deccdfbbeccb0d7cb9e6e2e authored by Matthias Templ on 06 May 2011, 05:59:55 UTC
version 1.5.0
Tip revision: 2849c21
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()


back to top