Color selector widget with gWidgets2RGtk2

widget_colorSelector.R

library(gWidgets2RGtk2)
library(cairoDevice)
library(ggplot2)

### make two examples datasets ###
dat1 <- data.frame(FACTOR1=gl(2,3, labels=c("abc","ABC")), FACTOR2=gl(3,2, labels=c("uv","wx","yz")), x=1:6, y=1:6)
dat2 <- data.frame(FACTOR1=gl(2,3, labels=c("xyz","XYZ")), FACTOR2=gl(3,2, labels=c("ab","cd","ef")), x=1:6, y=6:1)


### gWidgets macros ###
#
## get the labels of a gformlayout (gWidgets2)
# then change label style by using labs <- get_labels(fl); fl$set_rgtk2_font(labels[[1]], list(weight="bold"))
get_labels <- function(fl) {
  children <- Map(function(x) x$getWidget(), fl$widget$getChildren())
  labels <- Filter(function(x) is(x, "GtkLabel"), children)
  names(labels) <- sapply(labels, function(x) x$getText())
  labels
}
#
## new reference class for color selection widget
colorSelector <- NULL
gg.colors <<- c(1:9) # c("#984EA3", "#F781BF", "#E41A1C", "#377EB8", "#4DAF4A", "#FF7F00", "#A65628", "#999999", "#FFFF33")
names(gg.colors) <- c("Purple", "Pink", "Red", "Blue", "Green", "Orange", "Brown", "Gray", "Yellow")
colorSelect <- setRefClass(
  "colorSelect",
  fields=list(
    g="GGroup",
    factor_select="list",#GComboBoxNoEntry", 
    factors="character",
    comboboxes="list",
    colors_select="GFormLayout",
    dataset="data.frame",
    factor_levels="character",
    handler="function"
  ),
  
  methods=list(
    
    initialize=function(df=data.frame(), action=function(colorify) NULL, cont=gwindow(), ...) {
      g <<- ggroup(horizontal=FALSE, cont=cont, ...)
      initFields( 
        dataset=df,
        factors=Filter(function(nm) is.factor(df[[nm]]) && nlevels(df[[nm]])<10, names(df)),
        handler=action
      )
      gf <- gframe("")
      factor_select <<- list(
        gcombobox(factors, selected=1, cont=g, 
                  handler=function(h,...){
                    update()
                  })
      )
      factor_levels <<- levels(dataset[[factors[1]]])
      nlevels <- length(factor_levels)
      colors_select <<- gformlayout(cont=g)
      comboboxes <<- lapply(1:nlevels, function(i) {
        gcombobox(names(gg.colors), selected=i, cont=colors_select, label=factor_levels[i])
      })
      Labels <- get_labels(colors_select)
      sapply(1:nlevels, function(i){
        colors_select$set_rgtk2_font(Labels[[factor_levels[i]]], list(color=names(gg.colors)[i], weight="bold"))
      })
      make_exclusive()
      colorify <- list(factor=factors[1], colors=names(gg.colors)[1:nlevels])
      handler(colorify)
      .self      
    },
    
    update=function(){
      delete(g, colors_select)
      colors_select <<- gformlayout(cont=g)
      factor <- svalue(factor_select[[1]])
      factor_levels <<- levels(dataset[[factor]])
      comboboxes <<- lapply(1:length(factor_levels), function(i) {
        gcombobox(names(gg.colors), selected=i, cont=colors_select, label=factor_levels[i])
      })
      make_exclusive()
      labels_coloring()
      handler(get_values())
      .self 
    },
    
    make_exclusive=function() {
      sapply(1:length(comboboxes), function(i) {
        addHandlerChanged(comboboxes[[i]], handler=function(h,...) {
          all_selected <- sapply(comboboxes, svalue)
          selected <- svalue(h$obj)          
          ind <- which(selected == all_selected)          
          if(length(ind) > 1) {
            j <- setdiff(ind, i)
            remaining <- setdiff(names(gg.colors), all_selected)
            tmp <- comboboxes[[j]]
            svalue(tmp) <- remaining[1]
          }else{
            labels_coloring()
            handler(get_values())
          }
        })
      })
    },
    
    labels_coloring = function(){
      Labels <- get_labels(colors_select)
      sapply(1:length(factor_levels), function(i){ 
        colors_select$set_rgtk2_font(Labels[[factor_levels[i]]], list(color=tolower(svalue(comboboxes[[i]])), weight="bold"))
      })
    },
    
    get_values = function() list(factor=svalue(factor_select[[1]]), colors=unlist(svalue(colors_select))), 
    
    del = function(){
      delete(g, colors_select)
      delete(g, factor_select[[1]])
    }
  ))



################################################
###                                          ###
################################################
WINDOW0 <- gwindow("Color selector widget")
WINGRAPH <- gwindow("Plot") 
WINDOW <- ggroup(cont=WINDOW0) 
WINDOW$set_borderwidth(10L)
#
UI <- gvbox(container=WINDOW)
gf.dataset <- gframe("Choose a dataset", container=UI, horizontal=FALSE)
combo.dataset <- gcombobox(c("dat1","dat2"), container=gf.dataset)
go.plot <- gbutton("Plot!", container=gf.dataset, 
                   handler=function(h, ...){
                     dat <- eval(parse(text=svalue(combo.dataset)))
                     ggraph <<- ggraphics(container=WINGRAPH)
                     gg0 <<- ggplot(dat, aes(x=x, y=y)) + geom_point() 
                     print(gg0)
                     enabled(gf.colorify) <- TRUE
                   })
gf.colorify <- gframe("Color grouping", container=UI)
enabled(gf.colorify) <- FALSE
check.colorify <- gcheckbox("color by ...", container=gf.colorify, 
                            handler=function(h, ...){
                              if(svalue(h$obj)){
                                dat <- eval(parse(text=svalue(combo.dataset)))
                                colorSelector <<- colorSelect$new(
                                  dat,
                                  action = function(colorify){
                                    factor <- colorify$factor
                                    colors <- colorify$colors 
                                    print(
                                      ggplot(dat, aes_string(x="x", y="y", colour=factor)) + 
                                        geom_point() +
                                        scale_colour_manual(values=colors)
                                    )
                                  },
                                  gf.colorify
                                )
                              }else{
                                colorSelector$del()
                                print(gg0)
                              }
                            }
)