Nothing
#' A graphical user interface for the package mdir.logrank
#'
#' This function provides a graphical user interface for calculating
#' multiple-direction logrank test for the two-sided and the one-sided
#' testing problem.
#'
#'
#' @aliases GUI
#'
#' @export
calculateGUI <- function(){
#require("RGtk2", quietly = TRUE)
requireNamespace("RGtk2", quietly = TRUE)
if(!("package:RGtk2" %in% search())){attachNamespace("RGtk2")}
# Create window
window <- RGtk2::gtkWindow()
# Add title
window["title"] <- "Multiple-direction logrank test"
# Add a frame
frame <- RGtk2::gtkFrameNew("Choose between the one-sided and the two-sided testing problem")
window$add(frame)
# Create vertical container for file name entry
vbox <- RGtk2::gtkVBoxNew(FALSE, 8)
vbox$setBorderWidth(24)
frame$add(vbox)
#Add horizontal box
hbox <- RGtk2::gtkHBoxNew(FALSE, 5)
vbox$packStart(hbox, FALSE, FALSE, 0)
# Add "Testing problem: ":
label <- RGtk2::gtkLabelNewWithMnemonic("Testing problem: ")
hbox$packStart(label, FALSE, FALSE, 0)
#Add combobox
choices <- RGtk2::rGtkDataFrame(c(" One-sided ", " Two-sided "))
hbox$packStart
combobox <- RGtk2::gtkComboBox(choices)
crt <- RGtk2::gtkCellRendererText()
combobox$packStart(crt)
combobox$addAttribute(crt, "text", 0)
RGtk2::gtkComboBoxSetActive(combobox,0)
hbox$packStart(combobox, expand = FALSE) # Expend = FALSE ensures that the size for the combobox is exactly the size of the choices.
######
the.buttons <- RGtk2::gtkHButtonBoxNew()
the.buttons$setBorderWidth(5)
vbox$add(the.buttons)
the.buttons$setLayout("spread")
the.buttons$setSpacing(40)
buttonOK <- RGtk2::gtkButtonNewFromStock("gtk-ok")
the.buttons$packStart(buttonOK, fill=F)
buttonCancel <- RGtk2::gtkButtonNewFromStock("gtk-close")
the.buttons$packStart(buttonCancel, fill=F)
# Function for ok-button
functionOK <- function(button, user.data){
out_combo <- RGtk2::gtkComboBoxGetActive(combobox)
if (out_combo == 1){
calculateGUI_twosided()
}else{
calculateGUI_onesided()
}
}
#By clicking the ok-button the window is closed and the functionOK is activated
RGtk2::gSignalConnect(buttonOK, "clicked", functionOK )
RGtk2::gSignalConnect(buttonOK, "clicked", window$destroy)
RGtk2::gSignalConnect(buttonCancel, "clicked", window$destroy)
}
#################################################################
###################################################################
############# GUI for two-sided testing problem ##################
###################################################################
###################################################################
calculateGUI_twosided <- function(){
#require("RGtk2", quietly = TRUE)
requireNamespace("RGtk2", quietly = TRUE)
if(!("package:RGtk2" %in% search())){attachNamespace("RGtk2")}
# Create window
window <- RGtk2::gtkWindow()
# Add title
window["title"] <- "Two-sided permutation test"
# Add a frame
frame <- RGtk2::gtkFrameNew("Specify the settings")
window$add(frame)
# Create vertical container for file name entry
vbox <- RGtk2::gtkVBoxNew(FALSE, 8)
vbox$setBorderWidth(24)
frame$add(vbox)
# Add a sub-frame to vbox
frame <- RGtk2::gtkFrameNew("Specify the data location")
vbox$add(frame)
# Add a vertical box to this sub-frame
vbox1 <- RGtk2::gtkVBoxNew(FALSE, 8)
vbox1$setBorderWidth(24)
frame$add(vbox1)
# Add Filename
hbox <- RGtk2::gtkHBoxNew(FALSE, 8)
vbox1$packStart(hbox, FALSE, FALSE, 0)
label <- RGtk2::gtkLabelNewWithMnemonic("_File name")
hbox$packStart(label, FALSE, FALSE, 0)
# Add entry named "filename"
filename <- RGtk2::gtkEntryNew()
filename$setWidthChars(50)
label$setMnemonicWidget(filename)
hbox$packStart(filename, FALSE, FALSE, 0)
#The data always need a header, otherwise, your function does not work.
#Thus, the question "Headers?" is not needed.
##Add the Text "Headers?"
hbox <- RGtk2::gtkHBoxNew(FALSE, 8)
vbox1$packStart(hbox, FALSE, FALSE, 0)
#label <- RGtk2::gtkLabelNewWithMnemonic("_Headers?")
#hbox$packStart(label, FALSE, FALSE, 0)
#Add the checkbox for the question "Headers?"
#headersEntry <- RGtk2::gtkCheckButton()
#headersEntry$active <- TRUE
#hbox$packStart(headersEntry, FALSE, FALSE, 0)
#label$setMnemonicWidget(headersEntry)
# what separator is used?
label <- RGtk2::gtkLabelNewWithMnemonic("Col. _Separator?")
hbox$packStart(label, FALSE, FALSE, 0)
sepEntry <- RGtk2::gtkEntryNew()
sepEntry$setWidthChars(1)
sepEntry$setText(",")
hbox$packStart(sepEntry, FALSE, FALSE, 0)
label$setMnemonicWidget(sepEntry)
# what's the character used for decimal points?
label <- RGtk2::gtkLabelNewWithMnemonic("_Dec. character?")
hbox$packStart(label, FALSE, FALSE, 0)
decEntry <- RGtk2::gtkEntryNew()
decEntry$setWidthChars(1)
decEntry$setText(".")
hbox$packStart(decEntry, FALSE, FALSE, 0)
label$setMnemonicWidget(decEntry)
######DIRECTION-FRAME----------------------------
# Add a sub-frame to vbox
frame <- RGtk2::gtkFrameNew("Specify the directions")
vbox$add(frame)
# Add a vertical box to this sub-frame
vbox1 <- RGtk2::gtkVBoxNew(FALSE, 8)
vbox1$setBorderWidth(24)
frame$add(vbox1)
#Add the horizontal box
hbox <- RGtk2::gtkHBoxNew(FALSE, 8)
vbox1$packStart(hbox, FALSE, FALSE, 0)
#Add Proportional? + check box
label <- RGtk2::gtkLabelNewWithMnemonic("Proportional?")
hbox$packStart(label, FALSE, FALSE, 0)
propEntry <- RGtk2::gtkCheckButton()
propEntry$active <- TRUE
hbox$packStart(propEntry, FALSE, FALSE, 0)
label$setMnemonicWidget(propEntry)
#Add Crossing? + check box
label <- RGtk2::gtkLabelNewWithMnemonic("Crossing?")
hbox$packStart(label, FALSE, FALSE, 0)
crossingEntry <- RGtk2::gtkCheckButton()
crossingEntry$active <- TRUE
hbox$packStart(crossingEntry, FALSE, FALSE, 0)
label$setMnemonicWidget(crossingEntry)
#Add Early? + check box
label <- RGtk2::gtkLabelNewWithMnemonic("Early?")
hbox$packStart(label, FALSE, FALSE, 0)
earlyEntry <- RGtk2::gtkCheckButton()
hbox$packStart(earlyEntry, FALSE, FALSE, 0)
label$setMnemonicWidget(earlyEntry)
#Add Late? + check box
label <- RGtk2::gtkLabelNewWithMnemonic("Late?")
hbox$packStart(label, FALSE, FALSE, 0)
lateEntry <- RGtk2::gtkCheckButton()
hbox$packStart(lateEntry, FALSE, FALSE, 0)
label$setMnemonicWidget(lateEntry)
#Add Late? + check box
label <- RGtk2::gtkLabelNewWithMnemonic("Central?")
hbox$packStart(label, FALSE, FALSE, 0)
centralEntry <- RGtk2::gtkCheckButton()
hbox$packStart(centralEntry, FALSE, FALSE, 0)
label$setMnemonicWidget(centralEntry)
#Add horizontal box
hbox <- RGtk2::gtkHBoxNew(FALSE, 8)
vbox1$packStart(hbox, FALSE, FALSE, 0)
#Add question
label <- RGtk2::gtkLabelNewWithMnemonic("_User specified directions of the form w(x) = x^r * (1-x)^g:")
hbox$packStart(label, FALSE, FALSE, 0)
####COMBOBOXES----------------------------------------------
#Add horizontal box
hbox <- RGtk2::gtkHBoxNew(FALSE, 8)
vbox1$packStart(hbox, FALSE, FALSE, 0)
# Add "r":
label <- RGtk2::gtkLabelNewWithMnemonic("_r: ")
hbox$packStart(label, FALSE, FALSE, 0)
#Add 1.combobox for the choice of r
choices.vect <- 0:20 # How many different r,g can be chosen
choices <- RGtk2::rGtkDataFrame(c("", as.character(choices.vect)))
comboboxr1 <- RGtk2::gtkComboBox(choices)
crt <- RGtk2::gtkCellRendererText()
comboboxr1$packStart(crt)
comboboxr1$addAttribute(crt, "text", 0)
RGtk2::gtkComboBoxSetActive(comboboxr1,0)
hbox$packStart(comboboxr1)
#Add 2.combobox for the choice of r
comboboxr2 <- RGtk2::gtkComboBox(choices)
crt <- RGtk2::gtkCellRendererText()
comboboxr2$packStart(crt)
comboboxr2$addAttribute(crt, "text", 0)
RGtk2::gtkComboBoxSetActive(comboboxr2,0)
hbox$packStart(comboboxr2)
#Add 3.combobox for the choice of r
comboboxr3 <- RGtk2::gtkComboBox(choices)
crt <- RGtk2::gtkCellRendererText()
comboboxr3$packStart(crt)
comboboxr3$addAttribute(crt, "text", 0)
RGtk2::gtkComboBoxSetActive(comboboxr3,0)
hbox$packStart(comboboxr3)
#Add 4.combobox for the choice of r
comboboxr4 <- RGtk2::gtkComboBox(choices)
crt <- RGtk2::gtkCellRendererText()
comboboxr4$packStart(crt)
comboboxr4$addAttribute(crt, "text", 0)
RGtk2::gtkComboBoxSetActive(comboboxr4,0)
hbox$packStart(comboboxr4)
#Add 5.combobox for the choice of r
comboboxr5 <- RGtk2::gtkComboBox(choices)
crt <- RGtk2::gtkCellRendererText()
comboboxr5$packStart(crt)
comboboxr5$addAttribute(crt, "text", 0)
RGtk2::gtkComboBoxSetActive(comboboxr5,0)
hbox$packStart(comboboxr5)
#Add 6.combobox for the choice of r
comboboxr6 <- RGtk2::gtkComboBox(choices)
crt <- RGtk2::gtkCellRendererText()
comboboxr6$packStart(crt)
comboboxr6$addAttribute(crt, "text", 0)
RGtk2::gtkComboBoxSetActive(comboboxr6,0)
hbox$packStart(comboboxr6)
#Add 7.combobox for the choice of r
comboboxr7 <- RGtk2::gtkComboBox(choices)
crt <- RGtk2::gtkCellRendererText()
comboboxr7$packStart(crt)
comboboxr7$addAttribute(crt, "text", 0)
RGtk2::gtkComboBoxSetActive(comboboxr7,0)
hbox$packStart(comboboxr7)
#Add horizontal box
hbox <- RGtk2::gtkHBoxNew(FALSE, 8)
vbox1$packStart(hbox, FALSE, FALSE, 0)
# Add "g":
label <- RGtk2::gtkLabelNewWithMnemonic("_g:")
hbox$packStart(label, FALSE, FALSE, 0)
#Add 1.combobox for the choice of g
comboboxg1 <- RGtk2::gtkComboBox(choices)
crt <- RGtk2::gtkCellRendererText()
comboboxg1$packStart(crt)
comboboxg1$addAttribute(crt, "text", 0)
RGtk2::gtkComboBoxSetActive(comboboxg1,0)
hbox$packStart(comboboxg1)
#Add 2.combobox for the choice of g
comboboxg2 <- RGtk2::gtkComboBox(choices)
crt <- RGtk2::gtkCellRendererText()
comboboxg2$packStart(crt)
comboboxg2$addAttribute(crt, "text", 0)
RGtk2::gtkComboBoxSetActive(comboboxg2,0)
hbox$packStart(comboboxg2)
#Add 3.combobox for the choice of g
comboboxg3 <- RGtk2::gtkComboBox(choices)
crt <- RGtk2::gtkCellRendererText()
comboboxg3$packStart(crt)
comboboxg3$addAttribute(crt, "text", 0)
RGtk2::gtkComboBoxSetActive(comboboxg3,0)
hbox$packStart(comboboxg3)
#Add 4.combobox for the choice of g
comboboxg4 <- RGtk2::gtkComboBox(choices)
crt <- RGtk2::gtkCellRendererText()
comboboxg4$packStart(crt)
comboboxg4$addAttribute(crt, "text", 0)
RGtk2::gtkComboBoxSetActive(comboboxg4,0)
hbox$packStart(comboboxg4)
#Add 5.combobox for the choice of g
comboboxg5 <- RGtk2::gtkComboBox(choices)
crt <- RGtk2::gtkCellRendererText()
comboboxg5$packStart(crt)
comboboxg5$addAttribute(crt, "text", 0)
RGtk2::gtkComboBoxSetActive(comboboxg5,0)
hbox$packStart(comboboxg5)
#Add 6.combobox for the choice of g
comboboxg6 <- RGtk2::gtkComboBox(choices)
crt <- RGtk2::gtkCellRendererText()
comboboxg6$packStart(crt)
comboboxg6$addAttribute(crt, "text", 0)
RGtk2::gtkComboBoxSetActive(comboboxg6,0)
hbox$packStart(comboboxg6)
#Add 7.combobox for the choice of g
comboboxg7 <- RGtk2::gtkComboBox(choices)
crt <- RGtk2::gtkCellRendererText()
comboboxg7$packStart(crt)
comboboxg7$addAttribute(crt, "text", 0)
RGtk2::gtkComboBoxSetActive(comboboxg7,0)
hbox$packStart(comboboxg7)
## Simulation setting---------------------------------------------------------------
frame <- RGtk2::gtkFrameNew("Specify the simulation settings")
vbox$add(frame)
# Add a vertical box to this sub-frame
vbox1 <- RGtk2::gtkVBoxNew(FALSE, 8)
vbox1$setBorderWidth(24)
frame$add(vbox1)
# Add a horizontal box
hbox <- RGtk2::gtkHBoxNew(FALSE, 8)
vbox1$packStart(hbox, FALSE, FALSE, 0)
# Add nperm name
label <- RGtk2::gtkLabelNewWithMnemonic("_permutation iterations")
hbox$packStart(label, FALSE, FALSE, 0)
# Add entry for nperm
nperm <- RGtk2::gtkEntryNew()
nperm$setWidthChars(7)
nperm$setText(10000)
label$setMnemonicWidget(nperm)
hbox$packStart(nperm, FALSE, FALSE, 0)
# Add digit for p-values perm name
label <- RGtk2::gtkLabelNewWithMnemonic("digits for p-values")
hbox$packStart(label, FALSE, FALSE, 0)
# Add entry for digpval
digpval <- RGtk2::gtkEntryNew()
digpval$setWidthChars(2)
digpval$setText(3)
label$setMnemonicWidget(digpval)
hbox$packStart(digpval, FALSE, FALSE, 0)
# Add digitstat name
label <- RGtk2::gtkLabelNewWithMnemonic("digits for statistic")
hbox$packStart(label, FALSE, FALSE, 0)
# Add entry for digstat
digstat <- RGtk2::gtkEntryNew()
digstat$setWidthChars(2)
digstat$setText(3)
label$setMnemonicWidget(digstat)
hbox$packStart(digstat, FALSE, FALSE, 0)
## RESULTS---------------------------------------------------------------------
frame <- RGtk2::gtkFrameNew("Results")
vbox$add(frame)
# Add a vertical box to this sub-frame
vbox1 <- RGtk2::gtkVBoxNew(FALSE, 8)
vbox1$setBorderWidth(24)
frame$add(vbox1)
# Add a horizontal box
hbox <- RGtk2::gtkHBoxNew(FALSE, 8)
vbox1$packStart(hbox, FALSE, FALSE, 0)
# Add wait name
label <- RGtk2::gtkLabelNewWithMnemonic("Notifications: ")
hbox$packStart(label, FALSE, FALSE, 0)
# Add wait field
wait <- RGtk2::gtkEntryNew()
wait$setWidthChars(50)
label$setMnemonicWidget(wait)
hbox$packStart(wait, FALSE, FALSE, 0)
# Add a horizontal box
hbox <- RGtk2::gtkHBoxNew(FALSE, 8)
vbox1$packStart(hbox, FALSE, FALSE, 0)
# Add pval Approx name
label <- RGtk2::gtkLabelNewWithMnemonic("p-value (Approx.)")
hbox$packStart(label, FALSE, FALSE, 0)
# Add entry for p-value (Approx)
pvalappr <- RGtk2::gtkEntryNew()
pvalappr$setWidthChars(7)
label$setMnemonicWidget(pvalappr)
hbox$packStart(pvalappr, FALSE, FALSE, 0)
# Add entry for p-value (Perm)
label <- RGtk2::gtkLabelNewWithMnemonic("p-value (Perm.)")
hbox$packStart(label, FALSE, FALSE, 0)
# Add entry for p-value (Perm.)
pvalper <- RGtk2::gtkEntryNew()
pvalper$setWidthChars(7)
label$setMnemonicWidget(pvalper)
hbox$packStart(pvalper, FALSE, FALSE, 0)
# Add test statistic
label <- RGtk2::gtkLabelNewWithMnemonic("test statistic")
hbox$packStart(label, FALSE, FALSE, 0)
# Add entry for test statistic
tstat <- RGtk2::gtkEntryNew()
tstat$setWidthChars(7)
label$setMnemonicWidget(tstat)
hbox$packStart(tstat, FALSE, FALSE, 0)
# The buttons--------------------------------------------------------------------------------
the.buttons <- RGtk2::gtkHButtonBoxNew()
the.buttons$setBorderWidth(5)
vbox$add(the.buttons)
the.buttons$setLayout("spread")
the.buttons$setSpacing(40)
buttonOK <- RGtk2::gtkButtonNewFromStock("gtk-ok")
buttonLoad <- RGtk2::gtkButtonNewFromStock("load data")
the.buttons$packStart(buttonOK, fill=F)
the.buttons$packStart(buttonLoad, fill=F)
buttonCancel <- RGtk2::gtkButtonNewFromStock("gtk-close")
the.buttons$packStart(buttonCancel, fill=F)
### Function for button load
getDirectory <- function(button, user.data){
directory <- file.choose()
RGtk2::gtkEntrySetText(filename, directory)
}
## Function for button Start calculation
performStatistics <- function(button, user.data) {
extra.fun <- function(){
# Alle the code is in an separate function since we want to
# apply tryCatch latter.
wait$setText("Calculating, wait please...")
res <- NULL
d <- NULL
# Get the information about data and the file
the.file <- filename$getText()
if (the.file == ""){
wait$setText("ERROR: Specifiy filename or load data!")
return(0)
}
the.perm <- as.numeric(nperm$getText())
the.digp <- as.numeric(digpval$getText())
the.digs <- as.numeric(digstat$getText())
the.sep <- sepEntry$getText()
#the.headers <- headersEntry$active # not needed for our situation
the.dec <- decEntry$getText()
tryCatch(
d <- read.table(the.file, sep = the.sep, header = TRUE,
dec = the.dec),
error = function(e){
wait$setText("ERROR: Problems with reading the data")
return(0)
}
)
if( sum(c("time","group","event") %in% names(d)) != 3){
# Note that a misspecification of sep or dec may also lead here to
# an error, that is why we prefer this error text instead of a more
# specific one
wait$setText("ERROR: Problems with reading the data!")
return()
}
lev_group <- levels( as.factor(d$group))
if ( length(lev_group) != 2){
wait$setText("ERROR: There are either more or less than 2 groups!")
return()
}
the.prop <- propEntry$active
the.central <- centralEntry$active
the.early <- earlyEntry$active
the.late <- lateEntry$active
the.crossing <- crossingEntry$active
# Produce list rg
comboboxr <- list( comboboxr1, comboboxr2, comboboxr3,
comboboxr4, comboboxr5, comboboxr6,
comboboxr7)
comboboxg <- list( comboboxg1, comboboxg2, comboboxg3,
comboboxg4, comboboxg5, comboboxg6,
comboboxg7)
rg <- list()
for (i in 1:7){
r <- RGtk2::gtkComboBoxGetActive(comboboxr[[i]])
g <- RGtk2::gtkComboBoxGetActive(comboboxg[[i]])
if (r*g == 0 && r+g > 0){
# In this case only r or g are specificed for the corresponding direction
# ->error
# Note that also "" can be choosen. Hence, the value 0
# represent that nothing is chosen.
wait$setText("ERROR: Choose r and g for each user specified direction!")
return()
}
if( r>0 && g>0){ # Both exponents are specified
rg <- c( rg, list(c(r-1, g-1)) )
}
}
if ( the.prop == TRUE){ rg <- c(rg, list( c(0, 0) )) }
if ( the.early == TRUE){ rg <- c(rg, list( c(1, 5) ))}
if ( the.late == TRUE){ rg <- c(rg, list( c(5, 1) ))}
if ( the.central == TRUE){ rg <- c(rg, list( c(1, 1) ))}
if ( length(rg) == 0){ rg <- NULL}
res <- mdir.logrank(data = d, cross = the.crossing, rg = rg, nperm =
the.perm, dig_p = the.digp, dig_stat = the.digs)
wait.test <- substring( wait$getText(),1, 5) # Check if there is already an error
if( wait.test != "ERROR"){
wait$setText("Done")
}
pvalappr$setText( res$p_value$Approx)
pvalper$setText( res$p_value$Perm)
tstat$setText( res$stat)
} # END of extra.fun
match.fun(extra.fun)
tryCatch( extra.fun()
, error = function(e){
# If there is some ERROR in extra.fun() then the
# error function becomes active
wait.test <- substring( wait$getText(),1, 5) # Check if there is already an error
if( wait.test != "ERROR"){
wait$setText("ERROR. Please check the settings!")
}
}
) # End of tryCatch
}
## Activate buttons
RGtk2::gSignalConnect(buttonOK, "clicked", performStatistics)
RGtk2::gSignalConnect(buttonLoad, "clicked", getDirectory)
RGtk2::gSignalConnect(buttonCancel, "clicked", window$destroy)
}
###################################################################
###################################################################
############# GUI for the one-sided testing problem ###############
###################################################################
###################################################################
calculateGUI_onesided <- function(){
#require("RGtk2", quietly = TRUE)
requireNamespace("RGtk2", quietly = TRUE)
if(!("package:RGtk2" %in% search())){attachNamespace("RGtk2")}
# Create window
window <- RGtk2::gtkWindow()
# Add title
window["title"] <- "One-sided wild bootstrap test"
# Add a frame
frame <- RGtk2::gtkFrameNew("Specify the settings")
window$add(frame)
# Create vertical container for file name entry
vbox <- RGtk2::gtkVBoxNew(FALSE, 8)
vbox$setBorderWidth(24)
frame$add(vbox)
# Add a sub-frame to vbox
frame <- RGtk2::gtkFrameNew("Specify the data location")
vbox$add(frame)
# Add a vertical box to this sub-frame
vbox1 <- RGtk2::gtkVBoxNew(FALSE, 8)
vbox1$setBorderWidth(24)
frame$add(vbox1)
# Add Filename
hbox <- RGtk2::gtkHBoxNew(FALSE, 8)
vbox1$packStart(hbox, FALSE, FALSE, 0)
label <- RGtk2::gtkLabelNewWithMnemonic("_File name")
hbox$packStart(label, FALSE, FALSE, 0)
# Add entry named "filename"
filename <- RGtk2::gtkEntryNew()
filename$setWidthChars(50)
label$setMnemonicWidget(filename)
hbox$packStart(filename, FALSE, FALSE, 0)
#Add button to load the data
buttonLoad <- RGtk2::gtkButtonNewFromStock("load data")
hbox$packStart(buttonLoad, FALSE, FALSE, 0)
getDirectory <- function(button, user.data){
directory <- file.choose()
RGtk2::gtkEntrySetText(filename, directory)
}
RGtk2::gSignalConnect(buttonLoad, "clicked", getDirectory)
#The data always need a header, otherwise, your function does not work.
#Thus, the question "Headers?" is not needed.
##Add the Text "Headers?"
hbox <- RGtk2::gtkHBoxNew(FALSE, 8)
vbox1$packStart(hbox, FALSE, FALSE, 0)
#label <- RGtk2::gtkLabelNewWithMnemonic("_Headers?")
#hbox$packStart(label, FALSE, FALSE, 0)
#Add the checkbox for the question "Headers?"
#headersEntry <- RGtk2::gtkCheckButton()
#headersEntry$active <- TRUE
#hbox$packStart(headersEntry, FALSE, FALSE, 0)
#label$setMnemonicWidget(headersEntry)
# what separator is used?
label <- RGtk2::gtkLabelNewWithMnemonic("Col. _Separator?")
hbox$packStart(label, FALSE, FALSE, 0)
sepEntry <- RGtk2::gtkEntryNew()
sepEntry$setWidthChars(1)
sepEntry$setText(",")
hbox$packStart(sepEntry, FALSE, FALSE, 0)
label$setMnemonicWidget(sepEntry)
# what's the character used for decimal points?
label <- RGtk2::gtkLabelNewWithMnemonic("_Dec. character?")
hbox$packStart(label, FALSE, FALSE, 0)
decEntry <- RGtk2::gtkEntryNew()
decEntry$setWidthChars(1)
decEntry$setText(".")
hbox$packStart(decEntry, FALSE, FALSE, 0)
label$setMnemonicWidget(decEntry)
#new horizontal
hbox <- RGtk2::gtkHBoxNew(FALSE, 8)
vbox1$packStart(hbox, FALSE, FALSE, 0)
#Add Group 1 name text
label <- RGtk2::gtkLabelNewWithMnemonic("Specify the first group:")
hbox$packStart(label, FALSE, FALSE, 0)
#Add an empty combobox which can be manipuled later by the commands
# gtkComboBoxAppendText, gtkComboBoxRemoveText, gtkComboBoxPrependText (see below)
combogroup1 <- RGtk2::gtkComboBoxNewText()
hbox$packStart(combogroup1)
#new horizontal
hbox <- RGtk2::gtkHBoxNew(FALSE, 8)
vbox1$packStart(hbox, FALSE, FALSE, 0)
# Add Text instruction for group1
label <- RGtk2::gtkLabelNewWithMnemonic("Extract the group names from the data: ")
hbox$packStart(label, FALSE, FALSE, 0)
buttonExtract <- RGtk2::gtkButtonNewFromStock("Extract")
hbox$packStart(buttonExtract, fill=F)
# function for buttonExtract
functionExtract <- function(button, user.data){
the.file <- filename$getText()
if (the.file == ""){
wait$setText("ERROR: Specifiy filename or load data!")
return(0)
}
the.sep <- sepEntry$getText()
#the.headers <- headersEntry$active # not needed for our situation
the.dec <- decEntry$getText()
tryCatch(
d <- read.table(the.file, sep = the.sep, header = TRUE,
dec = the.dec),
error = function(e){
wait$setText("ERROR: Problems with reading the data")
return(0)
}
)
if( sum(c("time","group","event") %in% names(d)) != 3){
# Note that a misspecification of sep or dec may also lead here to
# an error, that is why we prefer this error text instead of a more
# specific one
wait$setText("ERROR: Problems with reading the data!")
return()
}
lev_group <- levels( as.factor(d$group))
if ( length(lev_group) != 2){
wait$setText("ERROR: There are either more or less than 2 groups!")
return()
}
#Remove the previous entries
RGtk2::gtkComboBoxRemoveText(combogroup1, 0)
RGtk2::gtkComboBoxRemoveText(combogroup1, 0)
#add the new entries
RGtk2::gtkComboBoxAppendText(combogroup1, as.character(lev_group[1]))
RGtk2::gtkComboBoxAppendText(combogroup1, as.character(lev_group[2]))
RGtk2::gtkComboBoxSetActive(combogroup1,0)
}
#Extract button clicked
RGtk2::gSignalConnect(buttonExtract, "clicked", functionExtract)
######DIRECTION-FRAME----------------------------
# Add a sub-frame to vbox
frame <- RGtk2::gtkFrameNew("Specify the directions")
vbox$add(frame)
# Add a vertical box to this sub-frame
vbox1 <- RGtk2::gtkVBoxNew(FALSE, 8)
vbox1$setBorderWidth(24)
frame$add(vbox1)
#Add the horizontal box
hbox <- RGtk2::gtkHBoxNew(FALSE, 8)
vbox1$packStart(hbox, FALSE, FALSE, 0)
#Add Proportional? + check box
label <- RGtk2::gtkLabelNewWithMnemonic("Proportional?")
hbox$packStart(label, FALSE, FALSE, 0)
propEntry <- RGtk2::gtkCheckButton()
propEntry$active <- TRUE
hbox$packStart(propEntry, FALSE, FALSE, 0)
label$setMnemonicWidget(propEntry)
#Add Early? + check box
label <- RGtk2::gtkLabelNewWithMnemonic("Early?")
hbox$packStart(label, FALSE, FALSE, 0)
earlyEntry <- RGtk2::gtkCheckButton()
earlyEntry$active <- TRUE
hbox$packStart(earlyEntry, FALSE, FALSE, 0)
label$setMnemonicWidget(earlyEntry)
#Add Late? + check box
label <- RGtk2::gtkLabelNewWithMnemonic("Late?")
hbox$packStart(label, FALSE, FALSE, 0)
lateEntry <- RGtk2::gtkCheckButton()
lateEntry$active <- TRUE
hbox$packStart(lateEntry, FALSE, FALSE, 0)
label$setMnemonicWidget(lateEntry)
#Add Late? + check box
label <- RGtk2::gtkLabelNewWithMnemonic("Central?")
hbox$packStart(label, FALSE, FALSE, 0)
centralEntry <- RGtk2::gtkCheckButton()
hbox$packStart(centralEntry, FALSE, FALSE, 0)
label$setMnemonicWidget(centralEntry)
#Add horizontal box
hbox <- RGtk2::gtkHBoxNew(FALSE, 8)
vbox1$packStart(hbox, FALSE, FALSE, 0)
#Add question
label <- RGtk2::gtkLabelNewWithMnemonic("_User specified directions of the form w(x) = x^r * (1-x)^g:")
hbox$packStart(label, FALSE, FALSE, 0)
####COMBOBOXES----------------------------------------------
#Add horizontal box
hbox <- RGtk2::gtkHBoxNew(FALSE, 8)
vbox1$packStart(hbox, FALSE, FALSE, 0)
# Add "r":
label <- RGtk2::gtkLabelNewWithMnemonic("_r: ")
hbox$packStart(label, FALSE, FALSE, 0)
#Add 1.combobox for the choice of r
choices.vect <- 0:20 # How many different r,g can be chosen
choices <- RGtk2::rGtkDataFrame(c("", as.character(choices.vect)))
comboboxr1 <- RGtk2::gtkComboBox(choices)
crt <- RGtk2::gtkCellRendererText()
comboboxr1$packStart(crt)
comboboxr1$addAttribute(crt, "text", 0)
RGtk2::gtkComboBoxSetActive(comboboxr1,0)
hbox$packStart(comboboxr1)
#Add 2.combobox for the choice of r
comboboxr2 <- RGtk2::gtkComboBox(choices)
crt <- RGtk2::gtkCellRendererText()
comboboxr2$packStart(crt)
comboboxr2$addAttribute(crt, "text", 0)
RGtk2::gtkComboBoxSetActive(comboboxr2,0)
hbox$packStart(comboboxr2)
#Add 3.combobox for the choice of r
comboboxr3 <- RGtk2::gtkComboBox(choices)
crt <- RGtk2::gtkCellRendererText()
comboboxr3$packStart(crt)
comboboxr3$addAttribute(crt, "text", 0)
RGtk2::gtkComboBoxSetActive(comboboxr3,0)
hbox$packStart(comboboxr3)
#Add 4.combobox for the choice of r
comboboxr4 <- RGtk2::gtkComboBox(choices)
crt <- RGtk2::gtkCellRendererText()
comboboxr4$packStart(crt)
comboboxr4$addAttribute(crt, "text", 0)
RGtk2::gtkComboBoxSetActive(comboboxr4,0)
hbox$packStart(comboboxr4)
#Add 5.combobox for the choice of r
comboboxr5 <- RGtk2::gtkComboBox(choices)
crt <- RGtk2::gtkCellRendererText()
comboboxr5$packStart(crt)
comboboxr5$addAttribute(crt, "text", 0)
RGtk2::gtkComboBoxSetActive(comboboxr5,0)
hbox$packStart(comboboxr5)
#Add 6.combobox for the choice of r
comboboxr6 <- RGtk2::gtkComboBox(choices)
crt <- RGtk2::gtkCellRendererText()
comboboxr6$packStart(crt)
comboboxr6$addAttribute(crt, "text", 0)
RGtk2::gtkComboBoxSetActive(comboboxr6,0)
hbox$packStart(comboboxr6)
#Add 7.combobox for the choice of r
comboboxr7 <- RGtk2::gtkComboBox(choices)
crt <- RGtk2::gtkCellRendererText()
comboboxr7$packStart(crt)
comboboxr7$addAttribute(crt, "text", 0)
RGtk2::gtkComboBoxSetActive(comboboxr7,0)
hbox$packStart(comboboxr7)
#Add horizontal box
hbox <- RGtk2::gtkHBoxNew(FALSE, 8)
vbox1$packStart(hbox, FALSE, FALSE, 0)
# Add "g":
label <- RGtk2::gtkLabelNewWithMnemonic("_g:")
hbox$packStart(label, FALSE, FALSE, 0)
#Add 1.combobox for the choice of g
comboboxg1 <- RGtk2::gtkComboBox(choices)
crt <- RGtk2::gtkCellRendererText()
comboboxg1$packStart(crt)
comboboxg1$addAttribute(crt, "text", 0)
RGtk2::gtkComboBoxSetActive(comboboxg1,0)
hbox$packStart(comboboxg1)
#Add 2.combobox for the choice of g
comboboxg2 <- RGtk2::gtkComboBox(choices)
crt <- RGtk2::gtkCellRendererText()
comboboxg2$packStart(crt)
comboboxg2$addAttribute(crt, "text", 0)
RGtk2::gtkComboBoxSetActive(comboboxg2,0)
hbox$packStart(comboboxg2)
#Add 3.combobox for the choice of g
comboboxg3 <- RGtk2::gtkComboBox(choices)
crt <- RGtk2::gtkCellRendererText()
comboboxg3$packStart(crt)
comboboxg3$addAttribute(crt, "text", 0)
RGtk2::gtkComboBoxSetActive(comboboxg3,0)
hbox$packStart(comboboxg3)
#Add 4.combobox for the choice of g
comboboxg4 <- RGtk2::gtkComboBox(choices)
crt <- RGtk2::gtkCellRendererText()
comboboxg4$packStart(crt)
comboboxg4$addAttribute(crt, "text", 0)
RGtk2::gtkComboBoxSetActive(comboboxg4,0)
hbox$packStart(comboboxg4)
#Add 5.combobox for the choice of g
comboboxg5 <- RGtk2::gtkComboBox(choices)
crt <- RGtk2::gtkCellRendererText()
comboboxg5$packStart(crt)
comboboxg5$addAttribute(crt, "text", 0)
RGtk2::gtkComboBoxSetActive(comboboxg5,0)
hbox$packStart(comboboxg5)
#Add 6.combobox for the choice of g
comboboxg6 <- RGtk2::gtkComboBox(choices)
crt <- RGtk2::gtkCellRendererText()
comboboxg6$packStart(crt)
comboboxg6$addAttribute(crt, "text", 0)
RGtk2::gtkComboBoxSetActive(comboboxg6,0)
hbox$packStart(comboboxg6)
#Add 7.combobox for the choice of g
comboboxg7 <- RGtk2::gtkComboBox(choices)
crt <- RGtk2::gtkCellRendererText()
comboboxg7$packStart(crt)
comboboxg7$addAttribute(crt, "text", 0)
RGtk2::gtkComboBoxSetActive(comboboxg7,0)
hbox$packStart(comboboxg7)
## Simulation setting---------------------------------------------------------------
frame <- RGtk2::gtkFrameNew("Specify the simulation settings")
vbox$add(frame)
# Add a vertical box to this sub-frame
vbox1 <- RGtk2::gtkVBoxNew(FALSE, 8)
vbox1$setBorderWidth(24)
frame$add(vbox1)
# Add a horizontal box
hbox <- RGtk2::gtkHBoxNew(FALSE, 8)
vbox1$packStart(hbox, FALSE, FALSE, 0)
# Add iter name
label <- RGtk2::gtkLabelNewWithMnemonic("_wild bootstrap iterations")
hbox$packStart(label, FALSE, FALSE, 0)
# Add entry for iter
iter <- RGtk2::gtkEntryNew()
iter$setWidthChars(7)
iter$setText(10000)
label$setMnemonicWidget(iter)
hbox$packStart(iter, FALSE, FALSE, 0)
# Add digit for p-values perm name
label <- RGtk2::gtkLabelNewWithMnemonic("digits for p-value")
hbox$packStart(label, FALSE, FALSE, 0)
# Add entry for digpval
digpval <- RGtk2::gtkEntryNew()
digpval$setWidthChars(2)
digpval$setText(3)
label$setMnemonicWidget(digpval)
hbox$packStart(digpval, FALSE, FALSE, 0)
# Add digitstat name
label <- RGtk2::gtkLabelNewWithMnemonic("digits for statistic")
hbox$packStart(label, FALSE, FALSE, 0)
# Add entry for digstat
digstat <- RGtk2::gtkEntryNew()
digstat$setWidthChars(2)
digstat$setText(3)
label$setMnemonicWidget(digstat)
hbox$packStart(digstat, FALSE, FALSE, 0)
# Add a horizontal box
hbox1 <- RGtk2::gtkHBoxNew(FALSE, 8)
vbox1$packStart(hbox1, FALSE, FALSE, 0)
# Add wild name
label <- RGtk2::gtkLabelNewWithMnemonic("wild bootstrap type")
hbox1$packStart(label, FALSE, FALSE, 0)
#Combobox for wild
choices_wild <- RGtk2::rGtkDataFrame(c(" Rademacher ", " Normal ", " Poisson "))
comboboxwild <- RGtk2::gtkComboBox(choices_wild)
crt <- RGtk2::gtkCellRendererText()
comboboxwild$packStart(crt)
comboboxwild$addAttribute(crt, "text", 0)
RGtk2::gtkComboBoxSetActive(comboboxwild,0)
hbox1$packStart(comboboxwild, expand = FALSE)
## RESULTS---------------------------------------------------------------------
frame <- RGtk2::gtkFrameNew("Results")
vbox$add(frame)
# Add a vertical box to this sub-frame
vbox1 <- RGtk2::gtkVBoxNew(FALSE, 8)
vbox1$setBorderWidth(24)
frame$add(vbox1)
# Add a horizontal box
hbox <- RGtk2::gtkHBoxNew(FALSE, 8)
vbox1$packStart(hbox, FALSE, FALSE, 0)
# Add wait name
label <- RGtk2::gtkLabelNewWithMnemonic("Notifications: ")
hbox$packStart(label, FALSE, FALSE, 0)
# Add wait field
wait <- RGtk2::gtkEntryNew()
wait$setWidthChars(60)
label$setMnemonicWidget(wait)
hbox$packStart(wait, FALSE, FALSE, 0)
# Add a horizontal box
hbox <- RGtk2::gtkHBoxNew(FALSE, 8)
vbox1$packStart(hbox, FALSE, FALSE, 0)
# Add name for p-value
label <- RGtk2::gtkLabelNewWithMnemonic("p-value")
hbox$packStart(label, FALSE, FALSE, 0)
# Add empty box for p-value
pval <- RGtk2::gtkEntryNew()
pval$setWidthChars(10)
label$setMnemonicWidget(pval)
hbox$packStart(pval, FALSE, FALSE, 0)
# Add test statistic
label <- RGtk2::gtkLabelNewWithMnemonic("test statistic")
hbox$packStart(label, FALSE, FALSE, 0)
# Add entry for test statistic
tstat <- RGtk2::gtkEntryNew()
tstat$setWidthChars(7)
label$setMnemonicWidget(tstat)
hbox$packStart(tstat, FALSE, FALSE, 0)
# The buttons--------------------------------------------------------------------------------
the.buttons <- RGtk2::gtkHButtonBoxNew()
the.buttons$setBorderWidth(5)
vbox$add(the.buttons)
the.buttons$setLayout("spread")
the.buttons$setSpacing(40)
buttonOK <- RGtk2::gtkButtonNewFromStock("gtk-ok")
the.buttons$packStart(buttonOK, fill=F)
buttonCancel <- RGtk2::gtkButtonNewFromStock("gtk-close")
the.buttons$packStart(buttonCancel, fill=F)
## Function for button Start calculation
performStatistics <- function(button, user.data) {
extra.fun <- function(){
# Al the code is in an separate function since we want to
# apply tryCatch latter.
wait$setText("Calculating, wait please...")
res <- NULL
d <- NULL
# Get the information about data and the file
the.file <- filename$getText()
if (the.file == ""){
wait$setText("ERROR: Specifiy filename or load data!")
return(0)
}
the.iter <- as.numeric(iter$getText())
the.digp <- as.numeric(digpval$getText())
the.digs <- as.numeric(digstat$getText())
the.sep <- sepEntry$getText()
#the.headers <- headersEntry$active # not needed for our situation
the.dec <- decEntry$getText()
wild_index <- RGtk2::gtkComboBoxGetActive(comboboxwild) + 1
wild <- c("rade", "norm", "pois")
the.wild <- wild[ wild_index ]
the.group1 <- RGtk2::gtkComboBoxGetActiveText(combogroup1)
if ( is.null(the.group1) == TRUE){
wait$setText("ERROR: Extract the groups from the data and specify the first group")
return(0)
}
tryCatch(
d <- read.table(the.file, sep = the.sep, header = TRUE,
dec = the.dec),
error = function(e){
wait$setText("ERROR: Problems with reading the data")
return(0)
}
)
if( sum(c("time","group","event") %in% names(d)) != 3){
# Note that a misspecification of sep or dec may also lead here to
# an error, that is why we prefer this error text instead of a more
# specific one
wait$setText("ERROR: Problems with reading the data!")
return()
}
lev_group <- levels( as.factor(d$group))
if ( length(lev_group) != 2){
wait$setText("ERROR: There are either more or less than 2 groups!")
return()
}
the.prop <- propEntry$active
the.central <- centralEntry$active
the.early <- earlyEntry$active
the.late <- lateEntry$active
# Produce list rg
comboboxr <- list( comboboxr1, comboboxr2, comboboxr3,
comboboxr4, comboboxr5, comboboxr6,
comboboxr7)
comboboxg <- list( comboboxg1, comboboxg2, comboboxg3,
comboboxg4, comboboxg5, comboboxg6,
comboboxg7)
rg <- list()
for (i in 1:7){
r <- RGtk2::gtkComboBoxGetActive(comboboxr[[i]])
g <- RGtk2::gtkComboBoxGetActive(comboboxg[[i]])
if (r*g == 0 && r+g > 0){
# In this case only r or g are specificed for the corresponding direction
# ->error
# Note that also "" can be choosen. Hence, the value 0
# represent that nothing is chosen.
wait$setText("ERROR: Choose r and g for each user specified direction!")
return()
}
if( r>0 && g>0){ # Both exponents are specified
rg <- c( rg, list(c(r-1, g-1)) )
}
}
if ( the.prop == TRUE){ rg <- c(rg, list( c(0, 0) )) }
if ( the.early == TRUE){ rg <- c(rg, list( c(0, 4) ))}
if ( the.late == TRUE){ rg <- c(rg, list( c(4, 0) ))}
if ( the.central == TRUE){ rg <- c(rg, list( c(1, 1) ))}
res <- mdir.onesided(d, rg = rg, group1 = the.group1, wild = the.wild, iter = the.iter, dig_p = the.digp, dig_stat = the.digs)
wait.test <- substring( wait$getText(),1, 5) # Check if there is already an error
if( wait.test != "ERROR"){
wait$setText("Done")
}
pval$setText( res$p_value)
tstat$setText( res$stat)
} # END of extra.fun
match.fun(extra.fun)
tryCatch( extra.fun()
, error = function(e){
# If there is some ERROR in extra.fun() then the
# error function becomes active
wait.test <- substring( wait$getText(),1, 5) # Check if there is already an error
if( wait.test != "ERROR"){
wait$setText("ERROR. Please check the settings!")
}
}
) # End of tryCatch
}
## Activate buttons
RGtk2::gSignalConnect(buttonOK, "clicked", performStatistics)
RGtk2::gSignalConnect(buttonCancel, "clicked", window$destroy)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.