R/probeSelectionInterface.R

In yaqcaffy: Affymetrix expression data quality control and reproducibility analysis

## =====================================
## Probe selection tcl/tk interface,
## return an YaqcControlProbes object
## - - - - - - - - - - - - - - - - - - -

probeSelectionInterface <- function(object,
                                    returnVar="yaqcControlProbes",
                                    filter=TRUE) {
  (require (tcltk) & require(tcltk2)) || stop("Package tcltk2 is not available.")
  if (exists(returnVar,.GlobalEnv)) {
    msg <- paste("Variable '",returnVar,"' exists in your global environment.",sep="")
    tkmessageBox(message=msg,icon="warning",type="ok")
  }
  this.info <- paste("Generated by 'probeSelectionInterface()' on",Sys.time(),"by",Sys.info()["user"])
  tt <- tktoplevel()
  mainframe <- tkframe(tt)
  if (filter) tkwm.title(tt,"Filtered selection")
  else tkwm.title(tt,"Probe selection")
  
  ## - - - - - - - - - - - - - - - - - - - - - - - - - -
  ## Upper frame: Notebook with 3 tabs
  upperframe <- tkframe(mainframe,relief="flat")
  nb <- tk2notebook(upperframe,
                    tabs = c("Hybridization", "Labeling","Degradation"))
  tkpack(nb, fill = "both", expand = 1)
  tb1 <- tk2notetab(nb, "Hybridization")
  tb2 <- tk2notetab(nb, "Labeling")
  tb3 <- tk2notetab(nb, "Degradation")
  if (filter) fnames <- grep("AFFX",featureNames(object),value=TRUE)
  else fnames <- featureNames(object)
  wd <- max(nchar(fnames))  
  ## tclVars
  xb5 <- tclVar("Select a BioB_5 probe") ## bio
  xb3 <- tclVar("Select a BioB_3 probe")
  xbm <- tclVar("Select a BioB_M probe")
  xc5 <- tclVar("Select a BioC_5 probe")
  xc3 <- tclVar("Select a BioC_3 probe")
  xd5 <- tclVar("Select a BioD_5 probe")
  xd3 <- tclVar("Select a BioD_3 probe")
  xdap5 <- tclVar("Select a Dap_5 probe") # skp
  xdap3 <- tclVar("Select a Dap_3 probe")
  xdapm <- tclVar("Select a Dap_M probe")
  xthr5 <- tclVar("Select a Thr_5 probe")
  xthr3 <- tclVar("Select a Thr_3 probe")
  xthrm <- tclVar("Select a Thr_M probe")
  xphe5 <- tclVar("Select a Phe_5 probe")
  xphe3 <- tclVar("Select a Phe_3 probe")
  xphem <- tclVar("Select a Phe_M probe")  
  xlys5 <- tclVar("Select a Lys_5 probe")
  xlys3 <- tclVar("Select a Lys_3 probe")
  xlysm <- tclVar("Select a Lys_M probe") 
  xact3 <- tclVar("Select an actin_3 probe") ## deg
  xact5 <- tclVar("Select an actin_5 probe")
  xactm <- tclVar("Select an actin_m probe")
  xgap3 <- tclVar("Select a gapdh_3 probe")
  xgap5 <- tclVar("Select a gapdh_5 probe")
  xgapm <- tclVar("Select a gapdh_m probe")
  
  if (filter) {
    ## First tab: Hybridization
    b5 <- grep("[B|b]io[B|b].+5",fnames)
    tcb.b5 <- ttkcombobox(tb1,values=fnames[b5],textvariable=xb5,width=wd)
    b3 <- grep("[B|b]io[B|b].+3",fnames)
    tcb.b3 <- ttkcombobox(tb1,values=fnames[b3],textvariable=xb3,width=wd)
    bm <- grep("[B|b]io[B|b].+M",fnames)
    tcb.bm <- ttkcombobox(tb1,values=fnames[bm],textvariable=xbm,width=wd)
    c5 <- grep("[B|b]io[C|c].+5",fnames)
    tcb.c5 <- ttkcombobox(tb1,values=fnames[c5],textvariable=xc5,width=wd)
    c3 <- grep("[B|b]io[C|c].+3",fnames)
    tcb.c3 <- ttkcombobox(tb1,values=fnames[c3],textvariable=xc3,width=wd)
    d5 <- grep("[B|b]io[D|d].+5",fnames)
    tcb.d5 <- ttkcombobox(tb1,values=fnames[d5],textvariable=xd5,width=wd)
    d3 <- grep("[B|b]io[D|d].+3",fnames)
    tcb.d3 <- ttkcombobox(tb1,values=fnames[d3],textvariable=xd3,width=wd)
    ## Second tab: Labeling probes
    dap5 <- grep("[D|d]ap.+5",fnames)
    tcb.dap5 <- ttkcombobox(tb2,values=fnames[dap5],textvariable=xdap5,width=wd)
    dap3 <- grep("[D|d]ap.+3",fnames)
    tcb.dap3 <- ttkcombobox(tb2,values=fnames[dap3],textvariable=xdap3,width=wd)
    dapm <- grep("[D|d]ap.+M",fnames)
    tcb.dapm <- ttkcombobox(tb2,values=fnames[dapm],textvariable=xdapm,width=wd)
    thr5 <- grep("[T|t]hr.+5",fnames)
    tcb.thr5 <- ttkcombobox(tb2,values=fnames[thr5],textvariable=xthr5,width=wd)
    thr3 <- grep("[T|t]hr.+3",fnames)
    tcb.thr3 <- ttkcombobox(tb2,values=fnames[thr3],textvariable=xthr3,width=wd)
    thrm <- grep("[T|t]hr.+M",fnames)
    tcb.thrm <- ttkcombobox(tb2,values=fnames[thrm],textvariable=xthrm,width=wd)
    phe5 <- grep("[P|p]he.+5",fnames)
    tcb.phe5 <- ttkcombobox(tb2,values=fnames[phe5],textvariable=xphe5,width=wd)
    phe3 <- grep("[P|p]he.+3",fnames)
    tcb.phe3 <- ttkcombobox(tb2,values=fnames[phe3],textvariable=xphe3,width=wd)
    phem <- grep("[P|p]he.+M",fnames)
    tcb.phem <- ttkcombobox(tb2,values=fnames[phem],textvariable=xphem,width=wd)
    lys5 <- grep("[L|l]ys.+5",fnames)
    tcb.lys5 <- ttkcombobox(tb2,values=fnames[lys5],textvariable=xlys5,width=wd)
    lys3 <- grep("[L|l]ys.+3",fnames)
    tcb.lys3 <- ttkcombobox(tb2,values=fnames[lys3],textvariable=xlys3,width=wd)
    lysm <- grep("[L|l]ys.+M",fnames)
    tcb.lysm <- ttkcombobox(tb2,values=fnames[lysm],textvariable=xlysm,width=wd)
    ## Third tab: degradation probes
    nodegs <- c(b5,b3,bm,c5,c3,d5,d3,
                dap5,dap3,dapm,
                thr5,thr3,thrm,
                phe5,phe3,phem,
                lys5,lys3,lysm)
    tcb.act3 <- ttkcombobox(tb3,values=fnames[-nodegs],textvariable=xact3,width=wd)
    tcb.act5 <- ttkcombobox(tb3,values=fnames[-nodegs],textvariable=xact5,width=wd)
    tcb.actm <- ttkcombobox(tb3,values=fnames[-nodegs],textvariable=xactm,width=wd)
    tcb.gap3 <- ttkcombobox(tb3,values=fnames[-nodegs],textvariable=xgap3,width=wd)
    tcb.gap5 <- ttkcombobox(tb3,values=fnames[-nodegs],textvariable=xgap5,width=wd)
     tcb.gapm <- ttkcombobox(tb3,values=fnames[-nodegs],textvariable=xgapm,width=wd)
  } else {
    tcb.b5 <- ttkcombobox(tb1,values=fnames,textvariable=xb5,width=wd) ## bio
    tcb.b3 <- ttkcombobox(tb1,values=fnames,textvariable=xb3,width=wd)
    tcb.bm <- ttkcombobox(tb1,values=fnames,textvariable=xbm,width=wd)
    tcb.c5 <- ttkcombobox(tb1,values=fnames,textvariable=xc5,width=wd)
    tcb.c3 <- ttkcombobox(tb1,values=fnames,textvariable=xc3,width=wd)
    tcb.d5 <- ttkcombobox(tb1,values=fnames,textvariable=xd5,width=wd)
    tcb.d3 <- ttkcombobox(tb1,values=fnames,textvariable=xd3,width=wd)
    tcb.dap5 <- ttkcombobox(tb2,values=fnames,textvariable=xdap5,width=wd) ## spk
    tcb.dap3 <- ttkcombobox(tb2,values=fnames,textvariable=xdap3,width=wd)
    tcb.dapm <- ttkcombobox(tb2,values=fnames,textvariable=xdapm,width=wd)
    tcb.thr5 <- ttkcombobox(tb2,values=fnames,textvariable=xthr5,width=wd)
    tcb.thr3 <- ttkcombobox(tb2,values=fnames,textvariable=xthr3,width=wd)
    tcb.thrm <- ttkcombobox(tb2,values=fnames,textvariable=xthrm,width=wd)
    tcb.phe5 <- ttkcombobox(tb2,values=fnames,textvariable=xphe5,width=wd)
    tcb.phe3 <- ttkcombobox(tb2,values=fnames,textvariable=xphe3,width=wd)
    tcb.phem <- ttkcombobox(tb2,values=fnames,textvariable=xphem,width=wd)
    tcb.lys5 <- ttkcombobox(tb2,values=fnames,textvariable=xlys5,width=wd)
    tcb.lys3 <- ttkcombobox(tb2,values=fnames,textvariable=xlys3,width=wd)
    tcb.lysm <- ttkcombobox(tb2,values=fnames,textvariable=xlysm,width=wd)
    tcb.act3 <- ttkcombobox(tb3,values=fnames,textvariable=xact3,width=wd) ## deg
    tcb.act5 <- ttkcombobox(tb3,values=fnames,textvariable=xact5,width=wd)
    tcb.actm <- ttkcombobox(tb3,values=fnames,textvariable=xactm,width=wd)
    tcb.gap3 <- ttkcombobox(tb3,values=fnames,textvariable=xgap3,width=wd)
    tcb.gap5 <- ttkcombobox(tb3,values=fnames,textvariable=xgap5,width=wd)
    tcb.gapm <- ttkcombobox(tb3,values=fnames,textvariable=xgapm,width=wd)
  }
  ## Packing
  tkpack(tcb.b5) ## bio
  tkpack(tcb.b3)
  tkpack(tcb.bm)
  tkpack(tklabel(tb1,text="       "))
  tkpack(tcb.c5)
  tkpack(tcb.c3)
  tkpack(tklabel(tb1,text="       "))
  tkpack(tcb.d5)
  tkpack(tcb.d3)
  tkpack(tcb.dap5) ## spk
  tkpack(tcb.dap3)
  tkpack(tcb.dapm)
  tkpack(tklabel(tb2,text="       "))
  tkpack(tcb.thr5)
  tkpack(tcb.thr3)
  tkpack(tcb.thrm)
  tkpack(tklabel(tb2,text="       "))
  tkpack(tcb.phe5)
  tkpack(tcb.phe3)
  tkpack(tcb.phem)
  tkpack(tklabel(tb2,text="       "))
  tkpack(tcb.lys5)
  tkpack(tcb.lys3)
  tkpack(tcb.lysm)
  tkpack(tcb.act3) ## deg
  tkpack(tcb.act5) 
  tkpack(tcb.actm) 
  tkpack(tklabel(tb3,text="       "))
  tkpack(tcb.gap3) 
  tkpack(tcb.gap5) 
  tkpack(tcb.gapm) 

  ## - - - - - - - - - - - - - - - - - - -
  ## Lower frame: buttons
  lowerframe <- tkframe(mainframe,relief="flat")
  ok <- tk2button(lowerframe, text = "Ok",
                  command = function() {
                    ll <- list(bio=c(tclvalue(xb5),tclvalue(xb3),tclvalue(xbm),
                                 tclvalue(xc5),tclvalue(xc3),
                                 tclvalue(xd5),tclvalue(xd3)),
                               spk=c(tclvalue(xdap5),tclvalue(xdap3),tclvalue(xdapm),
                                 tclvalue(xthr5),tclvalue(xthr3),tclvalue(xthrm),
                                 tclvalue(xphe5),tclvalue(xphe3),tclvalue(xphem),
                                 tclvalue(xlys5),tclvalue(xlys3),tclvalue(xlysm)),
                               deg=c(tclvalue(xact5),tclvalue(xact3),tclvalue(xactm),
                                 tclvalue(xgap5),tclvalue(xgap3),tclvalue(xgapm))
                               )
                    names(ll[["bio"]]) <- c("b5","b3","bm","c5","c3","d5","d3")
                    names(ll[["spk"]]) <- c("dap5","dap3","dapm",
                                            "thr5","thr3","thrm",
                                            "phe5","phe3","phem",
                                            "lys5","lys3","lysm")
                    names(ll[["deg"]]) <- c("act5","act3","actm",
                                            "gap5","gap3","gapm")
                    cp <- new("YaqcControlProbes",
                              bio=new("YaqcBioProbes",bio=ll[["bio"]]),
                              spk=new("YaqcSpkProbes",spk=ll[["spk"]]),
                              deg=new("YaqcDegProbes",deg=ll[["deg"]]),
                              info=this.info)
                    assign(returnVar,cp,envir=.GlobalEnv)
                    tkdestroy(tt)
                  })
  close <- tk2button(lowerframe, text = "Close",
                     command = function() {
                       tkdestroy(tt)
                     })
  tkgrid(mainframe)
  tkgrid(upperframe)
  tkgrid(lowerframe)
  tkgrid(ok,close)
}