Skip to content

Instantly share code, notes, and snippets.

@jverzani
Last active December 20, 2015 09:40
Show Gist options
  • Save jverzani/6109810 to your computer and use it in GitHub Desktop.
Save jverzani/6109810 to your computer and use it in GitHub Desktop.
Mock up of factor editor for gdf
##' I want
##' * relabel a factor
##' * collapse one or more factors
##' * append a level to a factor
##' * Select a factor to be the reference
##' * reorder factors (and make ordered along the way)
##'
##'
library(gWidgets2)
options(guiToolkit="RGtk2")
library(MASS)
f <- Cars93$Type
## adjust these properties during dialog
cur_reference_level <- f[1]
w <- gwindow("Edit factor")
g <- gpanedgroup(container=w, expand=TRUE)
lg <- gvbox(container=g)
cur_levels <- gtable(levels(f), container=lg,
multiple=TRUE,
expand=TRUE, fill="y")
names(cur_levels) <- "Levels"
cur_levels$remove_popup_menu()
bg <- ggroup(cont=lg)
add_level <- gbutton("add", cont=bg, handler=function(h,...) {
add_level_dialog()
})
tooltip(add_level) <- gettext("Add a new level to factor")
is_ordered <- gcheckbox("Ordered", container=bg, checked=is.ordered(f))
tooltip(is_ordered) <- gettext("Toggle if factor is ordered")
## right group
rg <- ggroup(container=g, expand=TRUE, fill="both")
cur_child <- gvbox(container=rg, expand=TRUE)
glabel("Directions...", cont=cur_child, anchor=c(-1,0))
## show different things based on selection...
none_selected <- function() {
delete(rg, cur_child)
cur_child <<- gvbox(container=rg, expand=TRUE)
glabel("Directions...", cont=cur_child, anchor=c(-1, 0))
}
one_selected <- function() {
## if one_is selected
delete(rg, cur_child)
cur_child <<- gvbox(container=rg, expand=TRUE)
## offer to relabel
glabel(gettext("Relabel:"), container=cur_child, anchor=c(-1,0))
rename_level <- gedit(svalue(cur_levels),
container=cur_child)
gseparator(container=cur_child)
## give choice of making ordered, or adjusting order
if(svalue(is_ordered)) {
bg <- ggroup(cont=cur_child)
move_up <- gbutton("up", cont=bg, handler=function(h,...) {
ind <- svalue(cur_levels, ind=TRUE)
cur <- cur_levels[]
cur[c(ind-1,ind)] <- cur[c(ind, ind-1)]
cur_levels[] <- cur
svalue(cur_levels) <- ind - 1
selection_changed()
})
move_down <- gbutton("down", cont=bg, handler=function(h,...) {
ind <- svalue(cur_levels, ind=TRUE)
cur <- cur_levels[]
cur[c(ind,ind + 1)] <- cur[c(ind+1, ind)]
cur_levels[] <- cur
svalue(cur_levels) <- ind + 1
selection_changed()
})
tooltip(move_up) <- gettext("Move selected level up in the order")
tooltip(move_down) <- gettext("Move selected level down in the order")
cur_ind <- svalue(cur_levels, ind=TRUE)
nlevs <- length(cur_levels[])
enabled(move_up) <- cur_ind > 1
enabled(move_down) <- cur_ind < nlevs
} else {
## can make ordered *or* make reference level
bg <- ggroup(container=cur_child)
ref_button <- gbutton("Set as reference", cont=bg, handler=function(h,...) {
ind <- svalue(cur_levels, index=TRUE)
if (ind == 1) return()
cur_reference_level <<- svalue(cur_levels)
blockHandler(cur_levels)
tmp <- cur_levels[]
tmp[c(1, ind)] <- tmp[c(ind, 1)]
cur_levels[] <- tmp
svalue(cur_levels, index=TRUE) <- 1
unblockHandler(cur_levels)
})
tooltip(ref_button) <- "
For an unordered factor, the top most level is set
as the reference level.Clicking this button will
move the selected level to the top.
"
}
addSpring(cur_child)
addHandlerChanged(rename_level, handler=function(h,...) {
blockHandler(rename_level)
ind <- svalue(cur_levels, index=TRUE)
new_name <- svalue(h$obj)
tmp <- cur_levels[]
tmp[ind] <- new_name
cur_levels[] <- tmp
svalue(cur_levels, index=TRUE) <- ind
svalue(rename_level) <- ""
unblockHandler(rename_level)
focus(cur_levels) <- TRUE
})
}
more_than_one_selected <- function() {
delete(rg, cur_child)
cur_child <<- gvbox(container=rg, expand=TRUE)
glabel("Collapse selected levels to:", container=cur_child, anchor=c(-1,0))
collapse_levels <- gedit("", intial.msg="Collapse levels to...",
container=cur_child)
addSpring(cur_child)
addHandlerChanged(collapse_levels, handler=function(h,...) {
blockHandler(cur_levels);
ind <- svalue(cur_levels, index=TRUE)
if (length(ind) < 2)
return()
tmp <- cur_levels[]
tmp[ind] <- svalue(collapse_levels)
tmp <- tmp[-sort(ind)[-1]]
cur_levels[] <- tmp
unblockHandler(cur_levels)
svalue(cur_levels, index=TRUE) <- sort(ind)[1]
})
}
##
selection_changed <- function(...) {
ind <- svalue(cur_levels, index=TRUE)
if(length(ind) == 0)
none_selected()
else if(length(ind) == 1)
one_selected()
else
more_than_one_selected()
}
addHandlerSelectionChanged(cur_levels, handler=selection_changed)
addHandlerChanged(is_ordered, handler=function(...) {
ind <- svalue(cur_levels, index=TRUE)
if (length(ind)==0 || ind < 1)
ind <- 1
svalue(cur_levels, index=TRUE) <- ind
})
##
add_level_dialog <- function() {
## add a level to current levels
dlg <- gbasicdialog(parent=w, handler=function(...) {
new_val <- svalue(e)
tmp <- cur_levels[]
if(nchar(new_val) > 0 && !(new_val %in% tmp)) {
blockHandler(cur_levels)
tmp <- c(tmp, new_val)
cur_levels[] <- tmp
unblockHandler(cur_levels)
svalue(cur_levels, index=TRUE) <- length(tmp)
}
})
g <- gvbox(cont=dlg)
glabel("Add a new level to factor ...", cont=g, anchor=c(-1,0))
e <- gedit("", container=g)
visible(dlg, TRUE)
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment