if(data.class(try(require(limma),TRUE))=="try-error"){
tkmessageBox(title="An error has occured!",message=paste("Cannot find package limma"),icon="error",type="ok")
stop("Cannot find package limma")
}
#
#
if(require(limma)==FALSE){
tkmessageBox(title="An error has occured!",message=paste("Cannot find package limma"),icon="error",type="ok")
stop("Cannot find package limma")
}
#
#
Try <- function(expr){
if(data.class(result<-try(expr,TRUE))=="try-error"){
tkmessageBox(title="An error has occured!",message=as.character(result),icon="error",type="ok")
}else{
return (result)
}
}
#
#
TryReadImgProcFile <- function(expr){
if(data.class(result<-try(expr,TRUE))=="try-error"){
tkmessageBox(title="Reading Image Processing Files Failed!",
message="limmaGUI was unable to read the image processing files listed in the Targets file.",icon="error",type="ok")
}else{
return (result)
}
} #end of TryReadImgProcFile <- function(expr)
#
#
Require <- function(pkg){
if(data.class(result<-try(find.package(pkg),TRUE))=="try-error"){
tkmessageBox(title="An error has occured!",message=paste("Cannot find package",pkg),icon="error",type="ok")
}else{
result <- Try(require(pkg,character.only=TRUE))
}
return (result)
} #end of Require <- function(pkg)
#
#
TclRequire <- function(tclPkg){
if((data.class(result<-try(tclRequire(tclPkg),TRUE))=="try-error") || (is.logical(result) && result==FALSE)){
limmaGUIglobals <- .limmaGUIglobals
limmaGUIglobals$TclRequireFailed <- TRUE
assign(".limmaGUIglobals",limmaGUIglobals,.GlobalEnv)
Try(winTitle<-"Tcl/Tk Extension(s) Not Found")
Try(message<-paste("Cannot find Tcl/Tk package \"", tclPkg,
"\". limmaGUI cannot continue.\n\n",
"limmaGUI requires the Tcl/Tk extensions, BWidget and Tktable.\n",
"You must have Tcl/Tk installed on your computer, not just the minimal\n",
"Tcl/Tk installation which comes with R (for Windows). If you do have\n",
"Tcl/Tk installed, including the extensions (e.g. using the ActiveTcl\n",
"distribution in Windows), make sure that R can find the path to the\n",
"Tcl library, e.g. C:\\Tcl\\lib (on Windows) or /usr/lib (on Linux/Unix)\n",
"or /sw/lib on Mac OSX.\n\n",
"If you don't know how to set environment variables in Windows, one way\n",
"to make sure that R can find the Tcl/Tk extensions Tktable2.8 and bwidget1.6\n",
"is to copy them from your ActiveTcl installation e.g. in C:\\Tcl\\lib into\n",
"the Tcl subdirectory of your R installation.\n",
"If you do understand how to set environment variables...\n",
"make sure that you have the TCL_LIBRARY environment variable set to the\n",
"appropriate path, e.g.C:\\Tcl\\lib\\tcl8.4 and the MY_TCLTK environment\n",
"variable set to a non-empty string, e.g. \"Yes\".\n\n",
"If using Windows, be sure to read the R for windows FAQ at\nhttp://www.stats.ox.ac.uk/pub/R/rw-FAQ.html\n\n",
"If your Tcl/Tk extensions still can't be found, try\n",
"addTclPath(\"<path to Tcl library>\").\nThis could be put in $HOME/.Rprofile\n\n",
"If you need further instructions, please contact your system administrator\n",
"and consider emailing r-help@stat.math.ethz.ch, or browse through the R-help\n",
"archives for a similar question.\n\n",
"The URLs for Tktable and BWidget are:\n",
"http://tktable.sourceforge.net\n",
"http://tcllib.sourceforge.net",
sep=""))
# Don't make ttMain a parent of this, because we might want to use TclRequire before
# defining ttMain.
Try(ttTclTkExtension <- tktoplevel())
onDestroy <- function(){
if(exists(".limmaGUIglobals",envir=.GlobalEnv)&&"ttMain" %in% names(.limmaGUIglobals))
try(tkdestroy(.limmaGUIglobals$ttMain),silent=TRUE)
else
stop("Tcl/Tk extensions (Tktable and BWidget) not found!")
stop("Aborted from limmaGUI.")
} #end of onDestroy <- function()
Try(tkbind(ttTclTkExtension, "<Destroy>", onDestroy))
Try(tkwm.title(ttTclTkExtension,winTitle))
Try(tkwm.deiconify(ttTclTkExtension))
Try(scr <- tkscrollbar(ttTclTkExtension, repeatinterval=5,
command=function(...)tkyview(txt,...)))
Try(txt <- tktext(ttTclTkExtension,bg="white",yscrollcommand=function(...)tkset(scr,...)))
Try(tkgrid(txt,scr,columnspan=2))
Try(tkgrid.configure(scr,columnspan=1,sticky="ns"))
Try(tkgrid.configure(txt,sticky="nsew"))
Try(tkinsert(txt,"end",message))
Try(tkconfigure(txt, state="disabled"))
Try(tkfocus(txt))
Try(
onOK <- function(){
try(tkdestroy(ttTclTkExtension),silent=TRUE)
if(exists(".limmaGUIglobals",envir=.GlobalEnv)&&"ttMain" %in% names(.limmaGUIglobals))
try(tkdestroy(.limmaGUIglobals$ttMain),silent=TRUE)
else
stop("Tcl/Tk extensions (Tktable and BWidget) not found!")
Try(LimmaFileName <- get("LimmaFileName",envir=limmaGUIenvironment))
Try(limmaDataSetNameText <- get("limmaDataSetNameText",envir=limmaGUIenvironment))
if(limmaDataSetNameText!="Untitled"){
Try(if(LimmaFileName=="Untitled" && limmaDataSetNameText!="Untitled") LimmaFileName <- limmaDataSetNameText) # Local assignment only
Try(
mbVal <- tkmessageBox(title="Aborting from limmaGUI",
message=paste("Save changes to ",fixSeps(LimmaFileName),"?",sep=""),
icon="question",
type="yesno",
default="yes")
)
try(
if(tclvalue(mbVal)=="yes")try(SaveLimmaFile(),silent=TRUE),silent=TRUE
)
} #end of if(limmaDataSetNameText!="Untitled")
stop("Tcl/Tk extensions (Tktable and BWidget) not found!")
} #end of onOK <- function()
)
Try(OK.but <- tkbutton(ttTclTkExtension,text=" OK ",command=onOK))
Try(tkgrid.configure(txt,columnspan=2))
Try(tkgrid(tklabel(ttTclTkExtension,text=" ")))
Try(tkgrid(tklabel(ttTclTkExtension,text="limmaGUI will now exit."),columnspan=2))
Try(tkgrid(tklabel(ttTclTkExtension,text=" ")))
Try(tkgrid(OK.but))
Try(tkgrid.configure(OK.but,sticky="e"))
Try(tkgrid(tklabel(ttTclTkExtension,text=" ")))
Try(tkfocus(OK.but))
Try(tkwait.window(ttTclTkExtension))
} #end of if((data.class(result<-try(tclRequire(tclPkg),TRUE))=="try-error") || (is.logical(result) && result==FALSE))
} # end of TclRequire
#
#
onDestroy <- function(){
Try(.JustAskedWhetherToSave <- get(".JustAskedWhetherToSave",envir=.GlobalEnv))
Try(
if(.JustAskedWhetherToSave==FALSE){
Try(LimmaFileName <- get("LimmaFileName",envir=limmaGUIenvironment))
Try(limmaDataSetNameText <- get("limmaDataSetNameText",envir=limmaGUIenvironment))
if(limmaDataSetNameText!="Untitled"){
Try(if(LimmaFileName=="Untitled" && limmaDataSetNameText!="Untitled") LimmaFileName <- limmaDataSetNameText) # Local assignment only
Try(mbVal <- tkmessageBox(title="Aborting from limmaGUI",
message=paste("Save changes to ",fixSeps(LimmaFileName),"?",sep=""),
icon="question",
type="yesno",
default="yes")
)
try(
if(tclvalue(mbVal)=="yes"){
try(SaveLimmaFile(),silent=TRUE)
}
,silent=TRUE
)
} #end of if(limmaDataSetNameText!="Untitled")
Try(assign(".JustAskedWhetherToSave",TRUE,.GlobalEnv))
} #end of if(.JustAskedWhetherToSave==FALSE)
)
} #end of onDestroy
#
#
limmaGUI <- function(BigfontsForlimmaGUIpresentation=FALSE){
assign("limmaGUIenvironment",new.env(),.GlobalEnv)
assign("Try",get("Try",envir=.GlobalEnv),limmaGUIenvironment)
# This option is for when I give a Presentation/talk on limmaGUI and want large limmaGUIfonts. Currently, there are
# some limmaGUIfonts which limmaGUI can't control, like menus, so as well as changing BigfontsForlimmaGUIpresentation to TRUE here, I
# Right-Click the Windows Desktop, click Properties (to get Display properties which can also be accessed
# through the Control Panel) then click on Appearance, and then change the limmaGUIfont size for menu,window title, etc.)
# Rather than change each limmaGUIfont (menu,window title,...) manually each time, I save the changes as a "scheme".
Try(limmaGUIglobals <- list())
Try(
if(BigfontsForlimmaGUIpresentation==TRUE){
Try(limmaGUIglobals$limmaGUIpresentation <- TRUE)
}else{
Try(limmaGUIglobals$limmaGUIpresentation <- FALSE)
}
)
Try(limmaGUIglobals$limmaDataSetNameTcl <- tclVar("Untitled"))
Try(assign(".limmaGUIglobals",limmaGUIglobals,.GlobalEnv))
Try(initGlobals())
Try(limmaGUIglobals <- get(".limmaGUIglobals",envir=.GlobalEnv))
Try(limmaGUIglobals$graphicsDevice <- "tkrplot")
Try(if(Sys.info()["sysname"]=="Darwin")Try(limmaGUIglobals$graphicsDevice <- "R"))
Try(limmaGUIglobals$Myhscale <- 1)
Try(limmaGUIglobals$Myvscale <- 1)
assign(".limmaGUIglobals",limmaGUIglobals,.GlobalEnv)
#
Try(
if(exists("X11", envir=.GlobalEnv) && Sys.info()["sysname"] != "Windows"){
Try(
if(Sys.info()["sysname"]=="Darwin"){
Try(addTclPath("/sw/lib/tcl8.4"))
Try(addTclPath("/sw/lib"))
Try(addTclPath("./lib"))
Try(addTclPath("/sw/lib/tk8.4"))
Try(addTclPath(paste(Sys.getenv("HOME"),.Platform$file.sep,"TkExtensions",sep="")))
} #end of if(Sys.info()["sysname"]=="Darwin")
)
Try(addTclPath("/usr/local/lib"))
Try(addTclPath("/usr/local/Tcl/lib"))
Try(addTclPath("/usr/local/lib/Tcl"))
Try(addTclPath("/usr/lib"))
Try(addTclPath("/usr/lib/Tcl"))
Try(addTclPath("/usr/local/ActiveTcl/lib"))
Try(limmaGUIglobals <- get(".limmaGUIglobals",envir=.GlobalEnv))
Try(limmaGUIglobals$Myhscale <- 1)
Try(limmaGUIglobals$Myvscale <- 1)
Try(assign(".limmaGUIglobals",limmaGUIglobals,.GlobalEnv))
} #end of if(exists("X11", envir=.GlobalEnv) && Sys.info()["sysname"] != "Windows")
)
Try(
if(Sys.info()["sysname"] == "Windows"){
Try(limmaGUIglobals <- get(".limmaGUIglobals",envir=.GlobalEnv))
Try(limmaGUIglobals$Myhscale <- 1.6)
Try(limmaGUIglobals$Myvscale <- 1.6)
Try(assign(".limmaGUIglobals",limmaGUIglobals,.GlobalEnv))
} #end of if(Sys.info()["sysname"] == "Windows")
)
Try(
if(Sys.info()["sysname"] == "Darwin" && !exists("X11", envir=.GlobalEnv)){
Try(addTclPath("/Library/Tcl"))
Try(addTclPath("/Network/Library/Tcl"))
Try(addTclPath("/System/Library/Tcl"))
Try(addTclPath("/Library/Frameworks/Tcl"))
Try(HOME <- Sys.getenv("HOME"))
Try(
if(nchar(HOME)>0){
Try(addTclPath(paste(HOME,"/Library/Tcl",sep="")))
Try(addTclPath(paste(HOME,"/Network/Library/Tcl",sep="")))
Try(addTclPath(paste(HOME,"/System/Library/Tcl",sep="")))
Try(addTclPath(paste(HOME,"/Library/Frameworks/Tcl",sep="")))
} #end of if(nchar(HOME)>0)
)
Try(limmaGUIglobals <- get(".limmaGUIglobals",envir=.GlobalEnv))
Try(limmaGUIglobals$Myhscale <- 1)
Try(limmaGUIglobals$Myvscale <- 1)
Try(assign(".limmaGUIglobals",limmaGUIglobals,.GlobalEnv))
} #end of if(Sys.info()["sysname"] == "Darwin" && !exists("X11", envir=.GlobalEnv))
)
Try(limmaGUIglobals <- get(".limmaGUIglobals",envir=.GlobalEnv))
Try(
if(.limmaGUIglobals$limmaGUIpresentation==TRUE)
Try(limmaGUIglobals$limmaGUIfont1 <- tkfont.create(family="times",size=48,weight="bold",slant="italic"))
else
Try(limmaGUIglobals$limmaGUIfont1 <- tkfont.create(family="times",size=24,weight="bold",slant="italic"))
)
Try(
if(.limmaGUIglobals$limmaGUIpresentation==TRUE)
Try(limmaGUIglobals$limmaGUIfont2 <- tkfont.create(family="arial",size=16))
else
Try(limmaGUIglobals$limmaGUIfont2 <- tkfont.create(family="arial",size=10))
)
Try(
if(.limmaGUIglobals$limmaGUIpresentation==TRUE)
Try(limmaGUIglobals$limmaGUIfontTree <- tkfont.create(family="arial",size=14))
else
Try(limmaGUIglobals$limmaGUIfontTree <- tkfont.create(family="arial",size=10))
)
Try(
if(.limmaGUIglobals$limmaGUIpresentation==TRUE)
Try(limmaGUIglobals$limmaGUIfontTable <- tkfont.create(family="arial",size=16))
else
Try(limmaGUIglobals$limmaGUIfontTable <- tkfont.create(family="arial",size=10))
)
Try(
if(.limmaGUIglobals$limmaGUIpresentation==TRUE)
Try(limmaGUIglobals$limmaGUIfontTopTable <- tkfont.create(family="arial",size=12,weight="bold"))
else
Try(limmaGUIglobals$limmaGUIfontTopTable <- limmaGUIglobals$limmaGUIfontTable)
)
Try(
if(.limmaGUIglobals$limmaGUIpresentation==TRUE)
Try(limmaGUIglobals$limmaGUIfont2b <- tkfont.create(family="arial",size=16,weight="bold"))
else
Try(limmaGUIglobals$limmaGUIfont2b <- tkfont.create(family="arial",size=10,weight="bold"))
)
Try(
if(.limmaGUIglobals$limmaGUIpresentation==TRUE)
Try(limmaGUIglobals$limmaGUIfontCourier <- tkfont.create(family="courier",size=16))
else
Try(limmaGUIglobals$limmaGUIfontCourier <- tkfont.create(family="courier",size=10))
)
Try(limmaGUIglobals$mainTreeWidth <- 30)
Try(
if(.limmaGUIglobals$limmaGUIpresentation==TRUE)
Try(limmaGUIglobals$ParameterizationTREEWidth <- 40)
else
Try(limmaGUIglobals$ParameterizationTREEWidth <- 30)
)
Try(
if(.limmaGUIglobals$limmaGUIpresentation==TRUE){
Try(limmaGUIglobals$ParameterizationTREEHeight <- 20)
Try(limmaGUIglobals$mainTreeHeight <- 20)
}else{
Try(limmaGUIglobals$ParameterizationTREEHeight <- 15)
Try(limmaGUIglobals$mainTreeHeight <- 15)
} #end of if(.limmaGUIglobals$limmaGUIpresentation==TRUE)
)
Try(limmaGUIglobals$oldOptions <- options(warn=-1)) # Otherwise R complains that I'm trying to set main in plots, i.e. set a plot title)
# Maybe it would be nice to eventually use the MainFrame widget from BWidget so we can have a nice toolbar etc.
Try(limmaGUIglobals$ttMain <- tktoplevel())
Try(assign(".limmaGUIglobals",limmaGUIglobals,.GlobalEnv))
Try(tkbind(.limmaGUIglobals$ttMain, "<Destroy>", onDestroy))
TclRequire("BWidget")
if("TclRequireFailed" %in% names(.limmaGUIglobals))
stop("Error occurred in TclRequire(\"BWidget\")")
TclRequire("Tktable")
if("TclRequireFailed" %in% names(.limmaGUIglobals))
stop("Error occurred in TclRequire(\"Tktable\")")
#
Try(
if(.limmaGUIglobals$limmaGUIpresentation==FALSE)
Try(mainFrame <- tkframe(.limmaGUIglobals$ttMain,relief="groove",borderwidth="2"))
else
Try(mainFrame <- tkframe(.limmaGUIglobals$ttMain))
)
Try(
if(.limmaGUIglobals$limmaGUIpresentation==FALSE){
Try(toolbarFrame <- tkframe(mainFrame,relief="groove",borderwidth="2"))
Try(tb <- tkframe(toolbarFrame,relief="groove",borderwidth="2"))
# The Bitmap::get stuff below requires the BWidget package.
# I think this could be done more simply with something like :
# Try(newButton <- tkbutton(tb,image=tcl("Bitmap::get","new"),command=NewLimmaFile))
Try(newButton <- .Tcl(paste("button",.Tk.subwin(tb),"-image [Bitmap::get new]",.Tcl.args(command=NewLimmaFile))))
Try(openButton <- .Tcl(paste("button",.Tk.subwin(tb),"-image [Bitmap::get open]",.Tcl.args(command=OpenLimmaFile))))
Try(saveButton <- .Tcl(paste("button",.Tk.subwin(tb),"-image [Bitmap::get save]",.Tcl.args(command=SaveLimmaFile))))
Try(tkgrid(newButton,openButton,saveButton,sticky="w"))
Try(tkgrid(tb,sticky="nw"))
# Try(tkgrid(toolbarFrame,sticky="ew"))
Try(tkgrid(toolbarFrame,sticky="w"))
# Try(tkgrid.configure(tb,sticky="w"))
} #end of if(.limmaGUIglobals$limmaGUIpresentation==FALSE)
)
#
Try(limmaDataSetNameText <- get("limmaDataSetNameText",envir=limmaGUIenvironment))
Try(LimmaFileName <- get("LimmaFileName",limmaGUIenvironment))
Try(if(LimmaFileName=="Untitled" && limmaDataSetNameText!="Untitled") LimmaFileName <- limmaDataSetNameText) # Local assignment only
Try(tkwm.title(.limmaGUIglobals$ttMain,paste("LimmaGUI -",fixSeps(LimmaFileName))))
Try(limmaGUIglobals <- .limmaGUIglobals)
Try(limmaGUIglobals$GALfileBoxTitle <- tclVar("Please select a GenePix Array List (GAL) file. (OPTIONAL)"))
Try(limmaGUIglobals$GALfileNameTcl <- tclVar("No filename is selected at the moment. Press the Select GAL File Button."))
Try(limmaGUIglobals$TargetsfileBoxTitleTcl <- tclVar("Please select a tab-delimited RNA Targets file. (REQUIRED)"))
Try(limmaGUIglobals$TargetsfileNameTcl <- tclVar("No filename is selected at the moment. Press the Select Targets File Button."))
Try(limmaGUIglobals$SpotTypesfileBoxTitleTcl <- tclVar("Please select a tab-delimited Spot Types file. (OPTIONAL)"))
Try(limmaGUIglobals$SpotTypesfileNameTcl <- tclVar("No filename is selected at the moment. Press the Select Spot-Types File Button."))
Try(assign(".limmaGUIglobals",limmaGUIglobals,.GlobalEnv))
#
Try(tkgrid(tklabel(mainFrame,text=" "),columnspan=3))
Try(
if(.limmaGUIglobals$limmaGUIpresentation==TRUE)
Try(tkgrid(tklabel(mainFrame,text="LimmaGUI",font=.limmaGUIglobals$limmaGUIfont1),column=1,columnspan=3,sticky="ew"))
else
Try(tkgrid(tklabel(mainFrame,text=" LimmaGUI ",font=.limmaGUIglobals$limmaGUIfont1),column=2,sticky="ew"))
)
Try(tkgrid(tklabel(mainFrame,text="Welcome to LimmaGUI, a package for Linear Modelling of Microarray Data.\nPlease select the Citations item from the Help Menu for citation information.",font=.limmaGUIglobals$limmaGUIfont2),columnspan=5))
Try(tkgrid(tklabel(mainFrame,text=" "),columnspan=5))
Try(tkgrid(tklabel(mainFrame,text=" "),columnspan=5))
Try(limmaDataSetName.but <- tkbutton(mainFrame,text="Data Set Name",command=GetlimmaDataSetName,font=.limmaGUIglobals$limmaGUIfont2))
Try(tkgrid(limmaDataSetName.but,column=2,columnspan=1))
Try(tkgrid(tklabel(mainFrame,text=" "),columnspan=5))
Try(mainTreeXScr <- tkscrollbar(mainFrame, repeatinterval=5,command=function(...)tkxview(.limmaGUIglobals$mainTree,...),orient="horizontal"))
Try(mainTreeYScr <- tkscrollbar(mainFrame, repeatinterval=5,command=function(...)tkyview(.limmaGUIglobals$mainTree,...)))
Try(limmaGUIglobals <- get(".limmaGUIglobals",envir=.GlobalEnv))
Try(limmaGUIglobals$mainTree <- tkwidget(mainFrame,"Tree",xscrollcommand=function(...)tkset(mainTreeXScr,...),yscrollcommand=function(...)tkset(mainTreeYScr,...),width=.limmaGUIglobals$mainTreeWidth,height=.limmaGUIglobals$mainTreeHeight,bg="white"))
Try(LinModTreeXScr <- tkscrollbar(mainFrame, repeatinterval=5,command=function(...)tkxview(.limmaGUIglobals$ParameterizationTREE,...),orient="horizontal"))
Try(LinModTreeYScr <- tkscrollbar(mainFrame, repeatinterval=5,command=function(...)tkyview(.limmaGUIglobals$ParameterizationTREE,...)))
Try(limmaGUIglobals$ParameterizationTREE <- tkwidget(mainFrame,"Tree",xscrollcommand=function(...)tkset(LinModTreeXScr,...),yscrollcommand=function(...)tkset(LinModTreeYScr,...),width=.limmaGUIglobals$ParameterizationTREEWidth,height=.limmaGUIglobals$ParameterizationTREEHeight,bg="white"))
Try(limmaGUIglobals$limmaDataSetNameTextLabel <- tklabel(mainFrame,text=limmaDataSetNameText,font=.limmaGUIglobals$limmaGUIfont2b))
Try(assign(".limmaGUIglobals",limmaGUIglobals,.GlobalEnv))
Try(tkgrid(tklabel(mainFrame,text=" "),.limmaGUIglobals$limmaDataSetNameTextLabel,tklabel(mainFrame,text=" "),tklabel(mainFrame,text="PARAMETERIZATIONS",font=.limmaGUIglobals$limmaGUIfont2b),tklabel(mainFrame,text=" ")))
Try(tkgrid(tklabel(mainFrame,text=" "),.limmaGUIglobals$mainTree,mainTreeYScr,.limmaGUIglobals$ParameterizationTREE,LinModTreeYScr))
Try(tkconfigure(.limmaGUIglobals$limmaDataSetNameTextLabel,textvariable=.limmaGUIglobals$limmaDataSetNameTcl))
Try(tkgrid.configure(.limmaGUIglobals$mainTree,rowspan=6,sticky="ns"))
Try(tkgrid.configure(mainTreeYScr,rowspan=6,sticky="wns"))
Try(tkgrid.configure(.limmaGUIglobals$ParameterizationTREE,rowspan=6,sticky="ns"))
Try(tkgrid.configure(LinModTreeYScr,rowspan=6,sticky="wns"))
Try(tkgrid(tklabel(mainFrame,text=" "),mainTreeXScr,tklabel(mainFrame,text=" "),LinModTreeXScr))
Try(tkgrid.configure(mainTreeXScr,sticky="ewn"))
Try(tkgrid.configure(LinModTreeXScr,sticky="ewn"))
#
Try(tkgrid(tklabel(mainFrame,text=" "),columnspan=5))
#
Try(tkgrid(mainFrame))
#
Try(tkinsert(.limmaGUIglobals$mainTree,"end","root","RG" ,text="R and G",font=.limmaGUIglobals$limmaGUIfontTree))
Try(tkinsert(.limmaGUIglobals$mainTree,"end","RG","RG.Status" ,text="Not Available",font=.limmaGUIglobals$limmaGUIfontTree))
Try(tkinsert(.limmaGUIglobals$mainTree,"end","root","BC" ,text="Background Correction",font=.limmaGUIglobals$limmaGUIfontTree))
Try(tkinsert(.limmaGUIglobals$mainTree,"end","BC","BC.Status" ,text="subtract",font=.limmaGUIglobals$limmaGUIfontTree))
Try(tkinsert(.limmaGUIglobals$mainTree,"end","root","WeightingType" ,text="Spot Quality Weighting",font=.limmaGUIglobals$limmaGUIfontTree))
Try(tkinsert(.limmaGUIglobals$mainTree,"end","WeightingType","WeightingType.Status" ,text="none",font=.limmaGUIglobals$limmaGUIfontTree))
Try(tkinsert(.limmaGUIglobals$mainTree,"end","root","MA" ,text="M and A",font=.limmaGUIglobals$limmaGUIfontTree))
Try(tkinsert(.limmaGUIglobals$mainTree,"end","MA","Raw" ,text="Raw",font=.limmaGUIglobals$limmaGUIfontTree))
Try(tkinsert(.limmaGUIglobals$mainTree,"end","Raw","Raw.Status" ,text="Not Available",font=.limmaGUIglobals$limmaGUIfontTree))
Try(tkinsert(.limmaGUIglobals$mainTree,"end","MA","WithinOnly" ,text="Within-Array Normalized",font=.limmaGUIglobals$limmaGUIfontTree))
Try(tkinsert(.limmaGUIglobals$mainTree,"end","WithinOnly","WithinOnly.Status" ,text="Not Available",font=.limmaGUIglobals$limmaGUIfontTree))
Try(tkinsert(.limmaGUIglobals$mainTree,"end","MA","BetweenOnly" ,text="Between-Array Normalized",font=.limmaGUIglobals$limmaGUIfontTree))
Try(tkinsert(.limmaGUIglobals$mainTree,"end","BetweenOnly","BetweenOnly.Status" ,text="Not Available",font=.limmaGUIglobals$limmaGUIfontTree))
Try(tkinsert(.limmaGUIglobals$mainTree,"end","MA","WithinAndBetween",text="Within and Between-Array Normalized",font=.limmaGUIglobals$limmaGUIfontTree))
Try(tkinsert(.limmaGUIglobals$mainTree,"end","WithinAndBetween","WithinAndBetween.Status" ,text="Not Available",font=.limmaGUIglobals$limmaGUIfontTree))
Try(tkinsert(.limmaGUIglobals$mainTree,"end","root","Layout", text="Layout",font=.limmaGUIglobals$limmaGUIfontTree))
Try(tkinsert(.limmaGUIglobals$mainTree,"end","Layout","Layout.Status" ,text="Not Available",font=.limmaGUIglobals$limmaGUIfontTree))
Try(tkinsert(.limmaGUIglobals$mainTree,"end","root","Parameterizations" ,text="Parameterizations",font=.limmaGUIglobals$limmaGUIfontTree))
Try(tkinsert(.limmaGUIglobals$mainTree,"end","Parameterizations","Parameterizations.Status.1" ,text="None",font=.limmaGUIglobals$limmaGUIfontTree))
#
# Menu code below was taken from Rcmdr (and slightly modified)
#
Try(etc <- system.file("etc",package="limmaGUI"))
Try(cat(paste("\nSearching for user-defined limmaGUI commands in",etc,"...\n")))
Try(source.files <- list.files(etc, pattern="\\.R$"))
Try(
for(file in source.files) {
Try(source(file.path(etc, file)))
Try(cat(paste("Sourced:", file, "\n")))
} #end of for
)#end of Try
Try(topMenu <- tkmenu(.limmaGUIglobals$ttMain))
Try(tkconfigure(.limmaGUIglobals$ttMain,menu=topMenu))
Try(Menus <- read.table(file.path(system.file("etc",package="limmaGUI"),"limmaGUI-menus.txt"), as.is=TRUE))
Try(
for(m in 1:nrow(Menus)){
Try(
if(Menus[m, 1] == "menu") assign(Menus[m, 2], tkmenu(eval(parse(text=Menus[m, 3])), tearoff=FALSE))
else if(Menus[m, 1] == "item"){
if(Menus[m, 3] == "command")
tkadd(eval(parse(text=Menus[m, 2])),"command", label=Menus[m, 4], command=eval(parse(text=Menus[m, 5])))
else if(Menus[m, 3] == "cascade"){
cascadeMenu <- eval(parse(text=Menus[m, 5]))
tkadd(eval(parse(text=Menus[m, 2])),"cascade", label=Menus[m, 4], menu=cascadeMenu)
if(Menus[m, 4]=="File")
{
Try(limmaGUIglobals <- get(".limmaGUIglobals",envir=limmaGUIenvironment))
Try(menuNames <- unique(Menus[,2,drop=TRUE]))
Try(numMenus <- length(menuNames))
Try(menus <- list())
Try(for(j in (1:numMenus))
menus[[j]] <- eval(parse(text=Menus[j,2])))
Try(names(menus) <- menuNames)
Try(limmaGUIglobals$menus <- menus)
Try(assign(".limmaGUIglobals",limmaGUIglobals,.GlobalEnv))
}
}else if(Menus[m, 3] == "separator"){
if(nrow(Menus)>m && Menus[m+1, 4]=="Exit"){
recentFilesFileName <- system.file("etc/recent-files.txt",package="limmaGUI")
recentFiles <- readLines(recentFilesFileName)
recentFiles <- gsub("\\\\","/",recentFiles)
# Remove any blank lines:
blanks <- grep("^[ \t\n]*$",recentFiles)
if(length(blanks)>0)recentFiles <- recentFiles[-blanks]
numRecentFiles <- length(recentFiles)
if(numRecentFiles>0){
tkadd(eval(parse(text=Menus[m, 2])),"separator")
for(i in (1:numRecentFiles)){
label <- recentFiles[i]
fileNameOnly <- strsplit(label,"/")[[1]]
fileNameOnly <- fileNameOnly[length(fileNameOnly)]
if(nchar(recentFiles[i])>60)label <- paste(".../",fileNameOnly)
eval(parse(text=paste("assign(\".OpenALimmaFile_",i,"\",function() OpenALimmaFile(\"",recentFiles[i],"\"),.GlobalEnv)",sep="")))
Try(
if(.Platform$OS.type=="windows"){
tkadd(
eval(parse(text=Menus[m,2])),"command",label=paste(i,". ",fixSeps(label),sep=""),command=eval(parse(text=paste(".OpenALimmaFile_",i,sep="")))
)#end of tkadd
}else{
tkadd(
eval(parse(text=Menus[m,2])),"command",label=paste(i,". ",label,sep=""),command=eval(parse(text=paste(".OpenALimmaFile_",i,sep="")))
)#end of tkadd
} #end of else
)#end of Try
} #end of for(i in (1:numRecentFiles))
} #end of if(numRecentFiles>0)
} #end of if(nrow(Menus)>m && Menus[m+1, 4]=="Exit")
tkadd(eval(parse(text=Menus[m, 2])),"separator")
} #end of else if(Menus[m, 3] == "separator")
else stop(paste("menu defintion error:", Menus[m, ], collapse=" "))
} #end of else if(Menus[m, 1] == "item")
else stop(paste("menu defintion error:", Menus[m, ], collapse=" "))
)#end of if(Menus[m, 1] == "menu") assign(Menus[m, 2], tkmenu(eval(parse(text=Menus[m, 3])), tearoff=FALSE))
} #end of for(m in 1:nrow(Menus))
)#end of Try(for(m in 1:nrow(Menus))
Try(limmaGUIglobals <- get(".limmaGUIglobals",envir=limmaGUIenvironment))
Try(limmaGUIglobals$mainMenu <- topMenu)
Try(assign(".limmaGUIglobals",limmaGUIglobals,.GlobalEnv))
Try(
if(.limmaGUIglobals$limmaGUIpresentation==FALSE){
Try(labelStatusBar <- tklabel(.limmaGUIglobals$ttMain,font=.limmaGUIglobals$limmaGUIfont2))
Try(tkgrid(labelStatusBar,sticky="w"))
Try(CurrentStatus <- tclVar(" "))
Try(tkconfigure(labelStatusBar,textvariable=CurrentStatus))
Try(tkbind(saveButton,"<Enter>",function() tclvalue(CurrentStatus) <- "Save the current Limma file."))
Try(tkbind(saveButton,"<Leave>",function() tclvalue(CurrentStatus) <- " "))
Try(tkbind(openButton,"<Enter>",function() tclvalue(CurrentStatus) <- "Open an existing Limma file."))
Try(tkbind(openButton,"<Leave>",function() tclvalue(CurrentStatus) <- " "))
Try(tkbind(newButton,"<Enter>",function() tclvalue(CurrentStatus) <- "Start a new Limma analysis."))
Try(tkbind(newButton,"<Leave>",function() tclvalue(CurrentStatus) <- " "))
} #end of if(.limmaGUIglobals$limmaGUIpresentation==FALSE)
)#end of Try
#
#Try(tkwm.resizable(.limmaGUIglobals$ttMain,"true","false"))
#
Try(tkbind(.limmaGUIglobals$ttMain, "<Control-N>", NewLimmaFile))
Try(tkbind(.limmaGUIglobals$ttMain, "<Control-S>", SaveLimmaFile))
Try(tkbind(.limmaGUIglobals$ttMain, "<Control-O>", OpenLimmaFile))
Try(tkbind(.limmaGUIglobals$ttMain, "<Control-n>", NewLimmaFile))
Try(tkbind(.limmaGUIglobals$ttMain, "<Control-s>", SaveLimmaFile))
Try(tkbind(.limmaGUIglobals$ttMain, "<Control-o>", OpenLimmaFile))
#
Try(tkfocus(.limmaGUIglobals$ttMain))
#
Try(temp <- options(.limmaGUIglobals$oldOptions))
invisible()
} #end of function(BigfontsForlimmaGUIpresentation=FALSE)
#
#
limmaGUIhelp <- function(){
Try(limmaGUIhelpIndex <- file.path(system.file("doc",package="limmaGUI"),"index.html"))
Try(browseURL(limmaGUIhelpIndex))
Try(cat(paste("Opening limmaGUI help...\nIf nothing happens, please open :\n",limmaGUIhelpIndex,"\nyourself.",sep="")))
} #end of limmaGUIhelp <- function()
#
#
limmaHelp <- function(){
#Try(limmaHelpIndex <- file.path(system.file("doc",package="limma"),"usersguide.html"))
Try(limmaHelpIndex <- file.path(system.file("doc",package="limma"),"index.html"))
Try(browseURL(limmaHelpIndex))
Try(cat(paste("Opening limma help...\nIf nothing happens, please open :\n",limmaHelpIndex,"\nyourself.",sep="")))
} #end of limmaHelp <- function()
#
#
showCitations <- function(){
Try(tkmessageBox(title="Citations",message="See the R console for the Citation listing."))
Try(print(citation("limmaGUI")))
} #end of showCitations <- function()
#
#
showChangeLog <- function(){
n <- 20
Try(tkmessageBox(title="ChangeLog",message=paste("See the R console for the first ",n," lines of the ChangeLog file.\nTo see more lines, use the LGchangeLog(n=nnn) function, where nnn is the number of lines to view.")))
Try(LGchangeLog(n))
} #end of showChangeLog <- function()
#
#
getPackageVersion <- function(pkgName){
DESCRIPTION <- readLines(paste(system.file(package=pkgName),"/DESCRIPTION",sep=""))
lineNum <- grep("Version",DESCRIPTION)
VersionLineWords <- strsplit(DESCRIPTION[lineNum]," ")[[1]]
numWords <- length(VersionLineWords)
VersionLineWords[numWords]
} #end of getPackageVersion <- function(pkgName)
#
#
initGlobals <- function(){
assign("limmaGUIVersion",getPackageVersion("limmaGUI"),limmaGUIenvironment)
assign("limmaVersion",getPackageVersion("limma"),limmaGUIenvironment)
assign("LimmaFileName","Untitled",limmaGUIenvironment)
assign("maLayout",list(),limmaGUIenvironment)
assign("MA" , list(M=matrix(data=0,nrow=1,ncol=1),A=matrix(data=0,nrow=1,ncol=1)),limmaGUIenvironment)
assign("MAraw" , list(),limmaGUIenvironment)
assign("MAwithinArrays" , list(),limmaGUIenvironment)
assign("MAbetweenArrays" , list(),limmaGUIenvironment)
assign("MAboth" , list(),limmaGUIenvironment)
assign("RG" , 0,limmaGUIenvironment)
assign("GALFile" , "",limmaGUIenvironment)
assign("ParameterizationList" , list(),limmaGUIenvironment)
assign("gal" , data.frame(),limmaGUIenvironment)
assign("NumSlides" , 0,limmaGUIenvironment)
assign("NumParameterizations", 0, limmaGUIenvironment)
assign("ParameterizationNamesVec", c(), limmaGUIenvironment)
assign("ParameterizationTreeIndexVec",c(), limmaGUIenvironment)
assign("NumParameters" , 0,limmaGUIenvironment)
assign("SlideNamesVec" , c(),limmaGUIenvironment)
assign("Targets" , data.frame(),limmaGUIenvironment)
assign("SpotTypes" , data.frame(),limmaGUIenvironment)
assign("SpotTypeStatus" , c(),limmaGUIenvironment)
assign("ndups" , 1,limmaGUIenvironment)
assign("spacing" , 1,limmaGUIenvironment)
assign("limmaDataSetNameText" , "Untitled",limmaGUIenvironment)
Try(tclvalue(.limmaGUIglobals$limmaDataSetNameTcl) <- "Untitled")
assign("ArraysLoaded",FALSE,limmaGUIenvironment)
assign("LinearModelComputed",rep(FALSE,100),limmaGUIenvironment) # Maximum of 100 parameterizations for now.
assign("WeightingType","none", limmaGUIenvironment)
assign("AreaLowerLimit",160, limmaGUIenvironment)
assign("AreaUpperLimit",170, limmaGUIenvironment)
# assign("FlagSpotWeighting", 0.1, limmaGUIenvironment)
assign("MA.Available",list(Raw=FALSE,WithinArrays=FALSE,BetweenArrays=FALSE,Both=FALSE),limmaGUIenvironment)
assign("RG.Available",FALSE,limmaGUIenvironment)
assign("Layout.Available",FALSE,limmaGUIenvironment)
assign("numConnectedSubGraphs",1,limmaGUIenvironment)
assign("connectedSubGraphs",list(),limmaGUIenvironment)
assign("NumRNATypes",2,limmaGUIenvironment)
assign("WithinArrayNormalizationMethod","printtiploess",limmaGUIenvironment)
assign("BetweenArrayNormalizationMethod","scale",limmaGUIenvironment)
assign(".JustAskedWhetherToSave",FALSE,.GlobalEnv)
assign("MAimported",new("MAList"),limmaGUIenvironment)
assign("RawMADataWasImported",FALSE,limmaGUIenvironment)
assign("NormalizedMADataWasImported",FALSE,limmaGUIenvironment)
assign("BCMethodDefault","subtract",limmaGUIenvironment)
assign("BCMethod","subtract",limmaGUIenvironment)
assign("NEOffsetDefault",16,limmaGUIenvironment)#.
Try(NEOffsetDefault <<- get("NEOffsetDefault",envir=limmaGUIenvironment))
assign("NEOffset",NEOffsetDefault,limmaGUIenvironment)
assign("ImageAnalysisExtension","spot",limmaGUIenvironment)
} #end of initGlobals <- function()
#
#
fixSeps <- function(string){
Try(if(.Platform$OS.type=="windows")string <- gsub("/","\\\\",string))
return (string)
} #end of fixSeps <- function(string)
#
# I wrote the function deleteItemFromList before I discovered
# that you could simply assign an item to NULL in a list to
# delete it (or use negative-indexing). Because I am only
# dealing with very small lists, it does not matter that
# I am using an inefficient method, and it may actually make
# the code more readable than assigning an element to NULL.
#
deleteItemFromList <- function(list1,itemName=NULL,index=NULL){
if(is.null(index))index <- match(itemName,attributes(list1)$names)
if(is.na(index))return(list1)
len <- length(list1)
newlist <- list()
count <- 0
for(i in (1:len)){
if(i!=index){
count <- count + 1
if(!is.null(attributes(list1)$names[i])){
newlist <- c(newlist,list(foo=list1[[i]]))
attributes(newlist)$names[count] <- attributes(list1)$names[i]
}else{
newlist[[count]] <- list1[[i]]
} #end of if/else (!is.null(attributes(list1)$names[i]))
} #end of if(i!=index)
} #end of for(i in (1:len))
return (newlist)
} #end of deleteItemFromList <- function(list1,itemName=NULL,index=NULL)
#
#
SetLayoutParameters <- function(){
Try(ArraysLoaded <- get("ArraysLoaded", envir=limmaGUIenvironment))
Try(NormalizedMADataWasImported<- get("NormalizedMADataWasImported", envir=limmaGUIenvironment))
if(ArraysLoaded==FALSE && NormalizedMADataWasImported==FALSE){
Try(tkmessageBox(title="Layout Parameters",message="No arrays have been loaded. Please try New or Open from the File menu.",type="ok",icon="error"))
Try(tkfocus(.limmaGUIglobals$ttMain))
return()
} #end of if(ArraysLoaded==FALSE && NormalizedMADataWasImported==FALSE)
#
Try(gal <- get("gal",envir=limmaGUIenvironment))
#
ttLayout<-tktoplevel(.limmaGUIglobals$ttMain)
tkwm.deiconify(ttLayout)
tkgrab.set(ttLayout)
tkfocus(ttLayout)
tkwm.title(ttLayout,"Layout Parameters")
Try(maLayout <- get("maLayout",envir=limmaGUIenvironment))
if(length(maLayout)==0){
Try(nspot.r <- tclVar(init="0"))
Try(nspot.c <- tclVar(init="0"))
Try(ngrid.r <- tclVar(init="0"))
Try(ngrid.c <- tclVar(init="0"))
}else{
Try(nspot.r <- tclVar(init=paste(maLayout$nspot.r)))
Try(nspot.c <- tclVar(init=paste(maLayout$nspot.c)))
Try(ngrid.r <- tclVar(init=paste(maLayout$ngrid.r)))
Try(ngrid.c <- tclVar(init=paste(maLayout$ngrid.c)))
} #end of else/if(length(maLayout)==0)
tkgrid(tklabel(ttLayout,text=" "))
entry.nspot.r <-tkentry(ttLayout,width="12",font=.limmaGUIglobals$limmaGUIfont2,textvariable=nspot.r,bg="white")
entry.nspot.c <-tkentry(ttLayout,width="12",font=.limmaGUIglobals$limmaGUIfont2,textvariable=nspot.c,bg="white")
entry.ngrid.r <-tkentry(ttLayout,width="12",font=.limmaGUIglobals$limmaGUIfont2,textvariable=ngrid.r,bg="white")
entry.ngrid.c <-tkentry(ttLayout,width="12",font=.limmaGUIglobals$limmaGUIfont2,textvariable=ngrid.c,bg="white")
#
GetFromGAL <- function(){
Try(gal <- get("gal",envir=limmaGUIenvironment))
tmpLayout <- getLayout(gal)
tclvalue(nspot.r) <- tmpLayout$nspot.r
tclvalue(nspot.c) <- tmpLayout$nspot.c
tclvalue(ngrid.r) <- tmpLayout$ngrid.r
tclvalue(ngrid.c) <- tmpLayout$ngrid.c
} #end of GetFromGAL <- function()
#
ReturnVal <- 0
#
onOK <- function(){
Try(assign("Layout.Available",TRUE,limmaGUIenvironment))
Try(tkdelete(.limmaGUIglobals$mainTree,"Layout.Status"))
Try(tkinsert(.limmaGUIglobals$mainTree,"end","Layout","Layout.Status",text="Available",font=.limmaGUIglobals$limmaGUIfontTree))
Try(assign("maLayout",list(ngrid.r=as.integer(tclvalue(ngrid.r)), ngrid.c=as.integer(tclvalue(ngrid.c)), nspot.r=as.integer(tclvalue(nspot.r)), nspot.c=as.integer(tclvalue(nspot.c))),limmaGUIenvironment))
Try(tkgrab.release(ttLayout));Try(tkdestroy(ttLayout));Try(tkfocus(.limmaGUIglobals$ttMain)); ReturnVal <<- 1
} #end of onOK <- function()
onCancel <- function() {Try(tkgrab.release(ttLayout));Try(tkdestroy(ttLayout));Try(tkfocus(.limmaGUIglobals$ttMain)); ReturnVal <<- 0}
OK.but <-tkbutton(ttLayout,text=" OK ",command=onOK,font=.limmaGUIglobals$limmaGUIfont2)
guess.but <-tkbutton(ttLayout,text="Determine from GAL file",command=GetFromGAL,font=.limmaGUIglobals$limmaGUIfont2)
Cancel.but <-tkbutton(ttLayout,text=" Cancel ",command=onCancel,font=.limmaGUIglobals$limmaGUIfont2)
#
tkgrid(tklabel(ttLayout,text="Number of rows of blocks",font=.limmaGUIglobals$limmaGUIfont2),entry.ngrid.r,sticky="w")
tkgrid(tklabel(ttLayout,text="Number of columns of blocks",font=.limmaGUIglobals$limmaGUIfont2),entry.ngrid.c,sticky="w")
tkgrid(tklabel(ttLayout,text="Number of rows per block",font=.limmaGUIglobals$limmaGUIfont2),entry.nspot.r,sticky="w")
tkgrid(tklabel(ttLayout,text="Number of columns per block",font=.limmaGUIglobals$limmaGUIfont2),entry.nspot.c,sticky="w")
tkgrid(guess.but)
tkgrid(OK.but,Cancel.but)
tkgrid(tklabel(ttLayout,text=" "))
if(length(maLayout)==0 && length(gal)>0)GetFromGAL()
Try(tkfocus(ttLayout))
#
Try(tkbind(ttLayout, "<Destroy>", function() {Try(tkgrab.release(ttLayout));Try(tkfocus(.limmaGUIglobals$ttMain))}))
Try(tkwait.window(ttLayout))
#
return(ReturnVal)
} #end of SetLayoutParameters <- function()
#
#
OpenGALFile <- function(){
Try(tmpGALFile <- tclvalue(tkgetOpenFile(filetypes="{{GAL Files} {.gal .GAL}} {{All files} *}")))
Try(if(!nchar(tmpGALFile)) return())
Try(assign("GALFile",tmpGALFile,limmaGUIenvironment))
Try(GALFile <- get("GALFile",envir=limmaGUIenvironment))
Try(tclvalue(.limmaGUIglobals$GALfileBoxTitle) <- "GenePix Array List (GAL) File")
Try(tclvalue(.limmaGUIglobals$GALfileNameTcl) <-fixSeps(paste(GALFile)))
Try(tkconfigure(.limmaGUIglobals$ttMain,cursor="watch"))
Try(gal <- readGAL(galfile=GALFile,fill=TRUE))
Try(gal$ID <- as.character(gal$ID))
Try(gal$Name <- as.character(gal$Name))
Try(assign("gal",gal,limmaGUIenvironment))
Try(if(data.class(tmp<-try(getLayout(gal),TRUE))!="try-error")assign("maLayout",tmp,limmaGUIenvironment))
Try(assign("Layout.Available",TRUE,limmaGUIenvironment))
Try(tkdelete(.limmaGUIglobals$mainTree,"Layout.Status"))
Try(tkinsert(.limmaGUIglobals$mainTree,"end","Layout","Layout.Status",text="Available",font=.limmaGUIglobals$limmaGUIfontTree))
Try(tkconfigure(.limmaGUIglobals$ttMain,cursor="arrow"))
Try(ArraysLoaded <- FALSE)
Try(assign("ArraysLoaded",ArraysLoaded,limmaGUIenvironment))
#
tkfocus(.limmaGUIglobals$ttMain)
} #end of OpenGALFile <- function()
#
#
OpenTargetsFile <- function(){
Try(tmpTargetsFile <- tclvalue(tkgetOpenFile(filetypes="{{Targets Files} {.txt}} {{All files} *}")))
Try(if(!nchar(tmpTargetsFile)) return())
Try(TargetsFile <- tmpTargetsFile)
Try(assign("TargetsFile",TargetsFile,limmaGUIenvironment))
Try(tclvalue(.limmaGUIglobals$TargetsfileBoxTitleTcl) <- paste("Targets File"))
Try(tclvalue(.limmaGUIglobals$TargetsfileNameTcl) <- fixSeps(paste(TargetsFile)))
Try(Targets <- read.table(TargetsFile,header=TRUE,sep="\t",quote="\"",as.is=TRUE))
Try(
if(!("FileName" %in% colnames(Targets)) && !("FileNameCy3" %in% colnames(Targets) && "FileNameCy5" %in% colnames(Targets))){
Try(tkmessageBox(title="RNA Targets File Error",message="The RNA Targets file should have a \"FileName\" column (or for ImaGene, a \"FileNameCy3\" column and a \"FileNameCy5\" column).",icon="error"))
Try(tkconfigure(.limmaGUIglobals$ttMain,cursor="arrow"))
return()
} #end of if(!("FileName" %in% colnames(Targets)) && !("FileNameCy3" %in% colnames(Targets) && "FileNameCy5" %in% colnames(Targets)))
)
Try(
if(!("SlideNumber" %in% colnames(Targets)) || !("Cy3" %in% colnames(Targets)) || !("Cy5" %in% colnames(Targets))){
Try(tkmessageBox(title="RNA Targets File Error",message="The RNA Targets file should have a \"SlideNumber\" column, a \"Cy3\" column and a \"Cy5\" column, where the Cy3 and Cy5 columns list the RNA types for the targets (e.g. \"wild type\" or \"mutant\").",icon="error"))
Try(tkconfigure(.limmaGUIglobals$ttMain,cursor="arrow"))
return()
} #end of if(!("SlideNumber" %in% colnames(Targets)) || !("Cy3" %in% colnames(Targets)) || !("Cy5" %in% colnames(Targets)))
)
#
Try(assign("Targets",Targets,limmaGUIenvironment))
Try(assign("NumSlides",nrow(Targets),limmaGUIenvironment))
#
Try(ArraysLoaded <- FALSE)
Try(assign("ArraysLoaded",ArraysLoaded,limmaGUIenvironment))
#
Try(tkfocus(.limmaGUIglobals$ttMain))
} #end of OpenTargetsFile <- function()
#
#
OpenSpotTypesFile <- function(){
Try(tmpSpotTypesFile <- tclvalue(tkgetOpenFile(filetypes="{{Spot-Type Files} {.txt}} {{All files} *}")))
Try(if(!nchar(tmpSpotTypesFile)) return())
Try(SpotTypesFile <- tmpSpotTypesFile)
Try(assign("SpotTypesFile",SpotTypesFile,limmaGUIenvironment))
Try(tclvalue(.limmaGUIglobals$SpotTypesfileBoxTitleTcl) <- paste("Spot-Types File"))
Try(tclvalue(.limmaGUIglobals$SpotTypesfileNameTcl) <- fixSeps(paste(SpotTypesFile)))
Try(SpotTypes <- read.table(SpotTypesFile,header=TRUE,sep="\t",quote="\"",as.is=TRUE,comment.char=""))
Try(
if(!("SpotType" %in% colnames(SpotTypes))||
!("ID" %in% colnames(SpotTypes)) ||
!("Name" %in% colnames(SpotTypes)) ||
!( ("Color" %in% colnames(SpotTypes)) || ("col" %in% colnames(SpotTypes)) )
){
Try(
tkmessageBox(
title="Spot Types",
message=paste("Error: SpotTypes table should contain column headings \"SpotType\",","\"ID\",\"Name\" and (\"Color\" or \"col\")."),
icon="error"
)
)
return()
} #end of if(!("SpotType" %in% colnames(SpotTypes))|| ...)
)
#
Try(
for(i in (1:ncol(SpotTypes))){
if(colnames(SpotTypes)[i]=="col")colnames(SpotTypes)[i] <- "Color"
if(colnames(SpotTypes)[i]=="cex")colnames(SpotTypes)[i] <- "PointSize"
} #end of for(i in (1:ncol(SpotTypes)))
)
#
Try(
if(length(SpotTypes$SpotType)!=length(unique(SpotTypes$SpotType))){
Try(
tkmessageBox(
title="Spot Types",
message=paste(
"Error: Each spot type in the SpotType column should be unique",
"(but one spot type can have multiple spot sub-types, e.g. you could have a spot type \"ratio\" which matches ID's in the GAL file equivalent to \"Ratio_Control_*\", i.e. \"Ratio_Control_1\", \"Ratio_Control_2\", etc.)"
),
icon="error"
)
)
return()
} #end of if(length(SpotTypes$SpotType)!=length(unique(SpotTypes$SpotType)))
)
Try(assign("SpotTypes",SpotTypes,limmaGUIenvironment))
Try(ArraysLoaded <- FALSE)
Try(assign("ArraysLoaded",ArraysLoaded,limmaGUIenvironment))
Try(tkfocus(.limmaGUIglobals$ttMain))
} #end of OpenSpotTypesFile <- function()
#
#
GetImageProcessingFileType <- function(){
ttGetImageProcessingFileType<-tktoplevel(.limmaGUIglobals$ttMain)
tkwm.deiconify(ttGetImageProcessingFileType)
tkgrab.set(ttGetImageProcessingFileType)
Try(tkwm.title(ttGetImageProcessingFileType,"Type of Image Processing Files"))
#
# Don't remove this! We need at least one tclVar initialization, not just tclvalue()'s.
Try(fileTypeTcl <- tclVar("spot"))
#
Try(ImageAnalysisExtension <- get("ImageAnalysisExtension",envir=limmaGUIenvironment))
Try(Targets <- get("Targets",envir=limmaGUIenvironment))
Try(
if("FileNameCy3" %in% colnames(Targets))
Try(tclvalue(fileTypeTcl) <- "imagene")
else if(length(grep("\\.spot$",tolower(Targets$FileName))) > 0)
Try(tclvalue(fileTypeTcl) <- "spot")
else if(length(grep("\\.gpr$",tolower(Targets$FileName))) > 0)
Try(tclvalue(fileTypeTcl) <- "genepix")
else if(length(grep("\\.",Targets$FileName))==0 || length(grep("\\.csv$",tolower(Targets$FileName))) > 0)
Try(tclvalue(fileTypeTcl) <- "arrayvision")
else if(length(grep("\\.xls$",tolower(Targets$FileName))) > 0)
Try(tclvalue(fileTypeTcl) <- "smd")
else
Try(tclvalue(fileTypeTcl) <- "quantarray")
)
#
Try(tkframe1 <- tkframe(ttGetImageProcessingFileType,borderwidth=2))
Try(tkframe2 <- tkframe(tkframe1,relief="groove",borderwidth=2))
Try(tkframe4<-tkframe(tkframe1,borderwidth=2))
#
Try(tkgrid(tklabel(tkframe1,text=" ")))
#
Try(tkgrid( tklabel(tkframe2,text="Which type of image-processing files are these?", font=.limmaGUIglobals$limmaGUIfont2),rowspan=1,columnspan=2,sticky="w"))
Try(Spot.but <- tkradiobutton(tkframe2,text="Spot", variable=fileTypeTcl,value="spot", font=.limmaGUIglobals$limmaGUIfont2))
Try(Spot.close.open.but <- tkradiobutton(tkframe2,text="Spot close/open", variable=fileTypeTcl,value="spot.close.open", font=.limmaGUIglobals$limmaGUIfont2))
Try(GenePix.but <- tkradiobutton(tkframe2,text="GenePix", variable=fileTypeTcl,value="genepix", font=.limmaGUIglobals$limmaGUIfont2))
Try(QuantArray.but <- tkradiobutton(tkframe2,text="QuantArray", variable=fileTypeTcl,value="quantarray", font=.limmaGUIglobals$limmaGUIfont2))
Try(ImaGene.but <- tkradiobutton(tkframe2,text="ImaGene", variable=fileTypeTcl,value="imagene", font=.limmaGUIglobals$limmaGUIfont2))
Try(ArrayVision.but <- tkradiobutton(tkframe2,text="ArrayVision", variable=fileTypeTcl,value="arrayvision", font=.limmaGUIglobals$limmaGUIfont2))
Try(Agilent.but <- tkradiobutton(tkframe2,text="Agilent", variable=fileTypeTcl,value="agilent", font=.limmaGUIglobals$limmaGUIfont2))
Try(SMD.but <- tkradiobutton(tkframe2,text="SMD (Stanford Microarray DB)",variable=fileTypeTcl,value="smd", font=.limmaGUIglobals$limmaGUIfont2))
#
Try(ReturnVal <- "")
Try(columnHeadings <- list())
Try(
onOther <- function(){
Try(columnHeadings <- GetImageAnalysisColumnHeadings())
Try(
if(length(columnHeadings)>0){
limmaGUIglobals <- .limmaGUIglobals
limmaGUIglobals$columnHeadings <- columnHeadings
assign(".limmaGUIglobals",limmaGUIglobals,.GlobalEnv)
} #end of if(length(columnHeadings)>0)
)
Try(tkgrab.release(ttGetImageProcessingFileType));Try(tkdestroy(ttGetImageProcessingFileType));Try(tkfocus(.limmaGUIglobals$ttMain))
Try(ReturnVal <<- "other")
} # end of onOther <- function()
)
Try(other.but <- tkbutton(tkframe2,text="Other...",command=onOther,font=.limmaGUIglobals$limmaGUIfont2))
#
Try(tkgrid(Spot.but, columnspan=2))
Try(tkgrid(Spot.close.open.but, columnspan=2))
Try(tkgrid(GenePix.but, columnspan=2))
Try(tkgrid(QuantArray.but, columnspan=2))
Try(tkgrid(ImaGene.but, columnspan=2))
Try(tkgrid(ArrayVision.but, columnspan=2))
Try(tkgrid(Agilent.but, columnspan=2))
Try(tkgrid(SMD.but, columnspan=2))
Try(tkgrid(tklabel(tkframe2,text=" ")))
Try(tkgrid(tklabel(tkframe2,text=" "),other.but))
Try(tkgrid.configure(other.but,sticky="w"))
Try(tkgrid(tklabel(tkframe2,text=" ")))
#
Try(tkgrid.configure(Spot.but,Spot.close.open.but,GenePix.but,QuantArray.but,ImaGene.but,ArrayVision.but,Agilent.but,SMD.but,sticky="w"))
Try(tkgrid(tkframe2))
onOK <- function(){
Try(fileTypeVal <- as.character(tclvalue(fileTypeTcl)))
Try(tkgrab.release(ttGetImageProcessingFileType));Try(tkdestroy(ttGetImageProcessingFileType));Try(tkfocus(.limmaGUIglobals$ttMain))
Try(ReturnVal <<- fileTypeVal)
} #end of onOK <- function()
onCancel <- function(){tkgrab.release(ttGetImageProcessingFileType);tkdestroy(ttGetImageProcessingFileType);tkfocus(.limmaGUIglobals$ttMain);ReturnVal <<- ""}
Try(OK.but <-tkbutton(tkframe4,text=" OK ",command=onOK,font=.limmaGUIglobals$limmaGUIfont2))
Try(Cancel.but <-tkbutton(tkframe4,text=" Cancel ",command=onCancel,font=.limmaGUIglobals$limmaGUIfont2))
Try(tkgrid(tklabel(tkframe4,text=" ")))
Try(tkgrid(OK.but,Cancel.but))
Try(tkgrid.configure(OK.but,sticky="e"))
Try(tkgrid.configure(Cancel.but,sticky="e"))
Try(tkgrid(tklabel(tkframe4,text=" ")))
Try(tkgrid(tkframe4))
Try(tkgrid(tkframe1))
Try(tkfocus(ttGetImageProcessingFileType))
Try(tkbind(ttGetImageProcessingFileType, "<Destroy>", function(){tkgrab.release(ttGetImageProcessingFileType);tkfocus(.limmaGUIglobals$ttMain);} ))
Try(tkwait.window(ttGetImageProcessingFileType))
return (ReturnVal)
} #end of GetImageProcessingFileType <- function()
#
#
ReadImageProcessingFiles <- function(){
Try(imageFileType <- GetImageProcessingFileType())
Try(if(nchar(imageFileType)==0) return(0))
#
Try(WeightingType <- get("WeightingType",envir=limmaGUIenvironment))
Try(AreaLowerLimit <- get("AreaLowerLimit",envir=limmaGUIenvironment))
Try(AreaUpperLimit <- get("AreaUpperLimit",envir=limmaGUIenvironment))
#
Try(
if(imageFileType=="spot"){
Try(WhetherToUseBackgroundCorrection <- tclvalue(tkmessageBox(title="Background Correction",message="Use Background Correction (highly recommended) ?",type="yesnocancel",icon="question",default="yes")))
}else{
Try(WhetherToUseBackgroundCorrection <- tclvalue(tkmessageBox(title="Background Correction",message="Use Background Correction?",type="yesnocancel",icon="question",default="yes")))
}
)
Try(
if(WhetherToUseBackgroundCorrection=="cancel")return(0)
)
Try(
if(WhetherToUseBackgroundCorrection=="yes"){
Try(GetBCReturnVal <- GetBackgroundCorrectionMethod())
Try(
if(GetBCReturnVal==""){#This happens if user presses Cancel button or close dialog cross on selecting BCMethod
return(0)
}else{
BCMethod <- GetBCReturnVal
Try(assign("BCMethod",BCMethod,limmaGUIenvironment))
}
)
}else{#user has selected No for doing a background correction
Try(BCMethod <- "none")
Try(assign("BCMethod",BCMethod,limmaGUIenvironment))
}
)
Try(WhetherToUseSpotQualityWeighting <- tkmessageBox(title="Spot Quality Weighting",message="Use Spot Quality Weighting?",type="yesnocancel",icon="question",default="no"))
Try(WhetherToUseSpotQualityWeighting <- tclvalue(WhetherToUseSpotQualityWeighting))
Try(
if(WhetherToUseSpotQualityWeighting=="cancel")return(0)
)
Try(
if(WhetherToUseSpotQualityWeighting=="yes" && imageFileType!="spot" && imageFileType!="spot.close.open" && imageFileType!="genepix" && imageFileType!="quantarray"){
Try(tkmessageBox(title="Spot Quality Weighting",message="Currently, spot quality weighting is only available for Spot, GenePix and QuantArray files. Arrays will be processed without spot quality weighting.",icon="warning",type="ok"))
Try(WhetherToUseSpotQualityWeighting <- "no")
}
)
#
Try(tkconfigure(.limmaGUIglobals$ttMain,cursor="watch"))
Try(tkfocus(.limmaGUIglobals$ttMain))
#
Try(WeightingType <- "none")
Try(assign("WeightingType",WeightingType,limmaGUIenvironment))
Try(
if(WhetherToUseSpotQualityWeighting=="yes"){
if(imageFileType=="spot" || imageFileType=="spot.close.open"){
if(GetWtAreaParams()==0){
Try(tkconfigure(.limmaGUIglobals$ttMain,cursor="arrow"))
return(0)
} #end of if(GetWtAreaParams()==0)
Try(AreaLowerLimit <- get("AreaLowerLimit",envir=limmaGUIenvironment))
Try(AreaUpperLimit <- get("AreaUpperLimit",envir=limmaGUIenvironment))
} #end of if(imageFileType=="spot" || imageFileType=="spot.close.open")
if(imageFileType=="genepix"){
Try(GenePixFlagWeightings <- GetGenePixFlagWeightings())
Try(tkconfigure(.limmaGUIglobals$ttMain,cursor="watch"))
if(length(GenePixFlagWeightings)==0){
Try(tkconfigure(.limmaGUIglobals$ttMain,cursor="arrow"))
return(0)
} #end of if(length(GenePixFlagWeightings)==0)
#Try(FlagSpotWeighting <- get("FlagSpotWeighting",envir=limmaGUIenvironment))
Try(assign("WeightingType","wtflagsVec",limmaGUIenvironment))
} #end of if(imageFileType=="genepix")
if(imageFileType=="quantarray")Try(assign("WeightingType","wtIgnore.Filter",limmaGUIenvironment))
if(imageFileType=="imagene") Try(assign("WeightingType","none",limmaGUIenvironment))
Try(WeightingType <- get("WeightingType",envir=limmaGUIenvironment))
} #end of if(WhetherToUseSpotQualityWeighting=="yes")
)#end of Try
Try(TargetsFile <- get("TargetsFile",envir=limmaGUIenvironment))
Try(
if(!nchar(TargetsFile)){
tkmb <- tkmessageBox(title="ERROR",message="Please select a Targets file first, e.g. SwirlSample.txt",icon="warning",type="ok",default="ok")
Try(tkconfigure(.limmaGUIglobals$ttMain,cursor="arrow"))
return(0)
}
)#end of Try
Try(Targets <- read.table(TargetsFile,header=TRUE,sep="\t",quote="\"",as.is=TRUE))
Try(assign("Targets",Targets,limmaGUIenvironment))
Try(
if(!("FileName" %in% colnames(Targets)) && !("FileNameCy3" %in% colnames(Targets) && "FileNameCy5" %in% colnames(Targets))){
Try(tkmessageBox(title="RNA Targets File Error",message="The RNA Targets file should have a \"FileName\" column (or for ImaGene, a \"FileNameCy3\" column and a \"FileNameCy5\" column)."))
Try(tkconfigure(.limmaGUIglobals$ttMain,cursor="arrow"))
return(0)
}
)#end of Try
Try(
if(!("FileName" %in% colnames(Targets)) && imageFileType!="imagene"){
Try(tkmessageBox(title="RNA Targets File Error",message="The RNA Targets file should have a \"FileName\" column."))
Try(tkconfigure(.limmaGUIglobals$ttMain,cursor="arrow"))
return(0)
}
)#end of Try
Try(
if(imageFileType=="imagene" && !("FileNameCy3" %in% colnames(Targets) && "FileNameCy5" %in% colnames(Targets))){
Try(tkmessageBox(title="RNA Targets File Error",message="When using ImaGene, the RNA Targets file should have a \"FileNameCy3\" column and a \"FileNameCy5\" column."))
Try(tkconfigure(.limmaGUIglobals$ttMain,cursor="arrow"))
return(0)
}
)#end of Try
Try(
if("FileName" %in% colnames(Targets))Try(slides <- Targets$FileName)
)
Try(
if("FileNameCy3" %in% colnames(Targets) && "FileNameCy5" %in% colnames(Targets)){
Try(slides <- cbind(as.matrix(Targets[,"FileNameCy3"]),as.matrix(Targets[,"FileNameCy5"])))
}
)#end of Try
Try(SlideNamesVec <- c())
Try(assign("NumSlides",nrow(Targets),limmaGUIenvironment))
Try(NumSlides <- get("NumSlides",envir=limmaGUIenvironment))
Try(
for(j in (1:NumSlides)){
if("Name" %in% colnames(Targets)){
SlideNamesVec[j] <- Targets[j,"Name"]
}else{
SlideNamesVec[j] <- paste(Targets[j,"SlideNumber"])
}
} #end of for(j in (1:NumSlides))
)#end of Try
Try(assign("SlideNamesVec",SlideNamesVec,limmaGUIenvironment))
#
Try(filesExist <- file.exists(slides))
Try(filesWhichDontExist <- slides[!filesExist])
Try(
if(length(filesWhichDontExist)>0){
Try(
for(i in (1:length(filesWhichDontExist))){
Try(tkmessageBox(title="Error opening file",message=paste("Failed to open file: \"",filesWhichDontExist[i],"\"",sep=""),icon="error"))
} #end of for
)
} #end of if(length(filesWhichDontExist)>0)
)
Try(
if(length(filesWhichDontExist)>0){
Try(tkconfigure(.limmaGUIglobals$ttMain,cursor="arrow"))
return(0)
} #end of if(length(filesWhichDontExist)>0)
)#end of Try
#
Try(
if(WhetherToUseSpotQualityWeighting=="yes"){
if(imageFileType=="spot")
TryReadImgProcFile(RG<-read.maimages(slides,wt.fun=wtarea(ideal=c(AreaLowerLimit,AreaUpperLimit)),source="spot"))
if(imageFileType=="spot.close.open")
TryReadImgProcFile(RG<-read.maimages(slides,wt.fun=wtarea(ideal=c(AreaLowerLimit,AreaUpperLimit)),source="spot.close.open"))
if(imageFileType=="genepix")
TryReadImgProcFile(RG<-read.maimages(slides,wt.fun=wtflags2(GenePixFlagWeightings),source="genepix"))
if(imageFileType=="quantarray"){
TryReadImgProcFile(RG<-read.maimages(slides,wt.fun=wtIgnore.Filter,source="quantarray"))
}
}else{
if(imageFileType!="other"){
TryReadImgProcFile(RG<-read.maimages(slides,source=imageFileType))
}else{
TryReadImgProcFile(RG<-read.maimages(slides,columns=.limmaGUIglobals$columnHeadings))
}
} #end of else/if(WhetherToUseSpotQualityWeighting=="yes")
)#end of Try
#
#get/set BCMethodDefault value
Try(
if(!exists("BCMethodDefault",envir=limmaGUIenvironment)){
Try(BCMethodDefault <- "subtract")
Try(assign("BCMethodDefault",BCMethodDefault,limmaGUIenvironment))
} #end of if(!exists("BCMethodDefault",envir=limmaGUIenvironment))
)
Try(BCMethodDefault <- get("BCMethodDefault",envir=limmaGUIenvironment))
#set BCMethod to default if not set previously
Try(
if(!exists("BCMethod",envir=limmaGUIenvironment)){
Try(BCMethod <- BCMethodDefault)
Try(assign("BCMethod",BCMethod,limmaGUIenvironment))
} #end of if(!exists("BCMethod",envir=limmaGUIenvironment))
)
Try(BCMethod <- get("BCMethod",envir=limmaGUIenvironment))
#
#set NEOffset=NEOffsetDefault in the environment limmaGUIenvironment if it doesn't already exist there
#First get NEOffsetDefault
#Try(#KS:Not sure why I do this - just following previous practice. Seems to me it must exist as I assigned it in initGlobals above
# if(!exists("NEOffsetDefault",envir=limmaGUIenvironment) ){
# Try(NEOffsetDefault <- 16)#KS:I dont like the specific value being repeated here
# Try(assign("NEOffsetDefault",NEOffsetDefault,limmaGUIenvironment))
# }
#)
#Try(NEOffsetDefault <- get("NEOffsetDefault",envir=limmaGUIenvironment))
Try(
if(!exists("NEOffsetDefault",envir=limmaGUIenvironment)){
Try(NEOffsetDefault <- 16)
Try(assign("NEOffsetDefault",NEOffsetDefault,limmaGUIenvironment))
}
)
Try(NEOffsetDefault <- get("NEOffsetDefault",envir=limmaGUIenvironment))
#Now get NEOffset
Try(#KS:Likewise, I thought NEOffset must have a value in limmaGUIenvironment from initGlobals assignment above
if(!exists("NEOffset",envir=limmaGUIenvironment) ){
Try(NEOffset <- NEOffsetDefault)#set to this value if it is not set previously
Try(assign("NEOffset",NEOffset,limmaGUIenvironment))
}
)
Try(NEOffset <- get("NEOffset",envir=limmaGUIenvironment))
###DEBUGNow show new normexp offset value
###Try(NEOffsetTcl <- tclVar(NEOffset))
###TempVal <- tkmessageBox(title="Info",message=paste("NEOffset at line 1077 = ",tclvalue(NEOffsetTcl)),icon="info",type="ok")
###Try(tkfocus(.limmaGUIglobals$ttMain))
#
Try(
if(WhetherToUseBackgroundCorrection=="no"){
#Note that calling backgroundCorrect with method = none removes background values.
Try(RG <- backgroundCorrect(RG,method="none"))
}else{#we wish to use Background correction
Try(
if(BCMethod != "normexp")Try(RG <- backgroundCorrect(RG,method=BCMethod))
)
Try(
if(BCMethod == "normexp")Try(RG <- backgroundCorrect(RG,method=BCMethod,offset=NEOffset))
)
} #end of else/if(WhetherToUseBackgroundCorrection=="no")
)
Try(assign("RG",RG,limmaGUIenvironment))
Try(assign("RG.Available",TRUE,limmaGUIenvironment) )
Try(assign("MAimported",FALSE,limmaGUIenvironment))
Try(tkdelete(.limmaGUIglobals$mainTree,"RG.Status"))
Try(tkinsert(.limmaGUIglobals$mainTree,"end","RG","RG.Status",text="Available",font=.limmaGUIglobals$limmaGUIfontTree))
Try(tkdelete(.limmaGUIglobals$mainTree,"BC.Status"))
if(BCMethod != "normexp"){
Try(tkinsert(.limmaGUIglobals$mainTree,"end","BC","BC.Status" ,text=BCMethod,font=.limmaGUIglobals$limmaGUIfontTree))
}
if(BCMethod == "normexp"){
Try(tkinsert(.limmaGUIglobals$mainTree,"end","BC","BC.Status" ,text=paste("normexp:offset = ",NEOffset,sep=""),font=.limmaGUIglobals$limmaGUIfontTree))
}
Try(tkdelete(.limmaGUIglobals$mainTree,"WeightingType.Status"))
Try(tkinsert(.limmaGUIglobals$mainTree,"end","WeightingType","WeightingType.Status" ,text=WeightingType,font=.limmaGUIglobals$limmaGUIfontTree))
#
# Let's automatically computed MAraw:
#
Try(RG <- get("RG",envir=limmaGUIenvironment))
###
### Try(tkmessageBox(title="ReadImageProcessingFiles:1165",message=paste("RGb =",summary(RG$Rb)),type="ok",icon="error"))
### Try(tkfocus(.limmaGUIglobals$ttMain))
###
Try(MA.Available <- get("MA.Available",envir=limmaGUIenvironment))
Try (MAraw <- MA.RG(RG))
Try(assign("MAraw",MAraw,limmaGUIenvironment))
Try(assign("MA", MAraw,limmaGUIenvironment))
Try(MA.Available$Raw <- TRUE)
Try(assign("MA.Available",MA.Available,limmaGUIenvironment))
Try(tkdelete(.limmaGUIglobals$mainTree,"Raw.Status"))
Try(tkinsert(.limmaGUIglobals$mainTree,"end","Raw","Raw.Status" ,text="Available",font=.limmaGUIglobals$limmaGUIfontTree))
#
Try(tkconfigure(.limmaGUIglobals$ttMain,cursor="arrow"))
#
Try(ArraysLoaded <- TRUE)
Try(assign("ArraysLoaded",ArraysLoaded,limmaGUIenvironment))
return (1)
} #end of ReadImageProcessingFiles <- function()
#
#
GetGenePixFlagWeightings <- function(){
Try(ttGenePixFlagWeightings <- tktoplevel(.limmaGUIglobals$ttMain))
Try(tkwm.deiconify(ttGenePixFlagWeightings))
Try(tkgrab.set(ttGenePixFlagWeightings))
Try(tkfocus(ttGenePixFlagWeightings))
Try(tkwm.title(ttGenePixFlagWeightings,"GenePix Flag Weightings"))
Try(tkgrid(tklabel(ttGenePixFlagWeightings,text=" ")))
Try(tkgrid(tklabel(ttGenePixFlagWeightings,text="GenePix Flag Weightings",font=.limmaGUIglobals$limmaGUIfont2)))
Try(tkgrid(tklabel(ttGenePixFlagWeightings,text=" ")))
Try(GoodFlagWeightingTcl <- tclVar("1"))
Try(entry.GoodFlagWeighting<-tkentry(ttGenePixFlagWeightings,width="20",font=.limmaGUIglobals$limmaGUIfont2,textvariable=GoodFlagWeightingTcl,bg="white"))
Try(tkgrid(tklabel(ttGenePixFlagWeightings,text="Good (100) ",font=.limmaGUIglobals$limmaGUIfont2),entry.GoodFlagWeighting,sticky="w"))
Try(BadFlagWeightingTcl <- tclVar("0.1"))
Try(entry.BadFlagWeighting<-tkentry(ttGenePixFlagWeightings,width="20",font=.limmaGUIglobals$limmaGUIfont2,textvariable=BadFlagWeightingTcl,bg="white"))
Try(tkgrid(tklabel(ttGenePixFlagWeightings,text="Bad (-100) ",font=.limmaGUIglobals$limmaGUIfont2),entry.BadFlagWeighting,sticky="w"))
Try(NotFoundFlagWeightingTcl <- tclVar("0.1"))
Try(entry.NotFoundFlagWeighting<-tkentry(ttGenePixFlagWeightings,width="20",font=.limmaGUIglobals$limmaGUIfont2,textvariable=NotFoundFlagWeightingTcl,bg="white"))
Try(tkgrid(tklabel(ttGenePixFlagWeightings,text="Not Found (-50) ",font=.limmaGUIglobals$limmaGUIfont2),entry.NotFoundFlagWeighting,sticky="w"))
Try(AbsentFlagWeightingTcl <- tclVar("0.1"))
Try(entry.AbsentFlagWeighting<-tkentry(ttGenePixFlagWeightings,width="20",font=.limmaGUIglobals$limmaGUIfont2,textvariable=AbsentFlagWeightingTcl,bg="white"))
Try(tkgrid(tklabel(ttGenePixFlagWeightings,text="Absent (-75) ",font=.limmaGUIglobals$limmaGUIfont2),entry.AbsentFlagWeighting,sticky="w"))
Try(UnflaggedFlagWeightingTcl <- tclVar("1"))
Try(entry.UnflaggedFlagWeighting<-tkentry(ttGenePixFlagWeightings,width="20",font=.limmaGUIglobals$limmaGUIfont2,textvariable=UnflaggedFlagWeightingTcl,bg="white"))
Try(tkgrid(tklabel(ttGenePixFlagWeightings,text="Unflagged (0) ",font=.limmaGUIglobals$limmaGUIfont2),entry.UnflaggedFlagWeighting,sticky="w"))
#
ReturnVal <- list()
#
onOK <- function(){
Try(Good <- as.numeric(tclvalue(GoodFlagWeightingTcl)))
Try(Bad <- as.numeric(tclvalue(BadFlagWeightingTcl)))
Try(NotFound <- as.numeric(tclvalue(NotFoundFlagWeightingTcl)))
Try(Absent <- as.numeric(tclvalue(AbsentFlagWeightingTcl)))
Try(Unflagged<- as.numeric(tclvalue(UnflaggedFlagWeightingTcl)))
Try(tkgrab.release(ttGenePixFlagWeightings))
Try(tkdestroy(ttGenePixFlagWeightings))
Try(tkfocus(.limmaGUIglobals$ttMain))
Try(ReturnVal <<- list(Good=Good,Bad=Bad,NotFound=NotFound,Absent=Absent,Unflagged=Unflagged))
} #end of onOK <- function()
#
onCancel <- function() {Try(tkgrab.release(ttGenePixFlagWeightings));Try(tkdestroy(ttGenePixFlagWeightings));Try(tkfocus(.limmaGUIglobals$ttMain));Try(ReturnVal <<- list())}
OK.but <- tkbutton(ttGenePixFlagWeightings,text=" OK ",command=onOK,font=.limmaGUIglobals$limmaGUIfont2)
Cancel.but <- tkbutton(ttGenePixFlagWeightings,text=" Cancel ",command=onCancel,font=.limmaGUIglobals$limmaGUIfont2)
Try(tkgrid(tklabel(ttGenePixFlagWeightings,text=" ")))
Try(tkgrid(OK.but,Cancel.but))
Try(tkgrid(tklabel(ttGenePixFlagWeightings,text=" ")))
Try(tkfocus(ttGenePixFlagWeightings))
Try(tkbind(ttGenePixFlagWeightings, "<Destroy>", function() {Try(tkgrab.release(ttGenePixFlagWeightings));Try(tkfocus(.limmaGUIglobals$ttMain));}))
Try(tkwait.window(ttGenePixFlagWeightings))
#
return (ReturnVal)
} #end of GetGenePixFlagWeightings <- function()
#
#
wtflags2 <- function(Weightings)
function(gpr){
w <- rep(1,nrow(gpr))
w[gpr[,"Flags"]==100] <- Weightings$Good
w[gpr[,"Flags"]==-100] <- Weightings$Bad
w[gpr[,"Flags"]==-50] <- Weightings$NotFound
w[gpr[,"Flags"]==-75] <- Weightings$Absent
w[gpr[,"Flags"]==0] <- Weightings$Unflagged
w
} #end of function(gpr)
#
#
tclArrayVar <- function(){
###Try(n <- evalq(TclVarCount <- TclVarCount + 1, .TkRoot$env))
Try(n <- .TkRoot$env$TclVarCount <- .TkRoot$env$TclVarCount +1L)
Try(name <- paste("::RTcl", n,sep = ""))
Try(l <- list(env = new.env()))
Try(assign(name, NULL, envir = l$env))
Try(reg.finalizer(l$env, function(env) tcl("unset", ls(env))))
Try(class(l) <- "tclArrayVar")
Try(.Tcl(paste("set ",name,"(0,0) \"\"",sep="")))
l
} #end of tclArrayVar <- function()
#
#
GetDesignOrContrasts <- function(Design=FALSE,Contrasts=FALSE,NumContrasts=0,parameterizationIndex=0){
# parameterizationIndex argument is for contrasts only
Try(
if((Design==TRUE && Contrasts==TRUE) || (Design==FALSE && Contrasts==FALSE)){
tkmessageBox(title="GetDesignOrContrasts",message="Error: Only one of DesignOrContrasts and Contrasts should be set to TRUE",icon="error")
}
)
Try(NumSlides <- get("NumSlides", envir=limmaGUIenvironment))
Try(NumParameters <- get("NumParameters",envir=limmaGUIenvironment))
Try(SlideNamesVec <- get("SlideNamesVec",envir=limmaGUIenvironment))
Try(Targets <- get("Targets", envir=limmaGUIenvironment))
Try(ArraysLoaded <- get("ArraysLoaded", envir=limmaGUIenvironment))
Try(RawMADataWasImported<- get("RawMADataWasImported", envir=limmaGUIenvironment))
Try(NormalizedMADataWasImported<- get("NormalizedMADataWasImported", envir=limmaGUIenvironment))
#
Try(
if(Design==TRUE)
Try(ReturnVal <- list(design=data.frame(),designCreatedFromDropDowns=FALSE))
else
Try(ReturnVal <- list(contrasts=data.frame(),contrastsCreatedFromDropDowns=FALSE))
)
#
Try(
if(Contrasts==TRUE)
ParameterizationTreeIndexVec <- get("ParameterizationTreeIndexVec",envir=limmaGUIenvironment)
)
#
if(ArraysLoaded==FALSE && NormalizedMADataWasImported==FALSE){
if(Design==TRUE)
tkmessageBox(title="Design Matrix",message="No arrays have been loaded. Please try New or Open from the File menu.",type="ok",icon="error")
else
tkmessageBox(title="Contrasts Matrix",message="No arrays have been loaded. Please try New or Open from the File menu.",type="ok",icon="error")
Try(tkfocus(.limmaGUIglobals$ttMain))
return(ReturnVal)
} #end of if(ArraysLoaded==FALSE && NormalizedMADataWasImported==FALSE)
#
GetDesignOrContrastsTable <- function(designOrContrastsFromDropDowns){
Try(ttDesignOrContrastsTable <- tktoplevel(.limmaGUIglobals$ttMain))
Try(tkwm.deiconify(ttDesignOrContrastsTable))
Try(tkgrab.set(ttDesignOrContrastsTable))
Try(tkfocus(ttDesignOrContrastsTable))
if(Design==TRUE){
Try(tkwm.title(ttDesignOrContrastsTable,"Design Matrix"))
}else{
Try(tkwm.title(ttDesignOrContrastsTable,"Contrasts Matrix"))
}
if(Design==TRUE){
Try(ReturnVal <- list(design=data.frame(),designCreatedFromDropDowns=FALSE))
Try(designOrContrasts <- designOrContrastsFromDropDowns$design)
}else{
Try(ReturnVal <- list(contrasts=data.frame(),contrastsCreatedFromDropDowns=FALSE))
Try(designOrContrasts <- designOrContrastsFromDropDowns$contrasts)
}
#
# Try(n <- evalq(TclVarCount <- TclVarCount + 1, .TkRoot$env))
# Try(tclArrayName <- paste("::RTcl", n, sep = ""))
Try(tclArrayVar1 <- tclArrayVar())
Try(tclArrayName <- ls(tclArrayVar1$env)) # This wouldn't work if I'd used tclArray(). Should update this stuff!
#
onOK <- function(){
Try(.Tcl(paste("event","generate",.Tcl.args(.Tk.ID(table1),"<Leave>"))))
if(Design==TRUE){
NumRows <- NumSlides
NumCols <- NumParameters
}else{
NumRows <- NumParameters
NumCols <- NumContrasts
}
#
Try(designOrContrasts <- as.data.frame(matrix(nrow=NumRows,ncol=NumCols)))
Try(rownamesDesignOrContrasts <- c())
for(i in (1:NumRows)){
Try(rownamesDesignOrContrasts[i] <- tclvalue(paste(tclArrayName,"(",i,",0)",sep="")))
}
#
Try(colnamesDesignOrContrasts <- c())
if(NumCols>0){
for(j in (1:NumCols)){
Try(colnamesDesignOrContrasts[j] <- tclvalue(paste(tclArrayName,"(0,",j,")",sep="")))
}
}
#
Try(rownames(designOrContrasts) <- rownamesDesignOrContrasts)
Try(colnames(designOrContrasts) <- colnamesDesignOrContrasts)
if(Design==TRUE){
Try(assign("SlideNamesVec",rownamesDesignOrContrasts,limmaGUIenvironment))
Try(SlideNamesVec <- get("SlideNamesVec",envir=limmaGUIenvironment))
}
#
if(NumCols>0){
for(i in (1:NumRows)){
for(j in (1:NumCols)){
Try(designOrContrasts[i,j] <- as.numeric(tclvalue(paste(tclArrayName,"(",i,",",j,")",sep=""))))
} #end of for(j in (1:NumCols))
} #end of for(i in (1:NumRows))
} #end of if(NumCols>0)
#
Try(tkgrab.release(ttDesignOrContrastsTable))
Try(tkdestroy(ttDesignOrContrastsTable))
Try(tkfocus(.limmaGUIglobals$ttMain))
if(Design==TRUE){
Try(ReturnVal <<- list(design=designOrContrasts,designCreatedFromDropDowns=FALSE))
}else{
Try(ReturnVal <<- list(contrasts=designOrContrasts,contrastsCreatedFromDropDowns=FALSE))
}
} #end of onOK <- function()
#
onCancel <- function(){
Try(tkgrab.release(ttDesignOrContrastsTable))
Try(tkdestroy(ttDesignOrContrastsTable))
Try(tkfocus(.limmaGUIglobals$ttMain))
if(Design==TRUE){
ReturnVal <<- list(design=data.frame(),designCreatedFromDropDowns=FALSE)
}else{
ReturnVal <<- list(contrasts=data.frame(),contrastsCreatedFromDropDowns=FALSE)
}
} #end of onCancel <- function()
#
Try(OK.but <-tkbutton(ttDesignOrContrastsTable,text=" OK ",command=onOK,font=.limmaGUIglobals$limmaGUIfont2))
Try(Cancel.but <-tkbutton(ttDesignOrContrastsTable,text=" Cancel ",command=onCancel,font=.limmaGUIglobals$limmaGUIfont2))
Try(tkgrid(tklabel(ttDesignOrContrastsTable,text=" ")))
if(Design==TRUE){
Try(PleaseEnterDesignOrContrastsLabel<-tklabel(ttDesignOrContrastsTable,text="Please enter the design matrix to be used for linear-modelling.",font=.limmaGUIglobals$limmaGUIfont2))
}else{
Try(PleaseEnterDesignOrContrastsLabel<-tklabel(ttDesignOrContrastsTable,text="Please enter the contrasts matrix to be used for linear-modelling.",font=.limmaGUIglobals$limmaGUIfont2))
}
Try(tkgrid(tklabel(ttDesignOrContrastsTable,text=" "),PleaseEnterDesignOrContrastsLabel))
Try(tkgrid.configure(PleaseEnterDesignOrContrastsLabel,columnspan=2))
Try(tkgrid(tklabel(ttDesignOrContrastsTable,text=" ")))
#
if(Design==TRUE){
NumRows <- NumSlides
NumCols <- NumParameters
}else{
NumRows <- NumParameters
NumCols <- NumContrasts
}
#
if(Design==TRUE){
Try(
if(nrow(designOrContrasts)==0){
Try(ParameterNamesVec <- c())
if(NumParameters>0)
for(i in (1:NumParameters))
Try(ParameterNamesVec <- c(ParameterNamesVec,paste("Param ",i,sep="")))
}else{
Try(ParameterNamesVec <- colnames(designOrContrasts))
} #end of else/if(nrow(designOrContrasts)==0)
)
Try(ColNamesVec <- ParameterNamesVec)
}else{
Try(parameterizationTreeIndex <- ParameterizationTreeIndexVec[parameterizationIndex])
Try(ParameterNamesVec <- GetParameterNames(parameterizationTreeIndex))
Try(
if(nrow(designOrContrasts)==0){
Try(ContrastsNamesVec <- c())
if(NumContrasts>0){
for(i in (1:NumContrasts)){
Try(ContrastsNamesVec <- c(ContrastsNamesVec,paste("Contrast ",i,sep="")))
}
} #end of if(NumContrasts>0)
}else{
Try(ContrastsNamesVec <- colnames(designOrContrasts))
} #end of else/if(nrow(designOrContrasts)==0)
)
Try(ColNamesVec <- ContrastsNamesVec)
} #end of else/if(Design==TRUE)
#
Try(rownamesDesignOrContrasts <- c())
Try(myRarray <- " ")
for(i in (1:NumRows)){
if(Design==TRUE)
Try(RowName <- SlideNamesVec[i])
else
Try(RowName <- ParameterNamesVec[i])
Try(rownamesDesignOrContrasts <- c(rownamesDesignOrContrasts,RowName))
Try(myRarray <- c(myRarray,paste(RowName)))
} #end of for(i in (1:NumRows))
if(NumCols>0){
for(j in (1:NumCols)){
Try(myRarray <- c(myRarray,paste(ColNamesVec[j])))
for(i in (1:NumRows))
{
if(nrow(designOrContrasts)==0)
Try(myRarray <- c(myRarray,"0"))
else
Try(myRarray <- c(myRarray,paste(designOrContrasts[i,j])))
}
} #end of for(j in (1:NumCols))
} #end of if(NumCols>0)
# This will give an error if tclArray doesn't exist.
# .Tcl("unset tclArray")
Try(dim(myRarray) <- c(NumRows+1,NumCols+1))
if(NumCols>0){
for(i in (0:NumRows)){
for(j in (0:NumCols)){
# Modified to use tcl!
Try(tcl("set",paste(tclArrayName,"(",i,",",j,")",sep=""),paste(myRarray[i+1,j+1])))
} #end of for(j in (0:NumCols))
} #end of for(i in (0:NumRows))
} #end of if(NumCols>0)
#
# Below, can I just use tkwidget(ttDesignOrContrastsTable,"table",...) ?
Try(table1 <- .Tk.subwin(ttDesignOrContrastsTable))
Try(.Tcl(paste("table",.Tk.ID(table1),.Tcl.args(variable=tclArrayName,rows=paste(NumRows+1),cols=paste(NumCols+1),titlerows="0",titlecols="0",selectmode="extended",colwidth="13",background="white",rowseparator="\"\n\"",colseparator="\"\t\"",resizeborders="col",multiline="0"))))
Try(tkgrid(tklabel(ttDesignOrContrastsTable,text=" "),table1))
#
Try(tcl(.Tk.ID(table1),"width","0",paste(max(4,max(nchar(rownamesDesignOrContrasts))+2))))
Try(
if(nrow(designOrContrasts)>0){
Try(
for(j in (1:NumCols)){
Try(tcl(.Tk.ID(table1),"width",paste(j),paste(max(4,max(nchar(ColNamesVec))+2,max(nchar(designOrContrasts[,j]))+2))))
}
)
} #end of if(nrow(designOrContrasts)>0)
)
#
# if(Contrasts==TRUE)
# Try(tcl(.Tk.ID(table1),"width","0","25"))
#
Try(tkconfigure(table1,font=.limmaGUIglobals$limmaGUIfontTable))
Try(tkgrid.configure(table1,columnspan=2))
#
Try(copyFcn <- function() .Tcl(paste("event","generate",.Tcl.args(.Tk.ID(table1),"<<Copy>>"))))
#
openDesignOrContrastsMatrixFile <- function(){
Try(
if(Design==TRUE)
Try(DesignOrContrastsFileName <- tclvalue(tkgetOpenFile(filetypes="{{Design Matrix Files} {.txt}} {{All files} *}")))
else
Try(DesignOrContrastsFileName <- tclvalue(tkgetOpenFile(filetypes="{{Contrasts Matrix Files} {.txt}} {{All files} *}")))
)
Try(if(!nchar(DesignOrContrastsFileName)) return())
Try(DesignOrContrastsTable <- read.table(DesignOrContrastsFileName,header=FALSE,sep="\t",quote="\"",as.is=TRUE))
# This will give an error if tclArray doesn't exist.
# .Tcl("unset tclArray")
if(NumCols>0){
for(i in (0:NumRows)){
for(j in (0:NumCols)){
#Try(.Tcl(paste("set ",tclArrayName,"(",i,",",j,") \"",DesignOrContrastsTable[i+1,j+1],"\"",sep="")))
Try(tcl("set",paste(tclArrayName,"(",i,",",j,")",sep=""),paste(DesignOrContrastsTable[i+1,j+1])))
} #end of for(j in (0:NumCols))
} #end of for(i in (0:NumRows))
} #end of if(NumCols>0)
} #end of openDesignOrContrastsMatrixFile <- function()
#
saveDesignOrContrastsMatrixFile <- function(){
Try(DesignOrContrastsFileName <- tclvalue(tkgetSaveFile(filetypes="{{DesignOrContrasts Matrix Files} {.txt}} {{All files} *}")))
Try(if(!nchar(DesignOrContrastsFileName)) return())
Try(len <- nchar(DesignOrContrastsFileName))
if(len<=4)
Try( DesignOrContrastsFileName <- paste(DesignOrContrastsFileName,".txt",sep=""))
else if(substring(DesignOrContrastsFileName,len-3,len)!=".txt")
Try(DesignOrContrastsFileName <- paste(DesignOrContrastsFileName,".txt",sep=""))
Try(designOrContrasts <- as.data.frame(matrix(nrow=NumSlides,ncol=NumParameters)))
Try(rownamesDesignOrContrasts <- c())
Try(for(i in (1:NumRows))
rownamesDesignOrContrasts[i] <- tclvalue(paste(tclArrayName,"(",i,",0)",sep="")))
Try(colnamesDesignOrContrasts <- c())
if(NumParameters>0)
Try(for(j in (1:NumCols))
colnamesDesignOrContrasts[j] <- tclvalue(paste(tclArrayName,"(0,",j,")",sep="")))
Try(rownames(designOrContrasts) <- rownamesDesignOrContrasts)
Try(colnames(designOrContrasts) <- colnamesDesignOrContrasts)
if(NumParameters>0)
Try(for(i in (1:NumRows))
for(j in (1:NumParameters))
designOrContrasts[i,j] <- as.numeric(tclvalue(paste(tclArrayName,"(",i,",",j,")",sep=""))))
#
Try(write.table(designOrContrasts,file=DesignOrContrastsFileName,col.names=NA,sep="\t",quote=FALSE,row.names=TRUE))
} #end of saveDesignOrContrastsMatrixFile <- function()
#
Try(topMenu <- tkmenu(ttDesignOrContrastsTable, tearoff=FALSE))
Try(fileMenu <- tkmenu(topMenu, tearoff=FALSE))
Try(tkadd(fileMenu, "command", label="Open", command=openDesignOrContrastsMatrixFile))
Try(tkadd(fileMenu, "command", label="Save As", command=saveDesignOrContrastsMatrixFile))
Try(tkadd(topMenu, "cascade", label="File",menu=fileMenu))
#
Try(editMenu <- tkmenu(topMenu, tearoff=FALSE))
Try(tkadd(editMenu, "command", label="Copy <Ctrl-C>", command=copyFcn))
Try(tkadd(topMenu, "cascade", label="Edit",menu=editMenu))
#
Try(tkconfigure(ttDesignOrContrastsTable,menu=topMenu))
#
Try(BlankLabel1<-tklabel(ttDesignOrContrastsTable,text=" "))
Try(tkgrid(BlankLabel1))
Try(BlankLabel2<-tklabel(ttDesignOrContrastsTable,text=" "))
Try(tkgrid(BlankLabel2,OK.but,Cancel.but))
Try(tkgrid.configure(OK.but,sticky="e"))
Try(tkgrid.configure(Cancel.but,sticky="w"))
Try(BlankLabel3<-tklabel(ttDesignOrContrastsTable,text=" "))
Try(tkgrid(BlankLabel3))
#
Try(tkfocus(ttDesignOrContrastsTable))
Try(tkbind(ttDesignOrContrastsTable, "<Destroy>", function() {Try(tkgrab.release(ttDesignOrContrastsTable));Try(tkfocus(.limmaGUIglobals$ttMain));}))
Try(tkwait.window(ttDesignOrContrastsTable))
return (ReturnVal)
} #end of GetDesignOrContrastsTable <- function(designOrContrastsFromDropDowns)
#
#
OnAdvanced <- function(){
Try(RawMADataWasImported <- get("RawMADataWasImported",envir=limmaGUIenvironment))
Try(NormalizedMADataWasImported <- get("NormalizedMADataWasImported",envir=limmaGUIenvironment))
Try(
if(!RawMADataWasImported && !NormalizedMADataWasImported){
Try(designOrContrastsFromDropDowns <- GetDesignOrContrastsFromDropDowns())
Try(ReturnValDesignOrContrastsTable <- GetDesignOrContrastsTable(designOrContrastsFromDropDowns)) # Returns designOrContrasts list object including designOrContrasts matrix as data.frame
}else{
Try(ReturnValDesignOrContrastsTable <- GetDesignOrContrastsTable(list(design=data.frame(),designOrContrastsCreatedFromDropDowns=TRUE,TargetVector=c(),RNAType1=c(),RNAType2=c(),plusOrMinus=c()))) # Returns designOrContrasts list object including designOrContrasts matrix as data.frame
} #end of if(!RawMADataWasImported && !NormalizedMADataWasImported)
)
if(Design==TRUE)
NumRows <- nrow(ReturnValDesignOrContrastsTable$design)
else
NumRows <- nrow(ReturnValDesignOrContrastsTable$contrasts)
if(NumRows>0 ){ # OK was clicked, not Cancel
Try(
if(!RawMADataWasImported && !NormalizedMADataWasImported){
Try(tkgrab.release(ttDesignOrContrasts))
Try(tkdestroy(ttDesignOrContrasts))
} #end of if(!RawMADataWasImported && !NormalizedMADataWasImported)
)
Try(tkfocus(.limmaGUIglobals$ttMain))
ReturnVal <<- ReturnValDesignOrContrastsTable # List contains designOrContrasts matrix as data.frame
} #end of if(NumRows>0 )
} #end of OnAdvanced <- function()
#
Try(
if(RawMADataWasImported || NormalizedMADataWasImported){
Try(GetParamsReturnVal <- GetNumParametersNoTargets())
Try(if(GetParamsReturnVal==-1)return(ReturnVal))
Try(NumParameters <- get("NumParameters",envir=limmaGUIenvironment))
OnAdvanced()
return(ReturnVal)
} #end of if(RawMADataWasImported || NormalizedMADataWasImported)
)
#
if(Design==TRUE){
# We will try to determine the number of parameters to be estimated (one less than
# the number of RNA targets). For now, we'll assume column
# names are Cy3 and Cy5, but later we can allow for Red, Green, RED, GREEN, CY5, CY3.
#
Try(Cy3Targets <- as.vector(Targets["Cy3"])$Cy3)
Try(Cy5Targets <- as.vector(Targets["Cy5"])$Cy5)
#
Cy3Copy <- Cy3Targets
Cy5Copy <- Cy5Targets
#
# Target <- Cy3Targets[1]
TargetVector <- c(Cy3Targets[1])
TargetsCounted <- 1
for(i in (1:length(Cy3Targets))){
for(j in (1:length(TargetVector))){
if(Cy3Targets[i]==TargetVector[j])Cy3Copy[i]<-"Counted"
} #end of for(j in (1:length(TargetVector)))
if(Cy3Copy[i]!="Counted"){
TargetVector <- c(TargetVector,Cy3Targets[i])
TargetsCounted <- TargetsCounted + 1
} #end of if(Cy3Copy[i]!="Counted")
} #end of for(i in (1:length(Cy3Targets)))
#
for(i in (1:length(Cy5Targets))){
for(j in (1:length(TargetVector))){
if(Cy5Targets[i]==TargetVector[j])Cy5Copy[i]<-"Counted"
} #end of for(j in (1:length(TargetVector)))
if(Cy5Copy[i]!="Counted"){
TargetVector <- c(TargetVector,Cy5Targets[i])
TargetsCounted <- TargetsCounted + 1
} #end of if(Cy5Copy[i]!="Counted")
} #end of for(i in (1:length(Cy5Targets)))
#
# NumParameters should be OK as a global, because the number of parameters is the same, no matter what the
# parametrization (unless we start dealing with Scorecard Controls, but they would need a whole new Targets file).
#
# We now allow for unconnected designOrContrastss.
# The "graph" below is a network graph, not a plot.
#
RNATypesGraph <- list()
Try(
for(i in (1:NumSlides)){
RNATypesGraph[[i]] <- c(Cy3Targets[i],Cy5Targets[i])
} #end of for(i in (1:NumSlides))
)
countConnectedSubGraphs <- function(graph){
count <- 0
connectedSubGraphs <- list()
while (length(graph)){
open <- graph[[1]][1]
closed <- c()
while (length(open)){
test <- open[1]
if(length(open)>1){
open <- open[2:length(open)]
}else{
open <- c()
}
g <- 1
if(!(test %in% closed)){
closed <- c(closed,test)
while (g <= length(graph)){
if(test %in% graph[[g]]){
n <- graph[[g]]
open <- c(open,n[1],n[2])
graph <- deleteItemFromList(graph,index=g)
}else{
g <- g + 1
} #end of else/if(test %in% graph[[g]])
} #end of while (g <= length(graph))
} #end of if(!(test %in% closed))
} #end of while (length(open))
connectedSubGraphs <- c(connectedSubGraphs,list(closed))
count <- count + 1
} #end of while (length(graph))
return (list(count=count,connectedSubGraphs=connectedSubGraphs))
} #end of countConnectedSubGraphs <- function(graph)
#
Try(result <- countConnectedSubGraphs(RNATypesGraph))
Try(numConnectedSubGraphs <- result$count)
Try(connectedSubGraphs <- result$connectedSubGraphs)
#
Try(assign("numConnectedSubGraphs",numConnectedSubGraphs,limmaGUIenvironment))
Try(assign("connectedSubGraphs",connectedSubGraphs,limmaGUIenvironment))
#
Try(assign("NumParameters", TargetsCounted - numConnectedSubGraphs,limmaGUIenvironment))
Try(assign("NumRNATypes", TargetsCounted,limmaGUIenvironment))
Try(NumParameters <- get("NumParameters",envir=limmaGUIenvironment))
ParameterNamesVec <- c()
if(NumParameters>0){
for(i in (1:NumParameters)){
ParameterNamesVec <- c(ParameterNamesVec,paste("Param",i))
}
} #end of if(NumParameters>0)
} #end of if(Design==TRUE)
#
if(NumParameters<=0){
Try(tkmessageBox(title="At Least Two RNA Types Are Required",message="You must have at least two types of RNA in your Targets file.",type="ok",icon="error"))
Try(tkfocus(.limmaGUIglobals$ttMain))
if(Design==TRUE)
return(list(design=data.frame(),designCreatedFromDropDowns=FALSE))
else
return(list(contrasts=data.frame(),contrastsCreatedFromDropDowns=FALSE))
} #end of if(NumParameters<=0)
#
if(Design==TRUE){
NumRows <- NumSlides
NumCols <- NumParameters
}else{
NumRows <- NumParameters
NumCols <- NumContrasts
} #end of else/if(Design==TRUE)
#
if(Contrasts==TRUE){
Try(parameterizationTreeIndex <- ParameterizationTreeIndexVec[parameterizationIndex])
Try(ParameterNamesVec <- GetParameterNames(parameterizationTreeIndex))
}
#
ttDesignOrContrasts<-tktoplevel(.limmaGUIglobals$ttMain)
tkwm.deiconify(ttDesignOrContrasts)
tkgrab.set(ttDesignOrContrasts)
tkfocus(ttDesignOrContrasts)
if(Design==TRUE){
tkwm.title(ttDesignOrContrasts,"Parameters To Estimate")
}else{
tkwm.title(ttDesignOrContrasts,"Contrasts")
}
#
if(Design==TRUE){
lbl2<-tklabel(ttDesignOrContrasts,text="Please specify pairs of RNA for which M parameters will be estimated",font=.limmaGUIglobals$limmaGUIfont2)
}else{
lbl2<-tklabel(ttDesignOrContrasts,text="Please specify pairs of parameters for which contrasts will be estimated",font=.limmaGUIglobals$limmaGUIfont2)
}
lbl3<-tklabel(ttDesignOrContrasts,text=" ")
tkgrid(tklabel(ttDesignOrContrasts,text=" "),row=0,column=1,columnspan=1)
tkgrid(tklabel(ttDesignOrContrasts,text=" "),row=0,column=4,columnspan=1)
tkgrid(lbl2,row=1,column=2,columnspan=4,rowspan=1,sticky="ew");
tkgrid.configure(lbl2,sticky="w")
tkgrid(tklabel(ttDesignOrContrasts,text=" "),column=1)
tkgrid(tklabel(ttDesignOrContrasts,text=" "))
tkgrid(tklabel(ttDesignOrContrasts,text=" "),column=1)
# plus<-tklabel(ttDesignOrContrasts,text=" + ",font=.limmaGUIglobals$limmaGUIfont2)
# minus<-tklabel(ttDesignOrContrasts,text=" - ",font=.limmaGUIglobals$limmaGUIfont2)
# tkgrid(plus,row=3, column=2,sticky="ew")
# tkgrid(minus,row=3,column=6,sticky="ew")
#
Try(
if(Design==TRUE){
TclList1AsString <- "{"
for(i in (1:TargetsCounted))
TclList1AsString <- paste(TclList1AsString,"{",TargetVector[i],"} ",sep="")
TclList1AsString <- paste(TclList1AsString,"}",sep="")
TclList2AsString <- TclList1AsString
}else{
TclList1AsString <- "{"
for(i in (1:NumParameters))
TclList1AsString <- paste(TclList1AsString,"{",ParameterNamesVec[i],"} ",sep="")
TclList1AsString <- paste(TclList1AsString,"}",sep="")
TclList2AsString <- TclList1AsString
} #end of else/Try(if(Design==TRUE)
)
#
Try(
if(Design==TRUE)
plusOrMinusTclListAsString <- "{{minus}}"
else
plusOrMinusTclListAsString <- "{{minus} {plus}}"
)
#
combo1 <- c()
combo2 <- c()
combo3 <- c()
Try(
if(NumCols>0){
for(paramORcontrast in (1:NumCols)){
Try(FirstDropDownColumn <- .Tk.subwin(ttDesignOrContrasts))
combo1 <- c(combo1,FirstDropDownColumn)
Try(.Tcl(paste("ComboBox",.Tk.ID(FirstDropDownColumn),"-editable false -values",TclList1AsString)))
Try(SecondDropDownColumn <- .Tk.subwin(ttDesignOrContrasts))
Try(combo2 <- c(combo2,SecondDropDownColumn))
Try(.Tcl(paste("ComboBox",.Tk.ID(SecondDropDownColumn),"-editable false -values",TclList2AsString)))
Try(plusOrMinusDropDown <- .Tk.subwin(ttDesignOrContrasts))
Try(combo3 <- c(combo3,plusOrMinusDropDown))
Try(.Tcl(paste("ComboBox",.Tk.ID(plusOrMinusDropDown),"-editable false -values",plusOrMinusTclListAsString)))
Try(tcl(.Tk.ID(plusOrMinusDropDown),"setvalue","first"))
Try(
if(.limmaGUIglobals$limmaGUIpresentation==TRUE){
Try(tkconfigure(FirstDropDownColumn,width=10))
Try(tkconfigure(SecondDropDownColumn,width=10))
Try(tkconfigure(plusOrMinusDropDown,width=10))
} #end of if(.limmaGUIglobals$limmaGUIpresentation==TRUE)
)
if(Design==TRUE)
Try(dropdownLabel <- paste("Parameter",paramORcontrast," "))
else
Try(dropdownLabel <- paste("Contrast",paramORcontrast, " ") )
#
Try(tkgrid(tklabel(ttDesignOrContrasts,text=dropdownLabel,font=.limmaGUIglobals$limmaGUIfont2),row=2+paramORcontrast,column=0,sticky="w"))
Try(tkconfigure(FirstDropDownColumn,font=.limmaGUIglobals$limmaGUIfont2))
Try(tkconfigure(SecondDropDownColumn,font=.limmaGUIglobals$limmaGUIfont2))
Try(tkconfigure(plusOrMinusDropDown,font=.limmaGUIglobals$limmaGUIfont2))
Try(tkgrid(FirstDropDownColumn,row=2+paramORcontrast,column=2,columnspan=1,rowspan=1))
Try(tkgrid(plusOrMinusDropDown,row=2+paramORcontrast,column=4,columnspan=1,rowspan=1))
Try(tkgrid(SecondDropDownColumn,row=2+paramORcontrast,column=6,columnspan=1,rowspan=1))
#
Try(tkgrid(tklabel(ttDesignOrContrasts,text=" "),row=2+paramORcontrast,column=7))
} #end of for(paramORcontrast in (1:NumCols))
} #end of if(NumCols>0)
)
tkgrid(tklabel(ttDesignOrContrasts,text=" "),rowspan=1,columnspan=4);
#
if(Design==TRUE)
ReturnVal <- list(design=data.frame(),designCreatedFromDropDowns=TRUE,TargetVector=TargetVector,RNAType1=c(),RNAType2=c(),plusOrMinus=c())
else
ReturnVal <- list(contrasts=data.frame(),contrastsCreatedFromDropDowns=TRUE,TargetVector=c(),Param1=c(),Param2=c(),plusOrMinus=c())
#
GetDesignOrContrastsFromDropDowns <- function(){
if(Design==TRUE){
NumRows <- NumSlides
NumCols <- NumParameters
}else{
NumRows <- NumParameters
NumCols <- NumContrasts
}
#
RNATypeOrParam1 <-c()
RNATypeOrParam2 <-c()
plusOrMinusStringVec <- c("-","+")
plusOrMinus <- c()
#
if(NumCols>0){
for(paramORcontrast in (1:NumCols)){
# I think I wrote this code when I was an R Tcl/Tk beginner. Check and update!
# I think combo1 and combo2 should really be lists, not vectors!!!
# *2 below, because the c() combines the tkwin objects which are acutally
# lists with 2 components: window ID and environment.
selection1 <- tclvalue(.Tcl(paste(.Tk.ID(combo1[paramORcontrast*2-1]),"getvalue")))
selection2 <- tclvalue(.Tcl(paste(.Tk.ID(combo2[paramORcontrast*2-1]),"getvalue")))
selection3 <- tclvalue(.Tcl(paste(.Tk.ID(combo3[paramORcontrast*2-1]),"getvalue")))
if(Design==TRUE){
Try(if((selection1=="-1")||(selection2=="-1"))
return (list(design=data.frame(),designCreatedFromDropDowns=TRUE,TargetVector=TargetVector,RNAType1=c(),RNAType2=c(),plusOrMinus=c())))
}else{
Try(if((selection1=="-1")||(selection2=="-1"))
return (list(contrasts=data.frame(),contrastsCreatedFromDropDowns=TRUE,TargetVector=c(),Param1=c(),Param2=c(),plusOrMinus=c())))
}
RNATypeOrParam1 <- c(RNATypeOrParam1,as.numeric(selection1)+1)
RNATypeOrParam2 <- c(RNATypeOrParam2,as.numeric(selection2)+1)
plusOrMinus <- c(plusOrMinus,plusOrMinusStringVec[as.numeric(selection3)+1])
} #end of for(paramORcontrast in (1:NumCols))
} #end of if(NumCols>0)
#
designOrContrasts <- as.data.frame(matrix(nrow=NumRows,ncol=NumCols))
if(Design==TRUE)
Try(rownames(designOrContrasts) <- SlideNamesVec)
else
Try(rownames(designOrContrasts) <- ParameterNamesVec)
#
Try(
if(Design==TRUE){
ParameterNamesVec <- vector(length=NumParameters)
if(NumParameters>0){
for(j in (1:NumParameters)){
ParameterNamesVec[j] <- paste("(",TargetVector[RNATypeOrParam1[j]],")-(",TargetVector[RNATypeOrParam2[j]],")",sep="")
}
} #end of if(NumParameters>0)
colnames(designOrContrasts) <- ParameterNamesVec
}else{
Try(parameterizationTreeIndex <- ParameterizationTreeIndexVec[parameterizationIndex])
Try(ParameterNamesVec <- GetParameterNames(parameterizationTreeIndex))
ContrastNamesVec <- vector(length=NumContrasts)
if(NumContrasts>0){
for(j in (1:NumContrasts)){
ContrastNamesVec[j] <- SimplifyContrastsExpression(paste("(",ParameterNamesVec[RNATypeOrParam1[j]],")",plusOrMinus[j],"(",ParameterNamesVec[RNATypeOrParam2[j]],")",sep=""))
}
} #end of if(NumContrasts>0)
colnames(designOrContrasts) <- ContrastNamesVec
}
)
#
if(Design==TRUE){
ParamMatrix <- matrix(nrow=TargetsCounted,ncol=NumParameters)
if(NumParameters>0){
for(i in (1:NumParameters)){
for(j in (1:TargetsCounted)){
ParamMatrix[j,i] <- 0
}
ParamMatrix[RNATypeOrParam1[i],i] <- 1
ParamMatrix[RNATypeOrParam2[i],i] <- -1
} #end of for(i in (1:NumParameters))
} #end of if(NumParameters>0)
Try(QR <- qr(ParamMatrix))
Try(
if(QR$rank!=ncol(QR$qr)){
Try(tkmessageBox(title="Design Matrix",message=paste("Error: Parameters are not linearly independent.\n\n",
"Try entering independent parameters or click on the Advanced button to enter the design matrix directly.",sep=""),icon="error"))
Try(return (list(design=data.frame(),designOrContrastsCreatedFromDropDowns=TRUE,TargetVector=TargetVector,RNAType1=c(),RNAType2=c(),plusOrMinus=c())))
} #end of if(QR$rank!=ncol(QR$qr))
)
RNATargetsVec <- vector(length=TargetsCounted)
for(i in (1:NumSlides)){
for(j in (1:TargetsCounted)){
RNATargetsVec[j] <- 0
if(paste(Cy5Targets[i])==paste(TargetVector[j]))RNATargetsVec[j] <- 1
if(paste(Cy3Targets[i])==paste(TargetVector[j]))RNATargetsVec[j] <- -1
} #end of for(j in (1:TargetsCounted))
designOrContrasts[i,] <- qr.solve(ParamMatrix,RNATargetsVec)
} #end of for(i in (1:NumSlides))
designOrContrasts <- round(designOrContrasts,digits=8)
}else{ # (Contrasts==TRUE)
Try(
for(i in (1:NumParameters)){
for(j in (1:NumContrasts)){
Try(designOrContrasts[i,j] <- 0)
Try(if(RNATypeOrParam1[j]==i)designOrContrasts[i,j] <- 1)
Try(
if(plusOrMinus[j]=="-"){
Try(if(RNATypeOrParam2[j]==i)designOrContrasts[i,j] <- -1)
}else{ # "+"
Try(if(RNATypeOrParam2[j]==i)designOrContrasts[i,j] <- 1)
} #end of else/if(plusOrMinus[j]=="-")
)
} #end of for(j in (1:NumContrasts))
} #end of for(i in (1:NumParameters))
)
} #end of else/if(Design==TRUE)
#
if(Design==TRUE)
return(list(design=designOrContrasts,designCreatedFromDropDowns=TRUE,TargetVector=TargetVector,RNAType1=RNATypeOrParam1,RNAType2=RNATypeOrParam2,plusOrMinus=plusOrMinus))
else
return(list(contrasts=designOrContrasts,contrastsCreatedFromDropDowns=TRUE,TargetVector=c(),Param1=RNATypeOrParam1,Param2=RNATypeOrParam2,plusOrMinus=plusOrMinus))
} #end of GetDesignOrContrastsFromDropDowns <- function()
#
onOK <- function(){
Try(designOrContrastsList <- GetDesignOrContrastsFromDropDowns())
Try(
if(Design==TRUE){
Try(
if(nrow(designOrContrastsList$design)==0){
Try(tkmessageBox(title="Parameterization",message=paste("Error in creating parameterization from drop-down selection. ",
"Make sure you have selected an RNA pair for each parameter and that your parameters are linearly independent."),type="ok",icon="error"))
Try(ReturnVal <<- list(design=data.frame(),designCreatedFromDropDowns=TRUE,TargetVector=TargetVector,RNAType1=c(),RNAType2=c(),plusOrMinus=c()))
return()
}else{
Try(tkgrab.release(ttDesignOrContrasts))
Try(tkdestroy(ttDesignOrContrasts))
Try(tkfocus(.limmaGUIglobals$ttMain))
Try(ReturnVal <<- designOrContrastsList)
Try(tkfocus(.limmaGUIglobals$ttMain))
return()
} #end of else/if(nrow(designOrContrastsList$design)==0)
)
} #end of if(Design==TRUE)
)
Try(
if(Contrasts==TRUE){
Try(
if(nrow(designOrContrastsList$contrasts)==0){
Try(
tkmessageBox(
title="Contrasts",
message=paste(
"Error in creating contrasts matrix from drop-down selection. ",
"Make sure you have selected a parameter pair for each contrast."
),
type="ok",
icon="error"
)
)
Try(ReturnVal <<- list(contrasts=data.frame(),contrastsCreatedFromDropDowns=TRUE,TargetVector=c(),Param1=c(),Param2=c(),plusOrMinus=c()))
return()
}else{
Try(tkgrab.release(ttDesignOrContrasts))
Try(tkdestroy(ttDesignOrContrasts))
Try(tkfocus(.limmaGUIglobals$ttMain))
Try(ReturnVal <<- designOrContrastsList)
Try(tkfocus(.limmaGUIglobals$ttMain))
return()
} #end of else/if(nrow(designOrContrastsList$contrasts)==0)
)
} #end of if(Contrasts==TRUE)
)
} #end of onOK <- function()
#
onCancel <- function(){
Try(tkgrab.release(ttDesignOrContrasts))
Try(tkdestroy(ttDesignOrContrasts))
Try(tkfocus(.limmaGUIglobals$ttMain))
if(Design==TRUE)
ReturnVal <<- list(design=data.frame(),designCreatedFromDropDowns=TRUE,TargetVector=TargetVector,RNAType1=c(),RNAType2=c(),plusOrMinus=c())
else
ReturnVal <<- list(contrasts=data.frame(),contrastsCreatedFromDropDowns=TRUE,TargetVector=c(),Param1=c(),Param2=c(),plusOrMinus=c())
} #end of onCancel <- function()
Advanced.but <- tkbutton(ttDesignOrContrasts,text="Advanced...",command=OnAdvanced,font=.limmaGUIglobals$limmaGUIfont2)
Try(OK.but <-tkbutton(ttDesignOrContrasts,text=" OK ",command=onOK,font=.limmaGUIglobals$limmaGUIfont2))
Try(Cancel.but <-tkbutton(ttDesignOrContrasts,text=" Cancel ",command=onCancel,font=.limmaGUIglobals$limmaGUIfont2))
Try(tkgrid(OK.but,column=2,row=9+NumParameters))
Try(tkgrid(Cancel.but,column=4,row=9+NumParameters))
Try(tkgrid(Advanced.but,column=6,row=9+NumParameters))
Try(tkgrid(tklabel(ttDesignOrContrasts,text=" ")))
#
Try(tkfocus(ttDesignOrContrasts))
#
Try(tkbind(ttDesignOrContrasts, "<Destroy>", function() {Try(tkgrab.release(ttDesignOrContrasts));Try(tkfocus(.limmaGUIglobals$ttMain));}))
Try(tkwait.window(ttDesignOrContrasts))
return (ReturnVal)
} #end of GetDesignOrContrasts <- function(Design=FALSE,Contrasts=FALSE,NumContrasts=0,parameterizationIndex=0)
#
#
SimplifyContrastsExpression <- function(string){
RNATypesAndSign <- GetRNATypesFrom.ContrastsFromDropDowns.String(string)
RNA1 <- RNATypesAndSign$RNA1
RNA2 <- RNATypesAndSign$RNA2
RNA3 <- RNATypesAndSign$RNA3
RNA4 <- RNATypesAndSign$RNA4
plusOrMinusSign <- RNATypesAndSign$plusOrMinusSign
ReturnVal <- string
#
if(RNA1==RNA3&&plusOrMinusSign=='-')
ReturnVal <- paste("(",RNA4,")-(",RNA2,")",sep="")
if(RNA2==RNA4&&plusOrMinusSign=='-')
ReturnVal <- paste("(",RNA1,")-(",RNA3,")",sep="")
if(RNA1==RNA4&&plusOrMinusSign=='+')
ReturnVal <- paste("(",RNA3,")-(",RNA2,")",sep="")
if(RNA2==RNA3&&plusOrMinusSign=='+')
ReturnVal <- paste("(",RNA1,")-(",RNA4,")",sep="")
#
return(ReturnVal)
} #end of SimplifyContrastsExpression <- function(string)
#
#
GetRNATypesFrom.ContrastsFromDropDowns.String <- function(string){
len <- nchar(string)
string <- substr(string,3,len)
# string == "a)-(b))-((b)-(c"
len <- nchar(string)
i <- 1
while (substr(string,i,i)!=")" && (i<=len))
i <- i + 1
RNA1 <- substr(string,1,i-1)
len <- nchar(string)
string <- substr(string,i+3,len)
len <- nchar(string)
i<-1
while (substr(string,i,i)!=")" && (i<=len))
i <- i + 1
RNA2 <- substr(string,1,i-1)
len <- nchar(string)
plusOrMinusSign <- substr(string,i+2,i+2)
string <- substr(string,i+5,len)
len <- nchar(string)
i<-1
while (substr(string,i,i)!=")" && (i<=len))
i <- i + 1
RNA3 <- substr(string,1,i-1)
len <- nchar(string)
string <- substr(string,i+3,len)
len <- nchar(string)
i<-1
while (substr(string,i,i)!=")" && (i<=len))
i <- i + 1
RNA4 <- substr(string,1,i-1)
list(RNA1=RNA1,RNA2=RNA2,RNA3=RNA3,RNA4=RNA4,plusOrMinusSign=plusOrMinusSign)
} #end of GetRNATypesFrom.ContrastsFromDropDowns.String <- function(string)
#
#
GetParameterNames <- function(parameterizationTreeIndex){
Try(NumParameters <- get("NumParameters",envir=limmaGUIenvironment))
Try(ParameterizationList <- get("ParameterizationList",envir=limmaGUIenvironment))
Try(ParameterizationNameNode <- paste("ParameterizationName.",parameterizationTreeIndex,sep=""))
Try(ParameterNamesVec <- c())
if(NumParameters>0){
for(i in (1:NumParameters)){
Try(ParametersNameNode<- paste("PMFParams.",parameterizationTreeIndex,".",i,sep=""))
Try(ParameterNamesVec[i] <- (ParameterizationList[[ParameterizationNameNode]])[[ParametersNameNode]])
} #end of for(i in (1:NumParameters))
} #end of if(NumParameters>0)
return (ParameterNamesVec)
} #end of GetParameterNames <- function(parameterizationTreeIndex)
#
#
GetReducedDuplicateSpacing <- function(parameterizationTreeIndex){
Try(NumParameters <- get("NumParameters",envir=limmaGUIenvironment))
Try(ParameterizationList <- get("ParameterizationList",envir=limmaGUIenvironment))
Try(ParameterizationNameNode <- paste("ParameterizationName.",parameterizationTreeIndex,sep=""))
Try(spacing <- get("spacing",envir=limmaGUIenvironment))
Try(ndups <- get("ndups",envir=limmaGUIenvironment))
Try(gal <- get("gal",envir=limmaGUIenvironment))
Try(SpotTypes <- get("SpotTypes",envir=limmaGUIenvironment))
Try(numSpotTypes <- nrow(SpotTypes))
Try(SpotTypeStatus <- get("SpotTypeStatus",envir=limmaGUIenvironment))
Try(SpotTypesForLinearModel <- ParameterizationList[[ParameterizationNameNode]]$SpotTypesForLinearModel)
Try(RG <- get("RG",envir=limmaGUIenvironment))
Try(MA <- MA.RG(RG)) # Locally only.
Try(oldNumRows <- nrow(MA$M))
Try(Omit <- "")
Try(count <- 0)
Try(
for(i in (1:numSpotTypes)){
Try(if(SpotTypesForLinearModel[i]==TRUE)next())
Try(count <- count + 1)
Try(
if(count>1){
Try(Omit <-paste(Omit,"|"))
}else{
Try(Omit <- "(")
}
)
Try(Omit <- paste(Omit," (SpotTypeStatus==\"",SpotTypes[i,"SpotType"],"\")",sep=""))
} #end of for(i in (1:numSpotTypes))
)
#
Try(
if(nchar(Omit)>0){
Try(Omit <- paste(Omit,")"))
Try(Omit <- eval(parse(text=Omit)))
MA$M <- MA$M[!Omit,]
MA$A <- MA$A[!Omit,]
} #end of if(nchar(Omit)>0)
)
#
Try(newNumRows <- nrow(MA$M))
Try(parameterizationSpacing <- spacing)
Try(spacingCorrected <- 0)
Try(if(oldNumRows/spacing==2 && oldNumRows!=newNumRows) { parameterizationSpacing <- newNumRows/2; spacingCorrected <- 1})
Try(if(oldNumRows/spacing==3 && oldNumRows!=newNumRows) { parameterizationSpacing <- newNumRows/3; spacingCorrected <- 1})
Try(if(oldNumRows/spacing==4 && oldNumRows!=newNumRows) { parameterizationSpacing <- newNumRows/4; spacingCorrected <- 1})
Try(if(oldNumRows/spacing==5 && oldNumRows!=newNumRows) { parameterizationSpacing <- newNumRows/5; spacingCorrected <- 1})
Try(if(oldNumRows/spacing==6 && oldNumRows!=newNumRows) { parameterizationSpacing <- newNumRows/6; spacingCorrected <- 1})
Try(if(oldNumRows/spacing==7 && oldNumRows!=newNumRows) { parameterizationSpacing <- newNumRows/7; spacingCorrected <- 1})
Try(if(oldNumRows/spacing==8 && oldNumRows!=newNumRows) { parameterizationSpacing <- newNumRows/8; spacingCorrected <- 1})
Try(if(oldNumRows/spacing==9 && oldNumRows!=newNumRows) { parameterizationSpacing <- newNumRows/9; spacingCorrected <- 1})
Try(if(oldNumRows/spacing==10 && oldNumRows!=newNumRows){ parameterizationSpacing <- newNumRows/10; spacingCorrected <- 1})
return (parameterizationSpacing)
} #end of GetReducedDuplicateSpacing <- function(parameterizationTreeIndex)
#
#
GetContrastsParameterizationNames <- function(parameterizationTreeIndex){
Try(ParameterizationList <- get("ParameterizationList",envir=limmaGUIenvironment))
Try(ParameterizationNameNode <- paste("ParameterizationName.",parameterizationTreeIndex,sep=""))
Try(NumContrastParameterizations <- ParameterizationList[[ParameterizationNameNode]]$NumContrastParameterizations)
Try(ContrastsParameterizationNamesVec <- c())
if(NumContrastParameterizations>0){
for(i in (1:NumContrastParameterizations)){
Try(ContrastsParameterizationNamesNode<- paste("ContrastsParameterizationNames.",parameterizationTreeIndex,".",i,sep=""))
Try(ContrastsParameterizationNamesVec[i] <- (ParameterizationList[[ParameterizationNameNode]])[[ContrastsParameterizationNamesNode]])
}
} #end of if(NumContrastParameterizations>0)
return (ContrastsParameterizationNamesVec)
} #end of GetContrastsParameterizationNames <- function(parameterizationTreeIndex)
#
#
GetSpotTypesIncludedNames <- function(parameterizationTreeIndex){
Try(ParameterizationList <- get("ParameterizationList",envir=limmaGUIenvironment))
Try(ParameterizationNameNode <- paste("ParameterizationName.",parameterizationTreeIndex,sep=""))
Try(SpotTypes <- get("SpotTypes",envir=limmaGUIenvironment))
Try(numSpotTypes <- nrow(SpotTypes))
Try(SpotTypesForLinearModel <- (ParameterizationList[[ParameterizationNameNode]])$SpotTypesForLinearModel)
#
count <- 0
Try(SpotTypesIncludedNamesVec <- c())
if(numSpotTypes>0)
for(i in (1:numSpotTypes)){
if(SpotTypesForLinearModel[i]==FALSE)next()
count <- count + 1
Try(SpotTypesNode<- paste("PMFSpotTypes.",parameterizationTreeIndex,".",i,sep=""))
Try(SpotTypesIncludedNamesVec[count] <- (ParameterizationList[[ParameterizationNameNode]])[[SpotTypesNode]])
}
return (SpotTypesIncludedNamesVec)
} #end of GetSpotTypesIncludedNames <- function(parameterizationTreeIndex)
#
#
HowManyDups <- function(){
Try(ndups <- get("ndups",envir=limmaGUIenvironment))
Try(spacing <- get("spacing",envir=limmaGUIenvironment))
ttHowManyDups<-tktoplevel(.limmaGUIglobals$ttMain)
tkwm.deiconify(ttHowManyDups)
tkgrab.set(ttHowManyDups)
tkfocus(ttHowManyDups)
tkwm.title(ttHowManyDups,"Number of Duplicates")
#
tkframe1 <- tkframe(ttHowManyDups,relief="groove",borderwidth=2)
tkframe2 <- tkframe(ttHowManyDups,relief="groove",borderwidth=2)
#
tkgrid(tklabel(ttHowManyDups,text=" "))
tkgrid(tklabel(ttHowManyDups,text="Looking at the GAL file will help you to answer these questions.",font=.limmaGUIglobals$limmaGUIfont2),columnspan=2)
tkgrid(tklabel(ttHowManyDups,text=" "))
tkgrid(tklabel(tkframe1,text="How many prints of each gene are there? ",font=.limmaGUIglobals$limmaGUIfont2),sticky="w")
NumDups<- tclVar(paste(ndups))
entry.NumDups<-tkentry(tkframe1,width="20",font=.limmaGUIglobals$limmaGUIfont2,textvariable=NumDups,bg="white")
tkgrid(tklabel(tkframe1,text="Number of prints for each gene : ",font=.limmaGUIglobals$limmaGUIfont2),entry.NumDups,sticky="w")
tkgrid(tkframe1,columnspan=2)
tkgrid(tklabel(ttHowManyDups,text=" "))
tkgrid(tklabel(tkframe2,text="What is the spacing between duplicate genes? ",font=.limmaGUIglobals$limmaGUIfont2),sticky="w")
Spacing<- tclVar(paste(spacing))
entry.Spacing<-tkentry(tkframe2,width="20",font=.limmaGUIglobals$limmaGUIfont2,textvariable=Spacing,bg="white")
tkgrid(tklabel(tkframe2,text="Spacing between duplicate genes : ",font=.limmaGUIglobals$limmaGUIfont2),entry.Spacing,sticky="w")
tkgrid(tkframe2,columnspan=2)
tkgrid(tklabel(ttHowManyDups,text=" "))
ReturnVal <- 0
onOK <- function(){
ndups <- as.integer(tclvalue(NumDups))
Try(assign("ndups",ndups,limmaGUIenvironment))
spacing <- as.integer(tclvalue(Spacing))
Try(assign("spacing",spacing,limmaGUIenvironment))
Try(tkgrab.release(ttHowManyDups))
Try(tkdestroy(ttHowManyDups))
Try(tkfocus(.limmaGUIglobals$ttMain))
ReturnVal <<- 1
} #end of onOK <- function()
onCancel <- function() {Try(tkgrab.release(ttHowManyDups));Try(tkdestroy(ttHowManyDups));Try(tkfocus(.limmaGUIglobals$ttMain));ReturnVal <<- 0}
OK.but <-tkbutton(ttHowManyDups,text=" OK ",command=onOK,font=.limmaGUIglobals$limmaGUIfont2)
Cancel.but <-tkbutton(ttHowManyDups,text=" Cancel ",command=onCancel,font=.limmaGUIglobals$limmaGUIfont2)
tkgrid(OK.but,Cancel.but)
tkgrid.configure(OK.but,sticky="e")
tkgrid.configure(Cancel.but,sticky="w")
tkgrid(tklabel(ttHowManyDups,text=" "))
Try(tkfocus(ttHowManyDups))
Try(tkbind(ttHowManyDups, "<Destroy>", function() {Try(tkgrab.release(ttHowManyDups));Try(tkfocus(.limmaGUIglobals$ttMain));}))
Try(tkwait.window(ttHowManyDups))
return (ReturnVal)
} #end of HowManyDups <- function()
#
#
ViewDesignOrContrastsMatrixInTable <- function(DesignOrContrasts,designOrContrastsList,parameterizationIndex,contrastsParameterizationIndex=NULL){
Try(
if(DesignOrContrasts!="Design" && DesignOrContrasts!="Contrasts"){
Try(tkmessageBox(title="View Design Or Contrasts Matrix In Table",message="Error: First argument must be \"Design\" or \"Contrasts\".",icon="error"))
return()
} #end of if(DesignOrContrasts!="Design" && DesignOrContrasts!="Contrasts")
)
#
Try(SlideNamesVec <- get("SlideNamesVec",envir=limmaGUIenvironment))
Try(NumParameters <- get("NumParameters",envir=limmaGUIenvironment))
Try(NumSlides <- get("NumSlides",envir=limmaGUIenvironment))
Try(ParameterizationNamesVec <- get("ParameterizationNamesVec",envir=limmaGUIenvironment))
Try(ParameterizationTreeIndexVec <- get("ParameterizationTreeIndexVec",envir=limmaGUIenvironment))
Try(parameterizationTreeIndex <- ParameterizationTreeIndexVec[parameterizationIndex])
Try(ContrastsParameterizationNamesVec <- GetContrastsParameterizationNames(parameterizationTreeIndex))
Try(ttViewDesignOrContrastsTable <- tktoplevel(.limmaGUIglobals$ttMain))
Try(tkwm.deiconify(ttViewDesignOrContrastsTable))
Try(tkgrab.set(ttViewDesignOrContrastsTable))
Try(tkfocus(ttViewDesignOrContrastsTable))
Try(
if(DesignOrContrasts=="Design"){
Try(tkwm.title(ttViewDesignOrContrastsTable,paste("Design matrix for parameterization ",ParameterizationNamesVec[parameterizationIndex],".",sep="")))
}else{
Try(tkwm.title(ttViewDesignOrContrastsTable,paste("Contrasts matrix for contrasts parameterization ", ContrastsParameterizationNamesVec[contrastsParameterizationIndex],
" in parameterization ",ParameterizationNamesVec[parameterizationIndex],".",sep="")))
} #end of if(DesignOrContrasts=="Design")
)
Try(
if(DesignOrContrasts=="Design")
Try(designOrContrasts <- designOrContrastsList$design)
else
Try(designOrContrasts <- designOrContrastsList$contrasts)
)
#
onClose <- function() {Try(.Tcl(paste("event","generate",.Tcl.args(.Tk.ID(table1),"<Leave>"))));Try(tkgrab.release(ttViewDesignOrContrastsTable));Try(tkdestroy(ttViewDesignOrContrastsTable));Try(tkfocus(.limmaGUIglobals$ttMain))}
#
Try(
if