old.analysis.GUI <- function() {
#
# Setup and run a GUI to take inputs for an analysis file.
#
# ---- Define the main window
win <- gtkWindowNew("toplevel")
win$setBorderWidth(8)
win$setTitle("S-Draw : Continuous variable analysis interface")
vbox1 <- gtkVBoxNew(FALSE, 8)
vbox1$setBorderWidth(8)
win$add(vbox1)
#--------------------------- Middle horizontal box ---------------
req.frame <- gtkFrameNew("Required Inputs")
vbox1$packStart(req.frame)
hbox1 <- gtkVBoxNew(FALSE, 8) #sets up middle horizontal box, FALSE means things not evenly spaced, 8 is for 8 pixels between things
hbox1$setBorderWidth(8)
req.frame$add(hbox1) #this adds the new horizontal box to the frame which is in the overall vertical box. we are building the window vertically
# ================= Required Inputs frame ============================
frame.frame <- gtkFrameNew("Sample Information")
hbox1$add(frame.frame) # Adds the frame to the horizontal box
# ---- Define a vertical box
req.vbox <- gtkVBoxNew(FALSE, 8)
req.vbox$setBorderWidth(8)
frame.frame$add(req.vbox)
# ---- Define table of boxes so everything aligns
tbl <- gtkTable(18,2,FALSE) #3 rows, 2 columns, FALSE for nonhomogeneous
gtkTableSetRowSpacings(tbl,1) #1 pixel between rows
gtkTableSetColSpacings(tbl,5) #5 pixels between columns
req.vbox$packStart(tbl)
# ---- Input csv file box
shape.in.entry <- gtkEntry()
shape.in.entry$setText( "" )
shape.file.label <- gtkLabel("CSV file OR data.frame object:")
shape.in.dir <- gtkEntry() # this entry box is hidden/not displayed
shape.in.dir$setText( getwd() )
#out.r.entry <- gtkEntry()
#out.r.entry$setText( "" )
# ---- Output R object box
out.r.entry <- gtkEntry()
out.r.entry$setText("")#paste("sdraw.", format(Sys.time(), "%Y.%m.%d.%H%M%S"), sep=""))
out.r.label <- gtkLabel("Output File:")
gtkTableAttach(tbl,out.r.label, 0, 1, 3, 4, xpadding=5, ypadding=5)
gtkTableAttach(tbl,out.r.entry, 1, 2, 3, 4, xpadding=5, ypadding=5)
shape.file.box <- gtkHBox(FALSE, 10)
browse.b <- gtkButton("Browse")
gSignalConnect(browse.b, "clicked", browse.for.shapefile,data=list(
shape.in.entry = shape.in.entry,
shape.in.dir = shape.in.dir,
out.r.entry = out.r.entry,
parent.window = win
))
shape.file.box$packEnd(browse.b)
shape.file.box$packStart(shape.in.entry)
gtkTableAttach(tbl,shape.file.label, 0, 1, 1, 2, xpadding=5, ypadding=5)
gtkTableAttach(tbl,shape.file.box, 1, 2, 1, 2, xpadding=5, ypadding=5)
# ---- needed analysis variables
# siteID
siteID.entry <- gtkEntryNew()
siteID.entry$setText( "siteID" )
siteID.label <- gtkLabel("Site-ID Variable:")
gtkTableAttach(tbl,siteID.label, 0, 1, 5, 6, xpadding=5, ypadding=5)
gtkTableAttach(tbl,siteID.entry, 1, 2, 5, 6, xpadding=5, ypadding=5)
# EvalStatus
evalStatus.entry <- gtkEntryNew()
evalStatus.entry$setText( "EvalStatus" )
evalStatus.label <- gtkLabel("Evaluation Status Variable:")
gtkTableAttach(tbl,evalStatus.label, 0, 1, 7, 8, xpadding=5, ypadding=5)
gtkTableAttach(tbl,evalStatus.entry, 1, 2, 7, 8, xpadding=5, ypadding=5)
# Target_Sampled
evalStatusYes.entry <- gtkEntryNew()
evalStatusYes.entry$setText( "Include=Y" )
evalStatusYes.label <- gtkLabel("Inclusion Identifier:")
#evalStatusYes.label$setMarkup("<span color='red'>Inclusion Identifier:</span>")
gtkTableAttach(tbl,evalStatusYes.label, 0, 1, 9, 10, xpadding=5, ypadding=5)
gtkTableAttach(tbl,evalStatusYes.entry, 1, 2, 9, 10, xpadding=5, ypadding=5)
# (sub)Population 2 -- recall population 1 is all elements together
pop2.entry <- gtkEntryNew()
pop2.entry$setText( "" )
pop2.label <- gtkLabel("Subpopulation 1:")
gtkTableAttach(tbl,pop2.label, 0, 1, 11, 12, xpadding=5, ypadding=5)
gtkTableAttach(tbl,pop2.entry, 1, 2, 11, 12, xpadding=5, ypadding=5)
# (sub)Population 3 -- recall population 1 is all elements together
pop3.entry <- gtkEntryNew()
pop3.entry$setText( "" )
pop3.label <- gtkLabel("Subpopulation 2:")
gtkTableAttach(tbl,pop3.label, 0, 1, 13, 14, xpadding=5, ypadding=5)
gtkTableAttach(tbl,pop3.entry, 1, 2, 13, 14, xpadding=5, ypadding=5)
# wgt
wgt.entry <- gtkEntryNew()
wgt.entry$setText( "wgt" )
wgt.label <- gtkLabel("Weight Variable:")
gtkTableAttach(tbl,wgt.label, 0, 1, 15, 16, xpadding=5, ypadding=5)
gtkTableAttach(tbl,wgt.entry, 1, 2, 15, 16, xpadding=5, ypadding=5)
# xcoord
xcoord.entry <- gtkEntryNew()
xcoord.entry$setText( "xcoord" )
xcoord.label <- gtkLabel("X-Coordinate:")
gtkTableAttach(tbl,xcoord.label, 0, 1, 17, 18, xpadding=5, ypadding=5)
gtkTableAttach(tbl,xcoord.entry, 1, 2, 17, 18, xpadding=5, ypadding=5)
# ycoord
ycoord.entry <- gtkEntryNew()
ycoord.entry$setText( "ycoord" )
ycoord.label <- gtkLabel("Y-Coordinate:")
gtkTableAttach(tbl,ycoord.label, 0, 1, 19, 20, xpadding=5, ypadding=5)
gtkTableAttach(tbl,ycoord.entry, 1, 2, 19, 20, xpadding=5, ypadding=5)
# continuous analysis variable
cont.var.entry <- gtkEntryNew()
cont.var.entry$setText( "contvar" )
cont.var.label <- gtkLabel("Continuous Outcome:")
gtkTableAttach(tbl,cont.var.label, 0, 1, 21, 22, xpadding=5, ypadding=5)
gtkTableAttach(tbl,cont.var.entry, 1, 2, 21, 22, xpadding=5, ypadding=5)
# =========================== Frame information area ==================================
# # ------ Optional inputs box
# opt.hbox <- gtkHBoxNew(TRUE, 2)
# opt.hbox$setBorderWidth(8)
# hbox2$packStart(opt.hbox)
#
# opt.frame <- gtkFrameNew("Optional Inputs")
# opt.hbox$packStart(opt.frame)
#
# # opt.blank.box <- gtkHBoxNew(TRUE,2)
# # opt.hbox$packStart(opt.blank.box)
#
# opt.vbox <- gtkVBoxNew(FALSE, 8)
# opt.vbox$setBorderWidth(8)
# opt.frame$add(opt.vbox)
#
#
# # ---- Define table of boxes so everything aligns
# opt.tbl <- gtkTable(7,5,FALSE)
# gtkTableSetRowSpacings(opt.tbl,1)
# gtkTableSetColSpacings(opt.tbl,5)
#
# opt.vbox$add(opt.tbl)
# ---- Separator
vbox1$packStart(gtkHSeparatorNew(), expand=FALSE)
finfo.vbox <- gtkHBoxNew(FALSE,2)
finfo.vbox$setBorderWidth(8)
vbox1$packStart(finfo.vbox)
finfo.title <- gtkLabel("Sample\nContents: \n<pending>")
finfo.vbox$packStart(finfo.title, expand=FALSE, fill=FALSE)
finfo.vbox$packStart(gtkVSeparatorNew(), expand=FALSE)
max.vars <- 20 # maximum number of variables to display
n.blank.cols <- 4 # must be even, half place on left and half on right
finfo.tbl <- gtkTable(max.vars+1,n.blank.cols+2,FALSE) #FALSE for nonhomogeneous
gtkTableSetRowSpacings(finfo.tbl,1) #1 pixel between rows
gtkTableSetColSpacings(finfo.tbl,5) #5 pixels between columns
finfo.vbox$packStart(finfo.tbl)
# Allocate the labels
names.labs <- lapply(1:(max.vars+1), gtkLabel, str="")
vtypes.labs <- lapply(1:(max.vars+1), gtkLabel, str="")
# Place column header labels
names.labs[[1]]$setText("VARIABLE")
vtypes.labs[[1]]$setText("CLASS")
gtkTableAttach(finfo.tbl, names.labs[[1]], (n.blank.cols/2), (n.blank.cols/2)+1, 0,1 )
gtkTableAttach(finfo.tbl, vtypes.labs[[1]], (n.blank.cols/2)+1, (n.blank.cols/2)+2, 0,1 )
# Place separators
gtkTableAttach(finfo.tbl, gtkHSeparatorNew(), (n.blank.cols/2), (n.blank.cols/2)+1, 1,2)
gtkTableAttach(finfo.tbl, gtkHSeparatorNew(), (n.blank.cols/2)+1, (n.blank.cols/2)+2, 1,2)
# Set their length
# f.setlablen <-function(x,lablist){
# lablist[[x]]$setWidthChars(25)
# #lablist[[x]]$setJustify(GTK_JUSTIFY_LEFT)
# #lablist[[x]]$setAlignment(0,.5)
# }
# names.labs <- lapply(1:(max.vars+1), f.setlablen, lablist=names.labs)
# vtypes.labs <- lapply(1:(max.vars+1), f.setlablen, lablist=vtypes.labs)
# place them
placelabs <- function(x, lablist, obj, labcol, bcols){
gtkTableAttach( obj, lablist[[x+1]], bcols+labcol-1, bcols+labcol, x-1+2, x+2) # + 2 for header
}
lapply(1:max.vars, placelabs, lablist=names.labs, obj=finfo.tbl, labcol=1, bcols=n.blank.cols/2)
lapply(1:max.vars, placelabs, lablist=vtypes.labs, obj=finfo.tbl, labcol=2, bcols=n.blank.cols/2 )
# blank.labs <- lapply(1:(n.blank.cols+2), gtkLabel, str=" ")
# placeblanklabs <- function(x, lablist, obj, side){
# gtkTableAttach( obj, lablist[[side+x]], side+x-1, side+x, 0, 1)
# }
# lapply(1:(n.blank.cols/2), placeblanklabs, lablist=blank.labs, obj=finfo.tbl, side=0)
# lapply(1:(n.blank.cols/2), placeblanklabs, lablist=blank.labs, obj=finfo.tbl, side=(n.blank.cols/2)+1)
# Initial values in columns, and hide all but first
names.labs[[2]]$setText("<pending>")
vtypes.labs[[2]]$setText("<pending>")
lapply(2:max.vars, function(x,lablist){lablist[[x+1]]$hide()}, lablist=names.labs)
lapply(2:max.vars, function(x,lablist){lablist[[x+1]]$hide()}, lablist=vtypes.labs)
# =========================== Bottom row of buttons ==================================
# ---- Separator
vbox1$packStart(gtkHSeparatorNew(), expand=FALSE)
# ---- Define box for row of buttons at bottom
bbox <- gtkHButtonBox()
bbox$SetLayout("Spread") # Layout can be c("Start", "Edge", "Spread", "End")
bbox$SetBorderWidth(10)
# ---- Read frame button, but do not draw sample, this displays variables in shapefile
read.b <- gtkButton("Inspect\n Sample")
gSignalConnect(read.b, "clicked", readButtonActionCSV,
data=list(
shape.in.entry=shape.in.entry,
shape.in.dir=shape.in.dir,
out.r.entry=out.r.entry,
name.labs=names.labs,
type.labs=vtypes.labs,
finfo.title=finfo.title
)
)
bbox$packEnd(read.b, expand=FALSE)
# ---- Run button
run.b <- gtkButton("Run")
gSignalConnect(run.b, "clicked", analysisCont, data=list(
shape.in.entry=shape.in.entry,
shape.in.dir=shape.in.dir,
siteID.entry=siteID.entry,
evalStatus.entry=evalStatus.entry,
evalStatusYes.entry=evalStatusYes.entry,
pop2.entry=pop2.entry,
pop3.entry=pop3.entry,
wgt.entry=wgt.entry,
xcoord.entry=xcoord.entry,
ycoord.entry=ycoord.entry,
cont.var.entry=cont.var.entry,
out.r.entry = out.r.entry
)
)
bbox$packEnd(run.b, expand=FALSE)
# ---- Read frame button, but do not draw sample, this plots resulting CDF
# plot.b <- gtkButton(" Plot\nCDF")
# gSignalConnect(plot.b, "clicked", analysisPlotCDF,
# data=list(
# )
# )
# bbox$packEnd(plot.b, expand=FALSE)
# ---- View button
view.b <- gtkButton("Tabulate\n Sample")
gSignalConnect(view.b, "clicked", view.analysis.sample, data=list(
out.r.entry = out.r.entry
))
bbox$packEnd( view.b, expand=FALSE)
# ---- Write to csv button
write.csv.b <- gtkButton("Export")
gSignalConnect(write.csv.b, "clicked", my.write.csv, data=list(
out.r.entry = out.r.entry,
parent.window = win
))
bbox$packEnd( write.csv.b, expand=FALSE)
# ---- Done button
cancel.b <- gtkButton("Done")
gSignalConnect(cancel.b, "clicked", function(x){
win$Hide();
win$Destroy()
})
bbox$packEnd( cancel.b, expand=FALSE)
# ---- Pack the rows of buttons into the vertical box
vbox1$packEnd( bbox, expand=FALSE)
# ---- Finally, show the window
win$Show()
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.