R/stratified.GUI.R
In tmcd82070/SDrawNPS: Sample Draw NPS
#' @export stratified.GUI
#'
#' @title Graphic User Interface (GUI) for selection of stratified GRTS samples.
#'
#' @description Initiates a dialog box via a GUI to select stratified samples
#' from 2-D resources.
#'
#' @return A \code{SpatialDesign} (see the \code{spsurvey} package) object with
#' the name specified by the user in the GUI\eqn{'}s \code{Sample\eqn{'}s R
#' name} box. This object contains the sampling design specifications, the
#' selected sample points in GRTS order, coordinates, and projection
#' information. Sample objects are stored in the current workspace, while any
#' export files, including a \code{txt} log of the commands utilized to
#' generate the sample, are saved to the file directory specified via
#' \code{getwd}.
#'
#' Any maps drawn during the sampling process must be saved before R is
#' closed. See \code{dev.copy}, \code{jpg}, and other graphics device
#' functions.
#'
#' @details This routine is intended to be called from the \code{SDrawNPS} menu,
#' but it can also be called from the command line in non-interactive
#' environments, such as RStudio. This routine uses the \code{RGtk2} package
#' windowing capabilities to construct a pop-up dialog box, or GUI. In the
#' dialog box, users specify at least the required input parameters, then
#' press the \sQuote{Run} button to draw the sample.
#'
#' On submission, the GUI internally packages its inputs, processes the
#' necessary shapefile, and executes the \code{spsurvey}-package \code{grts}
#' function. All \code{SDrawNPS} GUI submissions utilizing the GRTS sampling
#' methodology lead to the creation of a text-based log file, which records
#' all code utilized. The log file thus serves as a historical record
#' containing sampling information, including the random seed utilized. It
#' also serves as a tool for enhancing methodological understanding.
#'
#' See \sQuote{References} for additional resources.
#'
#' @section Required Inputs:
#'
#' \itemize{
#'
#' \item{Frame Information}
#'
#' \enumerate{
#'
#' \item Select \code{GRTS} as the \sQuote{Sample Type} in the top drop-down
#' list. The other sampling types are not currently available.
#'
#' \item Specify the shapefile or \code{SpatialPoints*}, \code{SpatialLines*},
#' or \code{SpatialPolygons*} package-\code{sp} object that constitutes the
#' sample frame in the \code{Shapefile} box, or click \sQuote{Browse} to
#' browse for a shapefile with a \code{.shp} extension. When specifying the
#' name of a shapefile via use of the input box, do not include the
#' \code{.shp} extension and recognize that all files associated with the
#' shapefile must reside in the current working directory, i.e., the one
#' returned by \code{getwd}. Following selection of a spatial object or
#' shapefile, click the \sQuote{Inspect Frame} button to plot it and list
#' variables associated with its attribute data. This is a good way to
#' determine the study area boundary.
#'
#' \item Specify the name of the stratification variable. This variable must
#' be contained in the attribute data of the spatial object specified in the
#' \code{Shapefile} box. For example, this could be an elevational class
#' associated with every point in the shapefile. This name is case sensitive
#' and must match that in the shapefile or \code{sp} object exactly. Constant
#' values of this variable define the strata.
#'
#' \item Specify the sample\eqn{'}s R object name. The output will be a
#' \code{SpatialDesign} object created via the \code{spsurvey} package, and
#' contains the sampling design specifications and selected sample points in
#' GRTS order, along with spatial coordinates and projection information.
#'
#' \item Specify the \sQuote{Sample Allocation} scheme. Available options
#' include \sQuote{Proportional to Size} relative to the size of each stratum
#' in the population; \sQuote{Constant} or the same number in all strata; and
#' \sQuote{User-specified} sample sizes within each stratum. Note that units
#' in small strata will have lower probabilities of inclusion and may not be
#' represented in small overall sample sizes.
#'
#' \item Specify the sample size as described above for the appropriate
#' allocation scheme.
#'
#' }
#'
#' \item{Sample Allocation & Sample Size}
#'
#' \enumerate{
#'
#' \item If the allocation scheme is \sQuote{Proportional to Size,} enter one
#' number for \sQuote{Sample Size.} This number will be distributed among
#' strata based on the relative number of points, length of lines, or area of
#' polygons in each stratum.
#'
#' \item If the allocation scheme is \sQuote{Constant,} enter one number for
#' \sQuote{Sample Size.} This number will be selected from each stratum. For
#' example, if \code{50} is specified, 50 points will be selected from objects
#' in each stratum.
#'
#' \item If the allocation scheme is \sQuote{User-specified,} enter a list of
#' numbers separated by commas for \sQuote{Sample Size.} If there are \eqn{H}
#' strata in the frame, specify \eqn{H} numbers, i.e., one number per stratum.
#' Order of sample sizes should be the same as the levels of the
#' stratification variable, as with a factor. In fact, to match sample sizes
#' to strata, \code{SDrawNPS} calls function \code{factor} to extract factor
#' levels of the strata variable. The order of these levels is the order of
#' samples sizes in the list. For example, if the strata variable contains
#' strings \code{"low"} and \code{"high"}, converting this variable to a
#' factor generally results in alphabetic ordering of levels, as in
#' \code{c("high", "low")}. In this case, the first number in the specified
#' list should be the sample size in the \code{"high"} stratum. The default
#' ordering of levels when vectors are converted to factors is alphabetic,
#' unless global options have changed.
#'
#' }
#'
#' }
#'
#' @section Optional Inputs:
#'
#' \enumerate{
#'
#' \item The \sQuote{Random number seed.} When specified, the seed may be used
#' to recreate the sample. When not specified, i.e., the box is left blank, a
#' random seed is selected against the current time. See \code{set.seed}. In
#' both cases, the seed ultimately utilized is recorded in both the resulting
#' log text file and R Console. Recording the seed allows for the easy
#' redrawing of samples if lost, or if more sites are needed. Any integer
#' value is acceptable as the random number seed.
#'
#' \item The number of oversample points, as encompassed via the \sQuote{Over
#' sample, each strata} box, can be specified within each stratum. Oversample
#' points are listed after the main sample points in the GRTS design file,
#' i.e., the resulting sample R output object. They can also be identified in
#' the \sQuote{panel} variable of the sample output. Apply caution when
#' specifying oversample points, as large oversamples can cause samples to
#' tend toward a proportional-to-size allocation even when other allocations
#' are specified.
#'
#' }
#'
#' @section Dialog Buttons:
#'
#' \enumerate{
#'
#' \item \sQuote{Inspect Frame.} After specifying the shapefile or \code{sp}
#' object name, pressing the \sQuote{Inspect Frame} button plots the
#' shapefile. It also lists the variables and their class in the
#' shapefile\eqn{'}s attribute data. After drawing a sample, the
#' \sQuote{Inspect Frame} button plots the study area, along with sampled
#' points.
#'
#' \item \sQuote{Run.} After specifying all required and optional inputs, the
#' \sQuote{Run} button draws the sample. The \code{.GlobalEnv} workspace
#' holds the resulting \code{SpatialDesign} object with the name specified via
#' the GUI \code{Sample\eqn{'}s R name} box. A confirmation dialog appears
#' following completion of the draw. Large samples may require several tens of
#' minutes for completion.
#'
#' \item \sQuote{Plot Sample.} Following sampling, the \sQuote{Plot Sample}
#' button displays the sampled points on the sampling frame.
#'
#' \item \sQuote{Tabulate Sample.} Following sampling, display the GRTS design
#' file in a tabular format. The GRTS design file contains information on
#' each sampled unit, such as coordinates, and design variables, e.g., stratum
#' or multi-density category. It also contains design weights.
#'
#' \item \sQuote{Export.} Following sampling, the \sQuote{Export} button
#' prompts the user to save sampling results via a pop-up dialog box. The
#' sample can be exported as an ArcGIS shapefile (\code{.SHP}); Comma
#' Separated (\code{.CSV}); Google Earth (\code{.KML}); or Garmin format
#' (\code{.GPX}) file.
#'
#' Shapefiles actually consist of several files with different extensions.
#' Because of this, do not include the \code{.SHP} extension in the
#' \code{Name} field of the pop-up when exporting to a shapefile.
#'
#' \item \sQuote{Done.} Dismisses the GUI dialog box, leaving any sample
#' objects in the \code{.GlobalEnv} workspace.
#'
#' }
#'
#' @author Trent McDonald (tmcdonald@@west-inc.com) and Jason Mitchell
#' (jmitchell@@west-inc.com)
#'
#' @seealso \code{\link{spsurvey::grts}}
#'
#' @references Stevens, D. L. and A. R. Olsen (2004). Spatially balanced
#' sampling of natural resources. Journal of the American Statistical
#' Association 99, 262-278.
#'
#' Kincaid, T. (2015). GRTS Survey Designs for an Area Resource. Accessed
#' online May 6, 2016.
#' \code{https://cran.r-project.org/web/packages/spsurvey/vignettes/Area_Design.pdf}.
#'
#'
#'
#'
#' Starcevich L. A., DiDonato G., McDonald T., Mitchell, J. (2016). A GRTS
#' User\eqn{'}s Manual for the SDrawNPS Package: A graphical user interface
#' for Generalized Random Tessellation Stratified (GRTS) sampling and
#' estimation. National Park Service, U.S. Department of the Interior.
#' Natural Resource Report NPS/XXXX/NRR—20XX/XXX.
#'
#' @keywords design survey
#'
#' @examples
#' # Open a GUI for stratified GRTS sampling.
#' stratified.GUI()
#'
stratified.GUI <- function() {
#
# Setup and run a GUI to take a BAS sample
#
design <- "stratified"
# ---- Define the main window
win <- gtkWindowNew("toplevel")
win$setBorderWidth(8)
win$setTitle("SDrawNPS : Stratified sample drawing interface")
#gtkWindowSetIconFromFile(win, filename = "s-draw.ico") # need path to be correct here, or does not work, obviously
vbox1 <- gtkVBoxNew(FALSE, 8)
win$add(vbox1)
# ================= Sample type frame ============================
samp.types <- c("HAL - Halton Lattice Sampling",
"BAS - Balanced Acceptance Sampling",
"GRTS - Generalized Random Tessellation Stratified",
"SSS - Simple Systematic Sampling")
#this adds different sampling frames
#I don't forsee adding anything other than BAS, GRTS, or SSS -- HAL!!!
samp.type.combo <- gtkComboBoxNewText()
samp.type.combo$show()
for( i in samp.types ){
samp.type.combo$appendText( i )
}
samp.type.combo$setActive(2)
# print(gtkComboBoxGetActive(samp.type.combo))
# print(gtkComboBoxGetWrapWidth(samp.type.combo))
samp.type.frame <- gtkFrameNew("Sample Type")
samp.type.frame$setBorderWidth(8)
#this adds a label to the combo box
combo.box <- gtkHBoxNew(FALSE, 8)
combo.box$setBorderWidth(8)
combo.box$packStart( samp.type.combo )
samp.type.frame$add( combo.box )
hbox2 <- gtkHBoxNew(FALSE, 8)
#hbox2$setBorderWidth(8)
hbox2$packStart(samp.type.frame)
# logo <- gtkImageNewFromFile("s_draw_banner.png")
# hbox2$packStart(logo)
vbox1$packStart(hbox2)
# Handler for change in sample type
f.samp.type.change <- function(x,dat){
stype <- samp.type.combo$getActive()
# Carefull, don't get the numbers out of order with the options
if( stype == 0 ){
# Halton samples
over.entry$hide()
over.size.label$hide()
} else if( stype == 1 ){
# BAS samples
over.entry$hide()
over.size.label$hide()
} else if( stype == 2 ){
# GRTS samples
over.entry$show()
over.size.label$show()
} else {
# sss samples
over.entry$hide()
over.size.label$hide()
}
}
gSignalConnect(samp.type.combo, "changed", f.samp.type.change )
# ------ 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)
# ---- Over sample size text box
over.entry <- gtkEntry()
over.entry$setText( "0" )
over.size.label <- gtkLabel("Over sample, each strata:")
gtkTableAttach(opt.tbl,over.size.label, 0, 1, 1, 2, xpadding=5, ypadding=5)
gtkTableAttach(opt.tbl,over.entry, 1, 2, 1, 2, xpadding=5, ypadding=5)
# ---- Seed text box
# ---- Over sample size text box
over.entry <- gtkEntry()
over.entry$setText( "0" )
over.size.label <- gtkLabel("Over sample, each strata:")
gtkTableAttach(opt.tbl,over.size.label, 0, 1, 1, 2, xpadding=5, ypadding=5)
gtkTableAttach(opt.tbl,over.entry, 1, 2, 1, 2, xpadding=5, ypadding=5)
# ---- Seed text box
seed.entry <- gtkEntry()
seed.entry$setText( "" )
seed.label <- gtkLabel("Random number seed:")
gtkTableAttach(opt.tbl,seed.label, 0, 1, 0, 1, xpadding=5, ypadding=5)
gtkTableAttach(opt.tbl,seed.entry, 1, 2, 0, 1, xpadding=5, ypadding=5)
# # ---- Over sample size text boxes
# over.entry <- gtkEntry()
# over.entry$setText( "0" )
# over.size.label <- gtkLabel("Over sample, each strata:")
#
# # Hide initially because Halton Latice is initial sample type
# over.entry$hide()
# over.size.label$hide()
#
#
# gtkTableAttach(opt.tbl,over.size.label, 0, 1, 1, 2, xpadding=5, ypadding=5)
# gtkTableAttach(opt.tbl,over.entry, 1, 2, 1, 2, xpadding=5, ypadding=5)
# --------------------------- Middle horizontal box ---------------
req.frame <- gtkFrameNew("Required Inputs")
vbox1$packStart(req.frame)
hbox1 <- gtkHBoxNew(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("Frame Information")
hbox1$add(frame.frame) # Adds the frame to the horizontal box
# ---- Define a verticle box
req.vbox <- gtkVBoxNew(FALSE, 8)
req.vbox$setBorderWidth(8)
frame.frame$add(req.vbox)
# ---- Define table of boxes so everything aligns
tbl <- gtkTable(7,4,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 shape file box
shape.in.entry <- gtkEntry()
shape.in.entry$setText( "" )
shape.file.label <- gtkLabel("Shapefile OR 'sp' Object:")
shape.in.dir <- gtkEntry() # this entry box is hidden/not displayed
shape.in.dir$setText( getwd() )
# ---- 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("Sample's R name:")
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)
# # ---- Input stratifying variable information Guy added this section 12/19
# # ---- Stratum Names
strata.var.entry <- gtkEntry()
strata.var.entry$setText( "" )
strata.var.label <- gtkLabel("Name of Stratifying Variable:")
gtkTableAttach(tbl,strata.var.label, 0, 1, 2, 3, xpadding=5, ypadding=5)
gtkTableAttach(tbl,strata.var.entry, 1, 2, 2, 3, xpadding=5, ypadding=5)
# ============================ Sample Allocation frame ===========
#hbox1 <- gtkHBoxNew(FALSE, 8) #sets up another horizontal box, FALSE means things not evenly spaced, 8 is for 8 pixels between things
#hbox1$setBorderWidth(8)
#vbox1$add(hbox1)
samp.alloc.frame <- gtkFrameNew("Sample Allocation")
hbox1$add(samp.alloc.frame)
# Radio Buttons to Specify Sample Allocation
stype.box <- gtkVBoxNew(TRUE, 2)
stype.box$setBorderWidth(8)
samp.alloc.frame$add( stype.box )
prop.rb <- gtkRadioButtonNewWithLabel(label="Proportional to Size")
const.rb <- gtkRadioButtonNewWithLabelFromWidget(prop.rb,"Constant")
user.rb <- gtkRadioButtonNewWithLabelFromWidget(prop.rb,"User-specified")
#user.entry <-gtkEntry()
#user.entry$setText( "" ) #keep box blank
stype.box$packStart(prop.rb, TRUE, TRUE, 2)
stype.box$packStart(const.rb, TRUE, TRUE, 2)
stype.box$packStart(user.rb, TRUE, TRUE, 2)
#stype.box$packStart(user.entry, TRUE, TRUE, 2)
#this creates a box next to the user-specified button
#it would be nice to only have this box pop up if the user-specified button is clicked
f.write.sample.label <- function(x,dat){
prop.active <- prop.rb$getActive()
const.active <- const.rb$getActive()
if(prop.active){
n.label$setText("Specify: total n across all\n\tstrata")
} else if( const.active ){
n.label$setText("Specify: n for a single stratum")
} else {
# Note, because the three buttons are in a group, you don't need signal for the last one
n.label$setText("Specify: a comma delimited\n\tlist of n, in strata order")
}
}
gSignalConnect(prop.rb, "toggled", f.write.sample.label )
gSignalConnect(const.rb, "toggled", f.write.sample.label )
# ---- Sample sizes
n.frame <- gtkFrameNew( "Sample Size")
# n.tbl <- gtkTableNew(7,4,homogeneous=FALSE) #Bigger than we need. FALSE for nonhomogeneous
# gtkTableSetRowSpacings(n.tbl,1) #1 pixel between rows
# gtkTableSetColSpacings(n.tbl,5) #5 pixels between column
hbox1$add(n.frame)
n.vbox <- gtkVBoxNew(TRUE, 2)
n.vbox$setBorderWidth(8)
n.frame$add( n.vbox )
n.entry <- gtkEntry()
n.entry$setText( "" )
n.label <- gtkLabel("Specify: total n across all\n\tstrata")
n.label2 <- gtkLabel(" ")
n.vbox$packStart(n.label)
n.vbox$packStart(n.entry)
n.vbox$packStart(n.label2)
# gtkTableAttach(n.tbl,tot.size.label, 0, 1, 0, 1, xpadding=5, ypadding=5)
# gtkTableAttach(n.tbl,n.entry, 1, 2, 0, 1, xpadding=5, ypadding=5)
# # =========================== Seed row button ==================================
#
# # ---- Separator
# vbox1$packStart(gtkHSeparatorNew(), expand=FALSE)
#
# hbox3 <- gtkHBoxNew(FALSE, 8)
# hbox3$setBorderWidth(8)
# vbox1$add(hbox3)
#
# # add seed box.
# seed.random.frame <- gtkFrameNew("Generate a random seed?")
# hbox3$add(seed.random.frame) # alloc
#
# # Radio Buttons to Specify Sample Weights
# stype.box <- gtkHBoxNew(TRUE, 2)
# stype.box$setBorderWidth(8)
# seed.random.frame$add( stype.box )
#
# seedy.rb <- gtkRadioButtonNewWithLabel(label="Yes") #const.rb
# seedn.rb <- gtkRadioButtonNewWithLabelFromWidget(seedy.rb,label="No") # prop.rb
#
# stype.box$packStart(seedn.rb, TRUE, TRUE, 2)
# stype.box$packStart(seedy.rb, TRUE, TRUE, 2)
# =========================== Frame information area ==================================
# ---- Separator
vbox1$packStart(gtkHSeparatorNew(), expand=FALSE)
finfo.vbox <- gtkHBoxNew(FALSE,2)
finfo.vbox$setBorderWidth(8)
vbox1$packStart(finfo.vbox)
finfo.title <- gtkLabel("Frame Type: \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 thier 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 ---------------------------------------------------
# =========================== 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 Frame ")
gSignalConnect(read.b, "clicked", readButtonAction,
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", run.strat.sample, data=list(
samp.type.combo=samp.type.combo,
n.entry=n.entry,
shape.in.entry=shape.in.entry,
shape.in.dir=shape.in.dir,
strata.var.entry=strata.var.entry,
out.r.entry=out.r.entry,
over.entry=over.entry,
seed.entry=seed.entry,
prop.rb=prop.rb,
const.rb=const.rb,
user.rb=user.rb
# seedy.rb=seedy.rb,
# seedn.rb=seedn.r
)
)
bbox$packEnd(run.b, expand=FALSE)
# ---- Read frame button, but do not draw sample, this displays variables in shapefile
plot.b <- gtkButton(" Plot\nSample")
gSignalConnect(plot.b, "clicked", readButtonAction,
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(plot.b, expand=FALSE)
# ---- View button
view.b <- gtkButton("Tabulate\n Sample")
gSignalConnect(view.b, "clicked", view.sample, data=list(
out.r.entry = out.r.entry
))
bbox$packEnd( view.b, expand=FALSE)
# ??? # ---- Write to csv button
# write.csv.b <- gtkButton("Write CSV")
# gSignalConnect(write.csv.b, "clicked", SDraw::my.write.csv, data=list(
# out.r.entry = out.r.entry
# ))
# bbox$packEnd( write.csv.b, expand=FALSE)
# ---- Write to Shapefile button
write.shp.b <- gtkButton("Export")
gSignalConnect(write.shp.b, "clicked", my.write.shp, data=list(
out.r.entry = out.r.entry,
parent.window = win
))
bbox$packEnd( write.shp.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()
}
tmcd82070/SDrawNPS documentation built on May 31, 2019, 4:37 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
#' @export stratified.GUI
#'
#' @title Graphic User Interface (GUI) for selection of stratified GRTS samples.
#'
#' @description Initiates a dialog box via a GUI to select stratified samples
#' from 2-D resources.
#'
#' @return A \code{SpatialDesign} (see the \code{spsurvey} package) object with
#' the name specified by the user in the GUI\eqn{'}s \code{Sample\eqn{'}s R
#' name} box. This object contains the sampling design specifications, the
#' selected sample points in GRTS order, coordinates, and projection
#' information. Sample objects are stored in the current workspace, while any
#' export files, including a \code{txt} log of the commands utilized to
#' generate the sample, are saved to the file directory specified via
#' \code{getwd}.
#'
#' Any maps drawn during the sampling process must be saved before R is
#' closed. See \code{dev.copy}, \code{jpg}, and other graphics device
#' functions.
#'
#' @details This routine is intended to be called from the \code{SDrawNPS} menu,
#' but it can also be called from the command line in non-interactive
#' environments, such as RStudio. This routine uses the \code{RGtk2} package
#' windowing capabilities to construct a pop-up dialog box, or GUI. In the
#' dialog box, users specify at least the required input parameters, then
#' press the \sQuote{Run} button to draw the sample.
#'
#' On submission, the GUI internally packages its inputs, processes the
#' necessary shapefile, and executes the \code{spsurvey}-package \code{grts}
#' function. All \code{SDrawNPS} GUI submissions utilizing the GRTS sampling
#' methodology lead to the creation of a text-based log file, which records
#' all code utilized. The log file thus serves as a historical record
#' containing sampling information, including the random seed utilized. It
#' also serves as a tool for enhancing methodological understanding.
#'
#' See \sQuote{References} for additional resources.
#'
#' @section Required Inputs:
#'
#' \itemize{
#'
#' \item{Frame Information}
#'
#' \enumerate{
#'
#' \item Select \code{GRTS} as the \sQuote{Sample Type} in the top drop-down
#' list. The other sampling types are not currently available.
#'
#' \item Specify the shapefile or \code{SpatialPoints*}, \code{SpatialLines*},
#' or \code{SpatialPolygons*} package-\code{sp} object that constitutes the
#' sample frame in the \code{Shapefile} box, or click \sQuote{Browse} to
#' browse for a shapefile with a \code{.shp} extension. When specifying the
#' name of a shapefile via use of the input box, do not include the
#' \code{.shp} extension and recognize that all files associated with the
#' shapefile must reside in the current working directory, i.e., the one
#' returned by \code{getwd}. Following selection of a spatial object or
#' shapefile, click the \sQuote{Inspect Frame} button to plot it and list
#' variables associated with its attribute data. This is a good way to
#' determine the study area boundary.
#'
#' \item Specify the name of the stratification variable. This variable must
#' be contained in the attribute data of the spatial object specified in the
#' \code{Shapefile} box. For example, this could be an elevational class
#' associated with every point in the shapefile. This name is case sensitive
#' and must match that in the shapefile or \code{sp} object exactly. Constant
#' values of this variable define the strata.
#'
#' \item Specify the sample\eqn{'}s R object name. The output will be a
#' \code{SpatialDesign} object created via the \code{spsurvey} package, and
#' contains the sampling design specifications and selected sample points in
#' GRTS order, along with spatial coordinates and projection information.
#'
#' \item Specify the \sQuote{Sample Allocation} scheme. Available options
#' include \sQuote{Proportional to Size} relative to the size of each stratum
#' in the population; \sQuote{Constant} or the same number in all strata; and
#' \sQuote{User-specified} sample sizes within each stratum. Note that units
#' in small strata will have lower probabilities of inclusion and may not be
#' represented in small overall sample sizes.
#'
#' \item Specify the sample size as described above for the appropriate
#' allocation scheme.
#'
#' }
#'
#' \item{Sample Allocation & Sample Size}
#'
#' \enumerate{
#'
#' \item If the allocation scheme is \sQuote{Proportional to Size,} enter one
#' number for \sQuote{Sample Size.} This number will be distributed among
#' strata based on the relative number of points, length of lines, or area of
#' polygons in each stratum.
#'
#' \item If the allocation scheme is \sQuote{Constant,} enter one number for
#' \sQuote{Sample Size.} This number will be selected from each stratum. For
#' example, if \code{50} is specified, 50 points will be selected from objects
#' in each stratum.
#'
#' \item If the allocation scheme is \sQuote{User-specified,} enter a list of
#' numbers separated by commas for \sQuote{Sample Size.} If there are \eqn{H}
#' strata in the frame, specify \eqn{H} numbers, i.e., one number per stratum.
#' Order of sample sizes should be the same as the levels of the
#' stratification variable, as with a factor. In fact, to match sample sizes
#' to strata, \code{SDrawNPS} calls function \code{factor} to extract factor
#' levels of the strata variable. The order of these levels is the order of
#' samples sizes in the list. For example, if the strata variable contains
#' strings \code{"low"} and \code{"high"}, converting this variable to a
#' factor generally results in alphabetic ordering of levels, as in
#' \code{c("high", "low")}. In this case, the first number in the specified
#' list should be the sample size in the \code{"high"} stratum. The default
#' ordering of levels when vectors are converted to factors is alphabetic,
#' unless global options have changed.
#'
#' }
#'
#' }
#'
#' @section Optional Inputs:
#'
#' \enumerate{
#'
#' \item The \sQuote{Random number seed.} When specified, the seed may be used
#' to recreate the sample. When not specified, i.e., the box is left blank, a
#' random seed is selected against the current time. See \code{set.seed}. In
#' both cases, the seed ultimately utilized is recorded in both the resulting
#' log text file and R Console. Recording the seed allows for the easy
#' redrawing of samples if lost, or if more sites are needed. Any integer
#' value is acceptable as the random number seed.
#'
#' \item The number of oversample points, as encompassed via the \sQuote{Over
#' sample, each strata} box, can be specified within each stratum. Oversample
#' points are listed after the main sample points in the GRTS design file,
#' i.e., the resulting sample R output object. They can also be identified in
#' the \sQuote{panel} variable of the sample output. Apply caution when
#' specifying oversample points, as large oversamples can cause samples to
#' tend toward a proportional-to-size allocation even when other allocations
#' are specified.
#'
#' }
#'
#' @section Dialog Buttons:
#'
#' \enumerate{
#'
#' \item \sQuote{Inspect Frame.} After specifying the shapefile or \code{sp}
#' object name, pressing the \sQuote{Inspect Frame} button plots the
#' shapefile. It also lists the variables and their class in the
#' shapefile\eqn{'}s attribute data. After drawing a sample, the
#' \sQuote{Inspect Frame} button plots the study area, along with sampled
#' points.
#'
#' \item \sQuote{Run.} After specifying all required and optional inputs, the
#' \sQuote{Run} button draws the sample. The \code{.GlobalEnv} workspace
#' holds the resulting \code{SpatialDesign} object with the name specified via
#' the GUI \code{Sample\eqn{'}s R name} box. A confirmation dialog appears
#' following completion of the draw. Large samples may require several tens of
#' minutes for completion.
#'
#' \item \sQuote{Plot Sample.} Following sampling, the \sQuote{Plot Sample}
#' button displays the sampled points on the sampling frame.
#'
#' \item \sQuote{Tabulate Sample.} Following sampling, display the GRTS design
#' file in a tabular format. The GRTS design file contains information on
#' each sampled unit, such as coordinates, and design variables, e.g., stratum
#' or multi-density category. It also contains design weights.
#'
#' \item \sQuote{Export.} Following sampling, the \sQuote{Export} button
#' prompts the user to save sampling results via a pop-up dialog box. The
#' sample can be exported as an ArcGIS shapefile (\code{.SHP}); Comma
#' Separated (\code{.CSV}); Google Earth (\code{.KML}); or Garmin format
#' (\code{.GPX}) file.
#'
#' Shapefiles actually consist of several files with different extensions.
#' Because of this, do not include the \code{.SHP} extension in the
#' \code{Name} field of the pop-up when exporting to a shapefile.
#'
#' \item \sQuote{Done.} Dismisses the GUI dialog box, leaving any sample
#' objects in the \code{.GlobalEnv} workspace.
#'
#' }
#'
#' @author Trent McDonald (tmcdonald@@west-inc.com) and Jason Mitchell
#' (jmitchell@@west-inc.com)
#'
#' @seealso \code{\link{spsurvey::grts}}
#'
#' @references Stevens, D. L. and A. R. Olsen (2004). Spatially balanced
#' sampling of natural resources. Journal of the American Statistical
#' Association 99, 262-278.
#'
#' Kincaid, T. (2015). GRTS Survey Designs for an Area Resource. Accessed
#' online May 6, 2016.
#' \code{https://cran.r-project.org/web/packages/spsurvey/vignettes/Area_Design.pdf}.
#'
#'
#'
#'
#' Starcevich L. A., DiDonato G., McDonald T., Mitchell, J. (2016). A GRTS
#' User\eqn{'}s Manual for the SDrawNPS Package: A graphical user interface
#' for Generalized Random Tessellation Stratified (GRTS) sampling and
#' estimation. National Park Service, U.S. Department of the Interior.
#' Natural Resource Report NPS/XXXX/NRR—20XX/XXX.
#'
#' @keywords design survey
#'
#' @examples
#' # Open a GUI for stratified GRTS sampling.
#' stratified.GUI()
#'
stratified.GUI <- function() {
#
# Setup and run a GUI to take a BAS sample
#
design <- "stratified"
# ---- Define the main window
win <- gtkWindowNew("toplevel")
win$setBorderWidth(8)
win$setTitle("SDrawNPS : Stratified sample drawing interface")
#gtkWindowSetIconFromFile(win, filename = "s-draw.ico") # need path to be correct here, or does not work, obviously
vbox1 <- gtkVBoxNew(FALSE, 8)
win$add(vbox1)
# ================= Sample type frame ============================
samp.types <- c("HAL - Halton Lattice Sampling",
"BAS - Balanced Acceptance Sampling",
"GRTS - Generalized Random Tessellation Stratified",
"SSS - Simple Systematic Sampling")
#this adds different sampling frames
#I don't forsee adding anything other than BAS, GRTS, or SSS -- HAL!!!
samp.type.combo <- gtkComboBoxNewText()
samp.type.combo$show()
for( i in samp.types ){
samp.type.combo$appendText( i )
}
samp.type.combo$setActive(2)
# print(gtkComboBoxGetActive(samp.type.combo))
# print(gtkComboBoxGetWrapWidth(samp.type.combo))
samp.type.frame <- gtkFrameNew("Sample Type")
samp.type.frame$setBorderWidth(8)
#this adds a label to the combo box
combo.box <- gtkHBoxNew(FALSE, 8)
combo.box$setBorderWidth(8)
combo.box$packStart( samp.type.combo )
samp.type.frame$add( combo.box )
hbox2 <- gtkHBoxNew(FALSE, 8)
#hbox2$setBorderWidth(8)
hbox2$packStart(samp.type.frame)
# logo <- gtkImageNewFromFile("s_draw_banner.png")
# hbox2$packStart(logo)
vbox1$packStart(hbox2)
# Handler for change in sample type
f.samp.type.change <- function(x,dat){
stype <- samp.type.combo$getActive()
# Carefull, don't get the numbers out of order with the options
if( stype == 0 ){
# Halton samples
over.entry$hide()
over.size.label$hide()
} else if( stype == 1 ){
# BAS samples
over.entry$hide()
over.size.label$hide()
} else if( stype == 2 ){
# GRTS samples
over.entry$show()
over.size.label$show()
} else {
# sss samples
over.entry$hide()
over.size.label$hide()
}
}
gSignalConnect(samp.type.combo, "changed", f.samp.type.change )
# ------ 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)
# ---- Over sample size text box
over.entry <- gtkEntry()
over.entry$setText( "0" )
over.size.label <- gtkLabel("Over sample, each strata:")
gtkTableAttach(opt.tbl,over.size.label, 0, 1, 1, 2, xpadding=5, ypadding=5)
gtkTableAttach(opt.tbl,over.entry, 1, 2, 1, 2, xpadding=5, ypadding=5)
# ---- Seed text box
# ---- Over sample size text box
over.entry <- gtkEntry()
over.entry$setText( "0" )
over.size.label <- gtkLabel("Over sample, each strata:")
gtkTableAttach(opt.tbl,over.size.label, 0, 1, 1, 2, xpadding=5, ypadding=5)
gtkTableAttach(opt.tbl,over.entry, 1, 2, 1, 2, xpadding=5, ypadding=5)
# ---- Seed text box
seed.entry <- gtkEntry()
seed.entry$setText( "" )
seed.label <- gtkLabel("Random number seed:")
gtkTableAttach(opt.tbl,seed.label, 0, 1, 0, 1, xpadding=5, ypadding=5)
gtkTableAttach(opt.tbl,seed.entry, 1, 2, 0, 1, xpadding=5, ypadding=5)
# # ---- Over sample size text boxes
# over.entry <- gtkEntry()
# over.entry$setText( "0" )
# over.size.label <- gtkLabel("Over sample, each strata:")
#
# # Hide initially because Halton Latice is initial sample type
# over.entry$hide()
# over.size.label$hide()
#
#
# gtkTableAttach(opt.tbl,over.size.label, 0, 1, 1, 2, xpadding=5, ypadding=5)
# gtkTableAttach(opt.tbl,over.entry, 1, 2, 1, 2, xpadding=5, ypadding=5)
# --------------------------- Middle horizontal box ---------------
req.frame <- gtkFrameNew("Required Inputs")
vbox1$packStart(req.frame)
hbox1 <- gtkHBoxNew(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("Frame Information")
hbox1$add(frame.frame) # Adds the frame to the horizontal box
# ---- Define a verticle box
req.vbox <- gtkVBoxNew(FALSE, 8)
req.vbox$setBorderWidth(8)
frame.frame$add(req.vbox)
# ---- Define table of boxes so everything aligns
tbl <- gtkTable(7,4,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 shape file box
shape.in.entry <- gtkEntry()
shape.in.entry$setText( "" )
shape.file.label <- gtkLabel("Shapefile OR 'sp' Object:")
shape.in.dir <- gtkEntry() # this entry box is hidden/not displayed
shape.in.dir$setText( getwd() )
# ---- 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("Sample's R name:")
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)
# # ---- Input stratifying variable information Guy added this section 12/19
# # ---- Stratum Names
strata.var.entry <- gtkEntry()
strata.var.entry$setText( "" )
strata.var.label <- gtkLabel("Name of Stratifying Variable:")
gtkTableAttach(tbl,strata.var.label, 0, 1, 2, 3, xpadding=5, ypadding=5)
gtkTableAttach(tbl,strata.var.entry, 1, 2, 2, 3, xpadding=5, ypadding=5)
# ============================ Sample Allocation frame ===========
#hbox1 <- gtkHBoxNew(FALSE, 8) #sets up another horizontal box, FALSE means things not evenly spaced, 8 is for 8 pixels between things
#hbox1$setBorderWidth(8)
#vbox1$add(hbox1)
samp.alloc.frame <- gtkFrameNew("Sample Allocation")
hbox1$add(samp.alloc.frame)
# Radio Buttons to Specify Sample Allocation
stype.box <- gtkVBoxNew(TRUE, 2)
stype.box$setBorderWidth(8)
samp.alloc.frame$add( stype.box )
prop.rb <- gtkRadioButtonNewWithLabel(label="Proportional to Size")
const.rb <- gtkRadioButtonNewWithLabelFromWidget(prop.rb,"Constant")
user.rb <- gtkRadioButtonNewWithLabelFromWidget(prop.rb,"User-specified")
#user.entry <-gtkEntry()
#user.entry$setText( "" ) #keep box blank
stype.box$packStart(prop.rb, TRUE, TRUE, 2)
stype.box$packStart(const.rb, TRUE, TRUE, 2)
stype.box$packStart(user.rb, TRUE, TRUE, 2)
#stype.box$packStart(user.entry, TRUE, TRUE, 2)
#this creates a box next to the user-specified button
#it would be nice to only have this box pop up if the user-specified button is clicked
f.write.sample.label <- function(x,dat){
prop.active <- prop.rb$getActive()
const.active <- const.rb$getActive()
if(prop.active){
n.label$setText("Specify: total n across all\n\tstrata")
} else if( const.active ){
n.label$setText("Specify: n for a single stratum")
} else {
# Note, because the three buttons are in a group, you don't need signal for the last one
n.label$setText("Specify: a comma delimited\n\tlist of n, in strata order")
}
}
gSignalConnect(prop.rb, "toggled", f.write.sample.label )
gSignalConnect(const.rb, "toggled", f.write.sample.label )
# ---- Sample sizes
n.frame <- gtkFrameNew( "Sample Size")
# n.tbl <- gtkTableNew(7,4,homogeneous=FALSE) #Bigger than we need. FALSE for nonhomogeneous
# gtkTableSetRowSpacings(n.tbl,1) #1 pixel between rows
# gtkTableSetColSpacings(n.tbl,5) #5 pixels between column
hbox1$add(n.frame)
n.vbox <- gtkVBoxNew(TRUE, 2)
n.vbox$setBorderWidth(8)
n.frame$add( n.vbox )
n.entry <- gtkEntry()
n.entry$setText( "" )
n.label <- gtkLabel("Specify: total n across all\n\tstrata")
n.label2 <- gtkLabel(" ")
n.vbox$packStart(n.label)
n.vbox$packStart(n.entry)
n.vbox$packStart(n.label2)
# gtkTableAttach(n.tbl,tot.size.label, 0, 1, 0, 1, xpadding=5, ypadding=5)
# gtkTableAttach(n.tbl,n.entry, 1, 2, 0, 1, xpadding=5, ypadding=5)
# # =========================== Seed row button ==================================
#
# # ---- Separator
# vbox1$packStart(gtkHSeparatorNew(), expand=FALSE)
#
# hbox3 <- gtkHBoxNew(FALSE, 8)
# hbox3$setBorderWidth(8)
# vbox1$add(hbox3)
#
# # add seed box.
# seed.random.frame <- gtkFrameNew("Generate a random seed?")
# hbox3$add(seed.random.frame) # alloc
#
# # Radio Buttons to Specify Sample Weights
# stype.box <- gtkHBoxNew(TRUE, 2)
# stype.box$setBorderWidth(8)
# seed.random.frame$add( stype.box )
#
# seedy.rb <- gtkRadioButtonNewWithLabel(label="Yes") #const.rb
# seedn.rb <- gtkRadioButtonNewWithLabelFromWidget(seedy.rb,label="No") # prop.rb
#
# stype.box$packStart(seedn.rb, TRUE, TRUE, 2)
# stype.box$packStart(seedy.rb, TRUE, TRUE, 2)
# =========================== Frame information area ==================================
# ---- Separator
vbox1$packStart(gtkHSeparatorNew(), expand=FALSE)
finfo.vbox <- gtkHBoxNew(FALSE,2)
finfo.vbox$setBorderWidth(8)
vbox1$packStart(finfo.vbox)
finfo.title <- gtkLabel("Frame Type: \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 thier 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 ---------------------------------------------------
# =========================== 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 Frame ")
gSignalConnect(read.b, "clicked", readButtonAction,
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", run.strat.sample, data=list(
samp.type.combo=samp.type.combo,
n.entry=n.entry,
shape.in.entry=shape.in.entry,
shape.in.dir=shape.in.dir,
strata.var.entry=strata.var.entry,
out.r.entry=out.r.entry,
over.entry=over.entry,
seed.entry=seed.entry,
prop.rb=prop.rb,
const.rb=const.rb,
user.rb=user.rb
# seedy.rb=seedy.rb,
# seedn.rb=seedn.r
)
)
bbox$packEnd(run.b, expand=FALSE)
# ---- Read frame button, but do not draw sample, this displays variables in shapefile
plot.b <- gtkButton(" Plot\nSample")
gSignalConnect(plot.b, "clicked", readButtonAction,
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(plot.b, expand=FALSE)
# ---- View button
view.b <- gtkButton("Tabulate\n Sample")
gSignalConnect(view.b, "clicked", view.sample, data=list(
out.r.entry = out.r.entry
))
bbox$packEnd( view.b, expand=FALSE)
# ??? # ---- Write to csv button
# write.csv.b <- gtkButton("Write CSV")
# gSignalConnect(write.csv.b, "clicked", SDraw::my.write.csv, data=list(
# out.r.entry = out.r.entry
# ))
# bbox$packEnd( write.csv.b, expand=FALSE)
# ---- Write to Shapefile button
write.shp.b <- gtkButton("Export")
gSignalConnect(write.shp.b, "clicked", my.write.shp, data=list(
out.r.entry = out.r.entry,
parent.window = win
))
bbox$packEnd( write.shp.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()
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.