Nothing
R/permutationstatmenu.R
In oneChannelGUI: A graphical interface designed to facilitate analysis of microarrays and miRNA/RNA-seq data on laptops
#set of functions, directly/indirectly involved, in oneChannelGUI Permutation stat Menu
#oneChannelGUI siggenes running SAM for two group unpaired test
#contains oneChannelGUI SaveTopTable called inside the function
#oneChannelGUI rankProd running RankProd for two group unpaired test considering also the differnet origin of the data
#contains oneChannelGUI SaveTopTable called inside the function
#################################################################################
#this functionis made to run SAM analysis on Bioconductor
"siggenes" <- function(){
#require(siggenes) || stop("library siggenes could not be found !")
#error if no data are loaded
Try(whichArrayPlatform <- get("whichArrayPlatform",envir=affylmGUIenvironment))
if(whichArrayPlatform ==""){
Try(tkmessageBox(title="SAM analysis",message="No arrays have been loaded. Please try New or Open from the File menu.",type="ok",icon="error"))
Try(tkfocus(.affylmGUIglobals$ttMain))
Try(return())
}
if(whichArrayPlatform=="AFFY"){
if(!affylmGUIenvironment$NormalizedAffyData.Available)
{
Try(tkmessageBox(title="SAM analysis",message="Probe set summary is not available!\nNext menu will give options for probe set summarization", type="ok", icon="info"))
Try(NormalizeNow())
Try(tkconfigure(.affylmGUIglobals$ttMain,cursor="watch"))
Try(NormalizedAffyData <- get("NormalizedAffyData",envir=affylmGUIenvironment))
Try(tkconfigure(.affylmGUIglobals$ttMain,cursor="arrow"))
}
}
#########################
Try(targets <- affylmGUIenvironment$Targets$Target)
Try(NormalizedAffyData <- get("NormalizedAffyData", env=affylmGUIenvironment))
Try(target.unique <- unique(targets))
Try(cl <- rep(0,length(targets)))
if(length(target.unique) == 2){
#groups definition
Try(tkmessageBox(title="siggenes analysis",message="Two-Class unpaired case analysis will be performed."))
Try(cl[which(targets==target.unique[2])] <- 1)
Try(sam.out <- sam(NormalizedAffyData, cl, rand = 1234567, gene.names = featureNames(NormalizedAffyData)))
SaveTopTable <- function()
{
Try(FileName <- tclvalue(tkgetSaveFile(initialfile=paste("siggene.delta.table.xls",sep=""),filetypes="{{Tab-Delimited Text Files} {.txt .xls}} {{All files} *}")))
Try(if(!nchar(FileName))
return())
Try(write.table(show(sam.out),file=FileName,quote=FALSE,col.names=NA,sep="\t"))
}
Try(tempfile1 <- tempfile())
write.table(show(sam.out),file=tempfile1,quote=FALSE,col.names=NA,sep="\t")
ttToptableTable <- tktoplevel(.affylmGUIglobals$ttMain)
tkwm.title(ttToptableTable,"Delta table")
xscr <-tkscrollbar(ttToptableTable, repeatinterval=5,orient="horizontal", command=function(...)tkxview(txt,...))
scr <- tkscrollbar(ttToptableTable, repeatinterval=5, command=function(...)tkyview(txt,...))
txt <- tktext(ttToptableTable, bg="white", font="courier",xscrollcommand=function(...)tkset(xscr,...), yscrollcommand=function(...)tkset(scr,...),wrap="none",width=100)
tkpack(scr, side="right", fill="y")
tkpack(xscr, side="bottom", fill="x")
tkpack(txt, side="left", fill="both", expand="yes")
chn <- tclvalue(tclopen( tempfile1))
tkinsert(txt, "end", tclvalue(tclread( chn)))
tclclose( chn)
tkconfigure(txt, state="disabled")
tkmark.set(txt,"insert","0.0")
tkfocus(txt)
topMenu2 <- tkmenu(ttToptableTable)
tkconfigure(ttToptableTable, menu=topMenu2)
fileMenu2 <- tkmenu(topMenu2, tearoff=FALSE)
tkadd(fileMenu2, "command", label="Save As", command=SaveTopTable) # ) # ,font=affylmGUIfontMenu)
tkadd(fileMenu2, "command", label="Close", command=function() tkdestroy(ttToptableTable)) # ) # ,font=affylmGUIfontMenu)
tkadd(topMenu2, "cascade", label="File", menu=fileMenu2) # ,font=affylmGUIfontMenu)
######################################################################################
#selecting the delta threshold
#iserire un tasto yes/no altrimenti non si riesce nemmeno a vedere la tabella dei delta
Try(startFun <- tclvalue(tkmessageBox(title="Delta threshold",message="Are you satisfied of the delta table results?",type="yesno",icon="question")))
if (startFun=="yes"){
Try(ttThresholdDelta<-tktoplevel(.affylmGUIglobals$ttMain))
Try(tkwm.deiconify(ttThresholdDelta))
Try(tkgrab.set(ttThresholdDelta))
Try(tkfocus(ttThresholdDelta))
Try(tkwm.title(ttThresholdDelta,"Delta value"))
Try(tkgrid(tklabel(ttThresholdDelta,text=" ")))
Try(ThresholdDelta <- "")
Try(Local.FileName <- tclVar(init=ThresholdDelta))
Try(entry.FileName <-tkentry(ttThresholdDelta,width="10",font=.affylmGUIglobals$affylmGUIfont2,textvariable=Local.FileName,bg="white"))
Try(tkgrid(tklabel(ttThresholdDelta,text="Please enter the DELTA value related \nto the FDR of your choice",font=.affylmGUIglobals$affylmGUIfont2)))
Try(tkgrid(entry.FileName))
onOK <- function()
{
Try(ThresholdDelta <- tclvalue(Local.FileName))
if(nchar(ThresholdDelta)==0)
Try(ThresholdDelta <- "Unselected")
Try(assign("ThresholdDelta",ThresholdDelta,affylmGUIenvironment))
Try(tclvalue(.affylmGUIglobals$ThresholdDeltaTcl) <- ThresholdDelta)
Try(tkgrab.release(ttThresholdDelta));Try(tkdestroy(ttThresholdDelta));Try(tkfocus(.affylmGUIglobals$ttMain))
}
Try(OK.but <-tkbutton(ttThresholdDelta,text=" OK ",command=onOK,font=.affylmGUIglobals$affylmGUIfont2))
# Try(tkgrid(tklabel(ttThresholdDelta,text=" "),OK.but,Cancel.but,tklabel(ttThresholdDelta,text=" ")))
Try(tkgrid(tklabel(ttThresholdDelta,text=" ")))
Try(tkgrid(OK.but))
Try(tkgrid.configure(OK.but))
Try(tkgrid(tklabel(ttThresholdDelta,text=" ")))
Try(tkfocus(entry.FileName))
Try(tkbind(entry.FileName, "<Return>",onOK))
Try(tkbind(ttThresholdDelta, "<Destroy>", function(){Try(tkgrab.release(ttThresholdDelta));Try(tkfocus(.affylmGUIglobals$ttMain));return(0)}))
Try(tkwait.window(ttThresholdDelta))
Try(tkfocus(.affylmGUIglobals$ttMain))
if(affylmGUIenvironment$ThresholdDelta=="Unselected"){
Try(tkmessageBox(title="Delta threshold",message="Since no DELTA threshold was selected the analysis is aborted."))
Try(return())
}
Try(delta <- as.numeric(affylmGUIenvironment$ThresholdDelta))
Try(plot(sam.out, delta))
Try(tkmessageBox(title="siggenes analysis",message="Check the results plot on the main R window!."))
Try(sum.sam.out <- summary(sam.out, delta, entrez = FALSE))
Try(table1 <- sum.sam.out@mat.sig[,2:6])
Try(table1$R.fold <- log2(table1$R.fold))
Try(names(table1)[5] <- "log2.R.fold")
Try(table1 <- signif(table1,2))
} else Try(return())
######################Selecting fc threshold
Try(ttThresholdFC<-tktoplevel(.affylmGUIglobals$ttMain))
Try(tkwm.deiconify(ttThresholdFC))
Try(tkgrab.set(ttThresholdFC))
Try(tkfocus(ttThresholdFC))
Try(tkwm.title(ttThresholdFC,"|FC| threshold"))
Try(tkgrid(tklabel(ttThresholdFC,text=" ")))
Try(ThresholdFC <- "")
Try(Local.FileName <- tclVar(init=ThresholdFC))
Try(entry.FileName <-tkentry(ttThresholdFC,width="10",font=.affylmGUIglobals$affylmGUIfont2,textvariable=Local.FileName,bg="white"))
Try(tkgrid(tklabel(ttThresholdFC,text="Please enter the log2 absolute \nFold Change threshold of your choice",font=.affylmGUIglobals$affylmGUIfont2)))
Try(tkgrid(entry.FileName))
onOK <- function()
{
Try(ThresholdFC <- tclvalue(Local.FileName))
if(nchar(ThresholdFC)==0)
Try(ThresholdFC <- 0)
Try(assign("ThresholdFC",ThresholdFC,affylmGUIenvironment))
Try(tclvalue(.affylmGUIglobals$ThresholdFCTcl) <- ThresholdFC)
Try(tkgrab.release(ttThresholdFC));Try(tkdestroy(ttThresholdFC));Try(tkfocus(.affylmGUIglobals$ttMain))
}
Try(OK.but <-tkbutton(ttThresholdFC,text=" OK ",command=onOK,font=.affylmGUIglobals$affylmGUIfont2))
Try(tkgrid(tklabel(ttThresholdFC,text=" ")))
Try(tkgrid(OK.but))
Try(tkgrid.configure(OK.but))
Try(tkgrid(tklabel(ttThresholdFC,text=" ")))
Try(tkfocus(entry.FileName))
Try(tkbind(entry.FileName, "<Return>",onOK))
Try(tkbind(ttThresholdFC, "<Destroy>", function(){Try(tkgrab.release(ttThresholdFC));Try(tkfocus(.affylmGUIglobals$ttMain));return(0)}))
Try(tkwait.window(ttThresholdFC))
Try(tkfocus(.affylmGUIglobals$ttMain))
Try(fold.change <- as.numeric(affylmGUIenvironment$ThresholdFC))
Try(table1 <- table1[which(abs(table1[,5]) >= fold.change),])
###############################################################adding annotation
getDataEnv <- function(name, lib) {
get(paste(lib, name, sep = ""), mode = "environment")
}
Try(whichArrayPlatform <- get("whichArrayPlatform", envir=affylmGUIenvironment))
if((whichArrayPlatform == "AFFY" || whichArrayPlatform == "LARGE" || whichArrayPlatform == "GENE") & .annotation(NormalizedAffyData)!=""){
Try(annLib <- .annotation(NormalizedAffyData))
if(annLib=="mogene10stv1"){
Try(annLib <- "mogene10sttranscriptcluster")
}
if(annLib=="hugene10stv1"){
Try(annLib <- "hugene10sttranscriptcluster")
}
if(length(as.character(unlist(strsplit(annLib, "\\.")))) < 2){
Try(annLib <- paste(annLib, ".db", sep=""))
}
Try(require(annLib, character.only = TRUE) || stop("need data package: ", annLib))
# Try(require("annotate", character.only = TRUE) || stop("need data package: annotate"))
#Try(geneNames <- as.character(unlist(mget(rownames(table1)), env=getDataEnv("ENTREZID", annLib), ifnotfound=NA))))
Try(annlib1 <- as.character(unlist(strsplit(annLib, ".db"))))
Try(geneNames <- lookUp(as.character(rownames(table1)), annlib1, "ENTREZID"))
Try(geneNames.n <- names(geneNames))
Try(geneNames <- as.character(unlist(geneNames)))
Try(names(geneNames) <- geneNames.n)
Try(geneNames <- geneNames[order(names(geneNames))])
#Try(geneSymbols <- as.character(unlist(mget(rownames(table1)), env=getDataEnv("SYMBOL", annLib), ifnotfound=NA))))
Try(geneSymbols <- lookUp(as.character(rownames(table1)), annlib1, "SYMBOL"))
Try(geneSymbols.n <- names(geneSymbols))
Try(geneSymbols <- as.character(unlist(geneSymbols)))
Try(names(geneSymbols) <- geneSymbols.n)
Try(geneSymbols.n <- names(geneSymbols))
Try(geneSymbols <- geneSymbols[order(names(geneSymbols))])
Try(table1 <- table1[order(rownames(table1)),])
#Try(require(annLib, character.only = TRUE) || stop("need data package: ", annlib))
#Try(geneNames <- as.character(unlist(mget(rownames(table1), env=getDataEnv("ENTREZID", annLib), ifnotfound=NA))))
#Try(geneSymbols <- as.character(unlist(mget(rownames(table1), env=getDataEnv("SYMBOL", annLib), ifnotfound=NA))))
Try(genelist <- cbind(as.matrix(rownames(table1)),as.matrix(geneNames),as.matrix(geneSymbols)))
Try(colnames(genelist) <- c("AffyID","EG","Symbol"))
if(identical(as.character(genelist[,1]), as.character(rownames(table1)))){
Try(table1 <- cbind(genelist, table1))
}
} else {
Try(geneNames <- rep("-", dim(table1)[1]))
Try(geneSymbols <- rep("-", dim(table1)[1]))
Try(genelist <- cbind(as.matrix(rownames(table1)),as.matrix(geneNames),as.matrix(geneSymbols)))
Try(colnames(genelist) <- c("AffyID","EG","Symbol"))
Try(table1 <- cbind(genelist, table1))
}
###############################################################
Try(tkmessageBox(title="siggenes analysis",message=paste(dim(table1)[1],"genes are found differentially expressed genes \nwith absolute FC >=",fold.change, "within the set of genes belonging to a delta of", delta, sep=" ")))
SaveTopTable <- function()
{
Try(FileName <- tclvalue(tkgetSaveFile(initialfile=paste("siggene.output.with.delta.",delta,".xls",sep=""),filetypes="{{Tab-Delimited Text Files} {.txt .xls}} {{All files} *}")))
Try(if(!nchar(FileName))
return())
#Try(write.table(table1,file=FileName,quote=FALSE,col.names=NA,sep="\t"))
Try(write.table(table1,file=FileName,quote=FALSE,row.names=F,sep="\t"))
}
Try(tkconfigure(.affylmGUIglobals$ttMain,cursor="watch"))
Try(tempfile1 <- tempfile())
#write.table(table1,file=tempfile1,quote=FALSE,col.names=NA,sep="\t")
Try(write.table(table1,file=tempfile1,quote=FALSE,row.names=F,sep="\t"))
ttToptableTable <- tktoplevel(.affylmGUIglobals$ttMain)
tkwm.title(ttToptableTable,paste(dim(table1)[1],"genes were found differentially expressed using a delta= ", delta,"and a |FC| threshold=",fold.change, sep=" "))
xscr <-tkscrollbar(ttToptableTable, repeatinterval=5,orient="horizontal", command=function(...)tkxview(txt,...))
scr <- tkscrollbar(ttToptableTable, repeatinterval=5, command=function(...)tkyview(txt,...))
txt <- tktext(ttToptableTable, bg="white", font="courier",xscrollcommand=function(...)tkset(xscr,...), yscrollcommand=function(...)tkset(scr,...),wrap="none",width=100)
tkpack(scr, side="right", fill="y")
tkpack(xscr, side="bottom", fill="x")
tkpack(txt, side="left", fill="both", expand="yes")
chn <- tclvalue(tclopen( tempfile1))
tkinsert(txt, "end", tclvalue(tclread( chn)))
tclclose( chn)
tkconfigure(txt, state="disabled")
tkmark.set(txt,"insert","0.0")
tkfocus(txt)
tkconfigure(.affylmGUIglobals$ttMain,cursor="arrow")
topMenu2 <- tkmenu(ttToptableTable)
tkconfigure(ttToptableTable, menu=topMenu2)
fileMenu2 <- tkmenu(topMenu2, tearoff=FALSE)
tkadd(fileMenu2, "command", label="Save As", command=SaveTopTable) # ) # ,font=affylmGUIfontMenu)
tkadd(fileMenu2, "command", label="Close", command=function() tkdestroy(ttToptableTable)) # ) # ,font=affylmGUIfontMenu)
tkadd(topMenu2, "cascade", label="File", menu=fileMenu2) # ,font=affylmGUIfontMenu)
Try(tkconfigure(.affylmGUIglobals$ttMain,cursor="arrow"))
} else if (length(target.unique) > 2){
#groups definition
Try(tkmessageBox(title="siggenes analysis",message="Multi class unpaired case analysis not implemented, yet."))
#Try(for(i in 2:length(target.unique)){
# cl[which(targets==target.unique[i]) <- i-1
#})
#Try(sam.out <- sam(NormalizedAffyData, cl, rand = 1234567, gene.names = featureNames(NormalizedAffyData)))
#Try(tkmessageBox(title="siggenes analysis",message="Check the delta table on the main R window!."))
} else {Try(tkmessageBox(title="siggenes analysis",message="One class analysis not implemented!"))}
}
################writing the results in a tcl/tk table
".print.TclTk.table" <- function(mytable){
SaveTopTable <- function(mytable)
{
Try(FileName <- tclvalue(tkgetSaveFile(initialfile=paste("siggene.output.xls",sep=""),filetypes="{{Tab-Delimited Text Files} {.txt .xls}} {{All files} *}")))
Try(if(!nchar(FileName))
return())
Try(write.table(mytable,file=FileName,quote=FALSE,col.names=NA,sep="\t"))
}
}
################################################################################
#this functionis made to run RankProd analysis
#in the present implementation only same origin data can be considered
#the target format has the experiment covariate linked to its origin by an _
#the origin should be numeric
#ctrl_1
#ctrl_1
#ctrl_2
#ctrl_2
#trt_1
#trt_1
#trt_2
#trt_2
"rankProd" <- function(){
# require(RankProd) || stop("library RankProd could not be found !")
#error if no data are loaded
Try(whichArrayPlatform <- get("whichArrayPlatform",envir=affylmGUIenvironment))
if(whichArrayPlatform ==""){
Try(tkmessageBox(title="RankProd analysis",message="No arrays have been loaded. Please try New or Open from the File menu.",type="ok",icon="error"))
Try(tkfocus(.affylmGUIglobals$ttMain))
Try(return())
}
if(whichArrayPlatform=="AFFY"){
if(!affylmGUIenvironment$NormalizedAffyData.Available)
{
Try(tkmessageBox(title="Rank Product analysis",message="Probe set summary is not available!\nNext menu will give options for probe set summarization", type="ok", icon="info"))
Try(NormalizeNow())
Try(tkconfigure(.affylmGUIglobals$ttMain,cursor="watch"))
Try(NormalizedAffyData <- get("NormalizedAffyData",envir=affylmGUIenvironment))
Try(tkconfigure(.affylmGUIglobals$ttMain,cursor="arrow"))
}
}
if(whichArrayPlatform=="NGS"){
if(!affylmGUIenvironment$NGSconversion.available)
{
Try(tkmessageBox(title="Rank Product analysis",message="Rank or log2 conversion of the data counts are not made, yet!\nThe two conversion options are available in the Reformat NGS menu.", type="ok", icon="info"))
Try(tkconfigure(.affylmGUIglobals$ttMain,cursor="arrow"))
Try(return())
}
}
#########################
Try(tkconfigure(.affylmGUIglobals$ttMain,cursor="watch"))
Try(targets <- affylmGUIenvironment$Targets$Target)
Try(targets <- strsplit(targets, "_"))
Try(targets <- t(as.data.frame(targets)))
if(dim(targets)[2]==1){
Try(target.unique <- unique(targets[,1]))
Try(cl <- rep(0,dim(targets)[1]))
Try(cl[which(targets[,1]==target.unique[2])] <- 1)
Try(origin <- rep(1,dim(targets)[1]))
} else if(dim(targets)[2]>1){
Try(target.unique <- unique(targets[,1]))
Try(cl <- rep(0,dim(targets)[1]))
Try(cl[which(targets[,1]==target.unique[2])] <- 1)
Try(origin <- as.numeric(targets[,2]))
} else{
Try(tkmessageBox(title="RankProd analysis",message="The target file is not in the right format!\nCovariates should be linked to their origin (a number) by an underscore.\nIf the origin is only one it is not mandatory to indicate it"))
return()
}
Try(NormalizedAffyData <- get("NormalizedAffyData", env=affylmGUIenvironment))
if(length(target.unique) == 2){
#groups definition
#Try(tkmessageBox(title="RankProd analysis",message="Rank Product analysis for two-class case will be performed."))
Try(cl[which(targets==target.unique[2])] <- 1)
################################
Try(ttIfDialog<-tktoplevel(.affylmGUIglobals$ttMain))
Try(tkwm.deiconify(ttIfDialog))
Try(tkgrab.set(ttIfDialog))
Try(tkfocus(ttIfDialog))
Try(tkwm.title(ttIfDialog,"Selecting the parameters to Run RankProd analysis for two-class case"))
Try(tkgrid(tklabel(ttIfDialog,text=" ")))
Try(frame1 <- tkframe(ttIfDialog,relief="groove",borderwidth=2))
Try(HowManyQuestion1 <- tklabel(frame1,text="Number of permutations",font=.affylmGUIglobals$affylmGUIfont2))
Try(tkgrid(HowManyQuestion1))
Try(tkgrid.configure(HowManyQuestion1,columnspan=2,sticky="w"))
Try(permutationsTcl <- tclVar("100"))
Try(I1.but <- tkradiobutton(frame1,text="50",variable=permutationsTcl,value="50",font=.affylmGUIglobals$affylmGUIfont2))
Try(I2.but <- tkradiobutton(frame1,text="100",variable=permutationsTcl,value="100",font=.affylmGUIglobals$affylmGUIfont2))
Try(I3.but <- tkradiobutton(frame1,text="250",variable=permutationsTcl,value="250",font=.affylmGUIglobals$affylmGUIfont2))
Try(I4.but <- tkradiobutton(frame1,text="500",variable=permutationsTcl,value="500",font=.affylmGUIglobals$affylmGUIfont2))
Try(tkgrid(I1.but,sticky="w"))
Try(tkgrid(I2.but,sticky="w"))
Try(tkgrid(I3.but,sticky="w"))
Try(tkgrid(I4.but,sticky="w"))
Try(tkgrid.configure(HowManyQuestion1,I1.but,I2.but,I3.but,I4.but,sticky="w"))
Try(frame2 <- tkframe(ttIfDialog,relief="groove",borderwidth=2))
Try(cutoffLabel <- tklabel(frame2,text="Cut off threshold",font=.affylmGUIglobals$affylmGUIfont2))
Try(tkgrid(cutoffLabel,sticky="w"))
Try(tkgrid.configure(cutoffLabel,sticky="w"))
Try(cutoffTcl <- tclVar("0.05"))
Try(F1.but <- tkradiobutton(frame2,text="none",variable=cutoffTcl,value="1",font=.affylmGUIglobals$affylmGUIfont2))
Try(F2.but <- tkradiobutton(frame2,text="0.05",variable=cutoffTcl,value="0.05",font=.affylmGUIglobals$affylmGUIfont2))
Try(F3.but <- tkradiobutton(frame2,text="0.01",variable=cutoffTcl,value="0.01",font=.affylmGUIglobals$affylmGUIfont2))
Try(F4.but <- tkradiobutton(frame2,text="0.005",variable=cutoffTcl,value="0.005",font=.affylmGUIglobals$affylmGUIfont2))
Try(F5.but <- tkradiobutton(frame2,text="0.001",variable=cutoffTcl,value="0.001",font=.affylmGUIglobals$affylmGUIfont2))
Try(F6.but <- tkradiobutton(frame2,text="0.0005",variable=cutoffTcl,value="0.0005",font=.affylmGUIglobals$affylmGUIfont2))
Try(tkgrid(F1.but,sticky="w"))
Try(tkgrid(F2.but,sticky="w"))
Try(tkgrid(F3.but,sticky="w"))
Try(tkgrid(F4.but,sticky="w"))
Try(tkgrid(F5.but,sticky="w"))
Try(tkgrid(F6.but,sticky="w"))
Try(tkgrid.configure(cutoffLabel,F1.but,F2.but,F3.but,F4.but,F5.but, F6.but,sticky="w"))
Try(onOK <- function()
{
ReturnVal1 <- as.numeric(tclvalue(permutationsTcl))
ReturnVal2 <- as.numeric(tclvalue(cutoffTcl))
Try(ReturnVal <<- paste(ReturnVal1, ReturnVal2, sep=";"))
Try(tkgrab.release(ttIfDialog))
Try(tkdestroy(ttIfDialog))
Try(tkfocus(.affylmGUIglobals$ttMain))
})
Try(frame3 <- tkframe(ttIfDialog,borderwidth=2))
Try(onCancel <- function() {Try(ReturnVal <<- ""); Try(tkgrab.release(ttIfDialog));Try(tkdestroy(ttIfDialog));Try(tkfocus(.affylmGUIglobals$ttMain))})
Try(OK.but <-tkbutton(frame3,text=" OK ",command=onOK,font=.affylmGUIglobals$affylmGUIfont2))
Try(Cancel.but <-tkbutton(frame3,text=" Cancel ",command=onCancel,font=.affylmGUIglobals$affylmGUIfont2))
Try(tkgrid(tklabel(frame3,text=" "),OK.but,Cancel.but,tklabel(frame3,text=" ")))
Try(tkgrid(tklabel(ttIfDialog,text=" "),frame1,frame2,tklabel(ttIfDialog,text=" ")))
Try(tkgrid(tklabel(ttIfDialog,text=" ")))
Try(tkgrid(tklabel(ttIfDialog,text=" "),frame3,tklabel(ttIfDialog,text=" ")))
Try(tkgrid(tklabel(ttIfDialog,text=" ")))
Try(tkgrid.configure(frame1,frame3,sticky="w"))
Try(tkfocus(ttIfDialog))
Try(tkbind(ttIfDialog, "<Destroy>", function() {Try(tkgrab.release(ttIfDialog));Try(tkfocus(.affylmGUIglobals$ttMain));}))
Try(tkwait.window(ttIfDialog))
if(ReturnVal==""){
Try(tkconfigure(.affylmGUIglobals$ttMain,cursor="arrow"))
return()
}
Try(tmp<-strsplit(ReturnVal, ";"))
permutations= as.numeric(tmp[[1]][1])
threshold= as.numeric(tmp[[1]][2])
################################
if(dim(targets)[2]==1){
Try(RP.out <- RP(exprs(NormalizedAffyData), cl, num.perm = permutations, logged = TRUE, na.rm = FALSE, plot = FALSE, rand = 1234567, gene.names = featureNames(NormalizedAffyData)))
}else if(dim(targets)[2]==2){
Try(RP.out <- RPadvance(exprs(NormalizedAffyData), cl, origin, num.perm = permutations, logged = TRUE, na.rm = FALSE, plot = FALSE, rand = 1234567, gene.names = featureNames(NormalizedAffyData)))
}
Try( mytop <- topGene(RP.out, cutoff = threshold, method = "pfp", logged = TRUE, logbase = 2, gene.names = featureNames(NormalizedAffyData)))
Try(tmpRes <- paste("log2FC of ",dim(mytop[[1]])[1]," genes in ",target.unique[1]," < ",target.unique[2]," and ",dim(mytop[[2]])[1]," genes in ",target.unique[1], " > ",target.unique[2], sep=""))
Try(mbVal <- tkmessageBox(title="RankProd analysis", message=paste(dim(mytop[[1]])[1]," genes in ",target.unique[1]," < ",target.unique[2]," and ",dim(mytop[[2]])[1]," genes in ",target.unique[1], " > ",target.unique[2],"\nIf you are satisfied press YES to save the results.", sep=""),
icon="question",type="yesno",default="yes"
)#end of tkmessageBox
)#end of Try(mbVal..
if(tclvalue(mbVal)=="yes"){
Try( table1 <- mytop[[1]])
Try(tmpFC <- -log2(table1[,3]))
Try( table1[,3] <- tmpFC)
Try( table2 <- mytop[[2]])
Try(tmpFC <- -log2(table2[,3]))
Try( table2[,3] <- tmpFC)
Try( mytop <- rbind(table1, table2))
Try( dimnames(mytop)[[2]][3] <- tmpRes)
Try(mytop <- as.data.frame(mytop))
#rownames are changing after
Try(mytop <- mytop[order(rownames(mytop)),])
###############################################################adding annotation
#getDataEnv <- function(name, lib) {
# get(paste(lib, name, sep = ""), mode = "environment")
#}
Try(whichArrayPlatform <- get("whichArrayPlatform", envir=affylmGUIenvironment))
if((whichArrayPlatform == "AFFY" || whichArrayPlatform == "LARGE" || whichArrayPlatform == "ILLU" || whichArrayPlatform == "GENE") & .annotation(NormalizedAffyData)!=""){
Try(annLib <- .annotation(NormalizedAffyData))
if(annLib=="mogene10stv1"){
Try(annLib <- "mogene10sttranscriptcluster")
}
if(annLib=="hugene10stv1"){
Try(annLib <- "hugene10sttranscriptcluster")
}
if(annLib !=""){
Try(annlib1 <- as.character(unlist(strsplit(annLib, "\\."))))
if(length(annlib1) < 2) annLib <- paste(annLib, ".db", sep="")
Try(require(annLib, character.only = TRUE) || stop("need data package: ", annLib))
# Try(require("annotate", character.only = TRUE) || stop("need data package: annotate"))
}
#Try(geneNames <- as.character(unlist(mget(as.character(rownames(mytop)), env=getDataEnv("ENTREZID", annLib), ifnotfound=NA))))
if(annLib=="ath1121501.db"){
Try(annlib <- as.character(unlist(strsplit(annLib, ".db"))))
Try(geneNames <- lookUp(featureNames(NormalizedAffyData), annlib, "ACCNUM"))
Try(geneNames.n <- names(geneNames))
Try(geneNames <- as.character(unlist(geneNames)))
Try(names(geneNames) <- geneNames.n)
#Try(geneSymbols <- as.character(unlist(mget(featureNames(NormalizedAffyData), env=getDataEnv("SYMBOL", annLib), ifnotfound=NA))))
Try(geneSymbols <- lookUp(featureNames(NormalizedAffyData), annlib, "SYMBOL"))
Try(geneSymbols.n <- names(geneSymbols))
Try(geneSymbols <- as.character(unlist(geneSymbols)))
Try(names(geneSymbols) <- geneSymbols.n)
if(length(geneNames)!=length(geneSymbols)){
common <- intersect(names(geneNames),names(geneSymbols))
geneSymbols <- geneSymbols[which(names(geneSymbols) %in% common)]
if(!identical(names(geneSymbols), names(geneNames))){
geneSymbols <- rep(NA, length(geneNames))
names(geneSymbols) <- names(geneNames)
}
}
}else if(annLib=="yeast2.db"){
Try(annlib <- as.character(unlist(strsplit(annLib, ".db"))))
Try(geneNames <- as.character(unlist(mget(featureNames(NormalizedAffyData), env=getDataEnv("ORF", annLib), ifnotfound=NA))))
Try(geneSymbols <- as.character(unlist(mget(featureNames(NormalizedAffyData), env=getDataEnv("GENENAME", annLib), ifnotfound=NA))))
}else if(annLib==""){
Try(NormalizedAffyData <- get("NormalizedAffyData",envir=affylmGUIenvironment))
Try(genelist <- data.frame(ID=I(featureNames(NormalizedAffyData))))
Try(geneNames <- get("geneNames",envir=affylmGUIenvironment))#eg
Try(geneSymbols <- get("geneSymbols",envir=affylmGUIenvironment))#symbol
Try(tkconfigure(.affylmGUIglobals$ttMain,cursor="watch"))
Try(geneNames <- rep("-", dim(genelist)[1]))
Try(geneSymbols <- rep("-", dim(genelist)[1]))
Try(tkconfigure(.affylmGUIglobals$ttMain,cursor="arrow"))
Try(genelist <- cbind(as.matrix(featureNames(NormalizedAffyData)),as.matrix(geneNames),as.matrix(geneSymbols)))
Try(colnames(genelist) <- c("geneID","EG","SYMBOL"))
}else {
Try(annlib <- as.character(unlist(strsplit(annLib, ".db"))))
Try(geneNames <- lookUp(as.character(rownames(mytop)), annlib, "ENTREZID"))
Try(geneNames.n <- names(geneNames))
Try(geneNames <- as.character(unlist(geneNames)))
Try(names(geneNames) <- geneNames.n)
Try(geneNames <- geneNames[order(names(geneNames))])
#Try(geneSymbols <- as.character(unlist(mget(as.character(rownames(mytop)), env=getDataEnv("SYMBOL", annLib), ifnotfound=NA))))
Try(geneSymbols <- lookUp(as.character(rownames(mytop)), annlib, "SYMBOL"))
Try(geneSymbols.n <- names(geneSymbols))
Try(geneSymbols <- as.character(unlist(geneSymbols)))
Try(names(geneSymbols) <- geneSymbols.n)
Try(geneSymbols.n <- names(geneSymbols))
Try(geneSymbols <- geneSymbols[order(names(geneSymbols))])
}
geneNames <- geneNames[which(names(geneNames) %in% rownames(mytop))]
geneSymbols <- geneSymbols[which(names(geneSymbols) %in% rownames(mytop))]
if(!identical(names(geneNames), rownames(mytop))){
Try(tkmessageBox(title="RankProd analysis",message="Internal error 1001. Contact oneChannelGUI mantainer!"))
return()
}
Try(genelist <- cbind(as.matrix(rownames(mytop)),as.matrix(geneNames),as.matrix(geneSymbols)))
Try(colnames(genelist) <- c("AffyID","EG","Symbol"))
Try(mytop <- cbind(genelist, mytop))
} else {
Try(geneNames <- rep("-", dim(mytop)[1]))
Try(geneSymbols <- rep("-", dim(mytop)[1]))
Try(genelist <- cbind(as.matrix(rownames(mytop)),as.matrix(geneNames),as.matrix(geneSymbols)))
Try(colnames(genelist) <- c("AffyID","EG","Symbol"))
Try(mytop <- cbind(genelist, mytop))
}
###############################################################
SaveTopTable <- function()
{
Try(FileName <- tclvalue(tkgetSaveFile(initialfile=paste("RankProd.output.with.cutoff.",threshold,".xls",sep=""),filetypes="{{Tab-Delimited Text Files} {.txt .xls}} {{All files} *}")))
Try(if(!nchar(FileName))
return())
#Try(write.table(mytop,file=FileName,quote=FALSE,col.names=NA,sep="\t"))
Try(write.table(mytop,file=FileName,quote=FALSE,row.names=F,sep="\t"))
}
Try(SaveTopTable())
} else if(tclvalue(mbVal)=="no"){
Try(tkfocus(.affylmGUIglobals$ttMain))
Try(tkconfigure(.affylmGUIglobals$ttMain,cursor="arrow"))
return()
}
} else if (length(target.unique) > 2){
#groups definition
Try(tkmessageBox(title="RankProd analysis",message="Multi class unpaired case analysis not implemented, yet."))
} else {Try(tkmessageBox(title="RankProd analysis",message="One class analysis not implemented!"))}
Try(tkconfigure(.affylmGUIglobals$ttMain,cursor="arrow"))
}
################################################################################
Try the oneChannelGUI package in your browser
Any scripts or data that you put into this service are public.
oneChannelGUI documentation built on Nov. 17, 2017, 11:02 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
#set of functions, directly/indirectly involved, in oneChannelGUI Permutation stat Menu
#oneChannelGUI siggenes running SAM for two group unpaired test
#contains oneChannelGUI SaveTopTable called inside the function
#oneChannelGUI rankProd running RankProd for two group unpaired test considering also the differnet origin of the data
#contains oneChannelGUI SaveTopTable called inside the function
#################################################################################
#this functionis made to run SAM analysis on Bioconductor
"siggenes" <- function(){
#require(siggenes) || stop("library siggenes could not be found !")
#error if no data are loaded
Try(whichArrayPlatform <- get("whichArrayPlatform",envir=affylmGUIenvironment))
if(whichArrayPlatform ==""){
Try(tkmessageBox(title="SAM analysis",message="No arrays have been loaded. Please try New or Open from the File menu.",type="ok",icon="error"))
Try(tkfocus(.affylmGUIglobals$ttMain))
Try(return())
}
if(whichArrayPlatform=="AFFY"){
if(!affylmGUIenvironment$NormalizedAffyData.Available)
{
Try(tkmessageBox(title="SAM analysis",message="Probe set summary is not available!\nNext menu will give options for probe set summarization", type="ok", icon="info"))
Try(NormalizeNow())
Try(tkconfigure(.affylmGUIglobals$ttMain,cursor="watch"))
Try(NormalizedAffyData <- get("NormalizedAffyData",envir=affylmGUIenvironment))
Try(tkconfigure(.affylmGUIglobals$ttMain,cursor="arrow"))
}
}
#########################
Try(targets <- affylmGUIenvironment$Targets$Target)
Try(NormalizedAffyData <- get("NormalizedAffyData", env=affylmGUIenvironment))
Try(target.unique <- unique(targets))
Try(cl <- rep(0,length(targets)))
if(length(target.unique) == 2){
#groups definition
Try(tkmessageBox(title="siggenes analysis",message="Two-Class unpaired case analysis will be performed."))
Try(cl[which(targets==target.unique[2])] <- 1)
Try(sam.out <- sam(NormalizedAffyData, cl, rand = 1234567, gene.names = featureNames(NormalizedAffyData)))
SaveTopTable <- function()
{
Try(FileName <- tclvalue(tkgetSaveFile(initialfile=paste("siggene.delta.table.xls",sep=""),filetypes="{{Tab-Delimited Text Files} {.txt .xls}} {{All files} *}")))
Try(if(!nchar(FileName))
return())
Try(write.table(show(sam.out),file=FileName,quote=FALSE,col.names=NA,sep="\t"))
}
Try(tempfile1 <- tempfile())
write.table(show(sam.out),file=tempfile1,quote=FALSE,col.names=NA,sep="\t")
ttToptableTable <- tktoplevel(.affylmGUIglobals$ttMain)
tkwm.title(ttToptableTable,"Delta table")
xscr <-tkscrollbar(ttToptableTable, repeatinterval=5,orient="horizontal", command=function(...)tkxview(txt,...))
scr <- tkscrollbar(ttToptableTable, repeatinterval=5, command=function(...)tkyview(txt,...))
txt <- tktext(ttToptableTable, bg="white", font="courier",xscrollcommand=function(...)tkset(xscr,...), yscrollcommand=function(...)tkset(scr,...),wrap="none",width=100)
tkpack(scr, side="right", fill="y")
tkpack(xscr, side="bottom", fill="x")
tkpack(txt, side="left", fill="both", expand="yes")
chn <- tclvalue(tclopen( tempfile1))
tkinsert(txt, "end", tclvalue(tclread( chn)))
tclclose( chn)
tkconfigure(txt, state="disabled")
tkmark.set(txt,"insert","0.0")
tkfocus(txt)
topMenu2 <- tkmenu(ttToptableTable)
tkconfigure(ttToptableTable, menu=topMenu2)
fileMenu2 <- tkmenu(topMenu2, tearoff=FALSE)
tkadd(fileMenu2, "command", label="Save As", command=SaveTopTable) # ) # ,font=affylmGUIfontMenu)
tkadd(fileMenu2, "command", label="Close", command=function() tkdestroy(ttToptableTable)) # ) # ,font=affylmGUIfontMenu)
tkadd(topMenu2, "cascade", label="File", menu=fileMenu2) # ,font=affylmGUIfontMenu)
######################################################################################
#selecting the delta threshold
#iserire un tasto yes/no altrimenti non si riesce nemmeno a vedere la tabella dei delta
Try(startFun <- tclvalue(tkmessageBox(title="Delta threshold",message="Are you satisfied of the delta table results?",type="yesno",icon="question")))
if (startFun=="yes"){
Try(ttThresholdDelta<-tktoplevel(.affylmGUIglobals$ttMain))
Try(tkwm.deiconify(ttThresholdDelta))
Try(tkgrab.set(ttThresholdDelta))
Try(tkfocus(ttThresholdDelta))
Try(tkwm.title(ttThresholdDelta,"Delta value"))
Try(tkgrid(tklabel(ttThresholdDelta,text=" ")))
Try(ThresholdDelta <- "")
Try(Local.FileName <- tclVar(init=ThresholdDelta))
Try(entry.FileName <-tkentry(ttThresholdDelta,width="10",font=.affylmGUIglobals$affylmGUIfont2,textvariable=Local.FileName,bg="white"))
Try(tkgrid(tklabel(ttThresholdDelta,text="Please enter the DELTA value related \nto the FDR of your choice",font=.affylmGUIglobals$affylmGUIfont2)))
Try(tkgrid(entry.FileName))
onOK <- function()
{
Try(ThresholdDelta <- tclvalue(Local.FileName))
if(nchar(ThresholdDelta)==0)
Try(ThresholdDelta <- "Unselected")
Try(assign("ThresholdDelta",ThresholdDelta,affylmGUIenvironment))
Try(tclvalue(.affylmGUIglobals$ThresholdDeltaTcl) <- ThresholdDelta)
Try(tkgrab.release(ttThresholdDelta));Try(tkdestroy(ttThresholdDelta));Try(tkfocus(.affylmGUIglobals$ttMain))
}
Try(OK.but <-tkbutton(ttThresholdDelta,text=" OK ",command=onOK,font=.affylmGUIglobals$affylmGUIfont2))
# Try(tkgrid(tklabel(ttThresholdDelta,text=" "),OK.but,Cancel.but,tklabel(ttThresholdDelta,text=" ")))
Try(tkgrid(tklabel(ttThresholdDelta,text=" ")))
Try(tkgrid(OK.but))
Try(tkgrid.configure(OK.but))
Try(tkgrid(tklabel(ttThresholdDelta,text=" ")))
Try(tkfocus(entry.FileName))
Try(tkbind(entry.FileName, "<Return>",onOK))
Try(tkbind(ttThresholdDelta, "<Destroy>", function(){Try(tkgrab.release(ttThresholdDelta));Try(tkfocus(.affylmGUIglobals$ttMain));return(0)}))
Try(tkwait.window(ttThresholdDelta))
Try(tkfocus(.affylmGUIglobals$ttMain))
if(affylmGUIenvironment$ThresholdDelta=="Unselected"){
Try(tkmessageBox(title="Delta threshold",message="Since no DELTA threshold was selected the analysis is aborted."))
Try(return())
}
Try(delta <- as.numeric(affylmGUIenvironment$ThresholdDelta))
Try(plot(sam.out, delta))
Try(tkmessageBox(title="siggenes analysis",message="Check the results plot on the main R window!."))
Try(sum.sam.out <- summary(sam.out, delta, entrez = FALSE))
Try(table1 <- sum.sam.out@mat.sig[,2:6])
Try(table1$R.fold <- log2(table1$R.fold))
Try(names(table1)[5] <- "log2.R.fold")
Try(table1 <- signif(table1,2))
} else Try(return())
######################Selecting fc threshold
Try(ttThresholdFC<-tktoplevel(.affylmGUIglobals$ttMain))
Try(tkwm.deiconify(ttThresholdFC))
Try(tkgrab.set(ttThresholdFC))
Try(tkfocus(ttThresholdFC))
Try(tkwm.title(ttThresholdFC,"|FC| threshold"))
Try(tkgrid(tklabel(ttThresholdFC,text=" ")))
Try(ThresholdFC <- "")
Try(Local.FileName <- tclVar(init=ThresholdFC))
Try(entry.FileName <-tkentry(ttThresholdFC,width="10",font=.affylmGUIglobals$affylmGUIfont2,textvariable=Local.FileName,bg="white"))
Try(tkgrid(tklabel(ttThresholdFC,text="Please enter the log2 absolute \nFold Change threshold of your choice",font=.affylmGUIglobals$affylmGUIfont2)))
Try(tkgrid(entry.FileName))
onOK <- function()
{
Try(ThresholdFC <- tclvalue(Local.FileName))
if(nchar(ThresholdFC)==0)
Try(ThresholdFC <- 0)
Try(assign("ThresholdFC",ThresholdFC,affylmGUIenvironment))
Try(tclvalue(.affylmGUIglobals$ThresholdFCTcl) <- ThresholdFC)
Try(tkgrab.release(ttThresholdFC));Try(tkdestroy(ttThresholdFC));Try(tkfocus(.affylmGUIglobals$ttMain))
}
Try(OK.but <-tkbutton(ttThresholdFC,text=" OK ",command=onOK,font=.affylmGUIglobals$affylmGUIfont2))
Try(tkgrid(tklabel(ttThresholdFC,text=" ")))
Try(tkgrid(OK.but))
Try(tkgrid.configure(OK.but))
Try(tkgrid(tklabel(ttThresholdFC,text=" ")))
Try(tkfocus(entry.FileName))
Try(tkbind(entry.FileName, "<Return>",onOK))
Try(tkbind(ttThresholdFC, "<Destroy>", function(){Try(tkgrab.release(ttThresholdFC));Try(tkfocus(.affylmGUIglobals$ttMain));return(0)}))
Try(tkwait.window(ttThresholdFC))
Try(tkfocus(.affylmGUIglobals$ttMain))
Try(fold.change <- as.numeric(affylmGUIenvironment$ThresholdFC))
Try(table1 <- table1[which(abs(table1[,5]) >= fold.change),])
###############################################################adding annotation
getDataEnv <- function(name, lib) {
get(paste(lib, name, sep = ""), mode = "environment")
}
Try(whichArrayPlatform <- get("whichArrayPlatform", envir=affylmGUIenvironment))
if((whichArrayPlatform == "AFFY" || whichArrayPlatform == "LARGE" || whichArrayPlatform == "GENE") & .annotation(NormalizedAffyData)!=""){
Try(annLib <- .annotation(NormalizedAffyData))
if(annLib=="mogene10stv1"){
Try(annLib <- "mogene10sttranscriptcluster")
}
if(annLib=="hugene10stv1"){
Try(annLib <- "hugene10sttranscriptcluster")
}
if(length(as.character(unlist(strsplit(annLib, "\\.")))) < 2){
Try(annLib <- paste(annLib, ".db", sep=""))
}
Try(require(annLib, character.only = TRUE) || stop("need data package: ", annLib))
# Try(require("annotate", character.only = TRUE) || stop("need data package: annotate"))
#Try(geneNames <- as.character(unlist(mget(rownames(table1)), env=getDataEnv("ENTREZID", annLib), ifnotfound=NA))))
Try(annlib1 <- as.character(unlist(strsplit(annLib, ".db"))))
Try(geneNames <- lookUp(as.character(rownames(table1)), annlib1, "ENTREZID"))
Try(geneNames.n <- names(geneNames))
Try(geneNames <- as.character(unlist(geneNames)))
Try(names(geneNames) <- geneNames.n)
Try(geneNames <- geneNames[order(names(geneNames))])
#Try(geneSymbols <- as.character(unlist(mget(rownames(table1)), env=getDataEnv("SYMBOL", annLib), ifnotfound=NA))))
Try(geneSymbols <- lookUp(as.character(rownames(table1)), annlib1, "SYMBOL"))
Try(geneSymbols.n <- names(geneSymbols))
Try(geneSymbols <- as.character(unlist(geneSymbols)))
Try(names(geneSymbols) <- geneSymbols.n)
Try(geneSymbols.n <- names(geneSymbols))
Try(geneSymbols <- geneSymbols[order(names(geneSymbols))])
Try(table1 <- table1[order(rownames(table1)),])
#Try(require(annLib, character.only = TRUE) || stop("need data package: ", annlib))
#Try(geneNames <- as.character(unlist(mget(rownames(table1), env=getDataEnv("ENTREZID", annLib), ifnotfound=NA))))
#Try(geneSymbols <- as.character(unlist(mget(rownames(table1), env=getDataEnv("SYMBOL", annLib), ifnotfound=NA))))
Try(genelist <- cbind(as.matrix(rownames(table1)),as.matrix(geneNames),as.matrix(geneSymbols)))
Try(colnames(genelist) <- c("AffyID","EG","Symbol"))
if(identical(as.character(genelist[,1]), as.character(rownames(table1)))){
Try(table1 <- cbind(genelist, table1))
}
} else {
Try(geneNames <- rep("-", dim(table1)[1]))
Try(geneSymbols <- rep("-", dim(table1)[1]))
Try(genelist <- cbind(as.matrix(rownames(table1)),as.matrix(geneNames),as.matrix(geneSymbols)))
Try(colnames(genelist) <- c("AffyID","EG","Symbol"))
Try(table1 <- cbind(genelist, table1))
}
###############################################################
Try(tkmessageBox(title="siggenes analysis",message=paste(dim(table1)[1],"genes are found differentially expressed genes \nwith absolute FC >=",fold.change, "within the set of genes belonging to a delta of", delta, sep=" ")))
SaveTopTable <- function()
{
Try(FileName <- tclvalue(tkgetSaveFile(initialfile=paste("siggene.output.with.delta.",delta,".xls",sep=""),filetypes="{{Tab-Delimited Text Files} {.txt .xls}} {{All files} *}")))
Try(if(!nchar(FileName))
return())
#Try(write.table(table1,file=FileName,quote=FALSE,col.names=NA,sep="\t"))
Try(write.table(table1,file=FileName,quote=FALSE,row.names=F,sep="\t"))
}
Try(tkconfigure(.affylmGUIglobals$ttMain,cursor="watch"))
Try(tempfile1 <- tempfile())
#write.table(table1,file=tempfile1,quote=FALSE,col.names=NA,sep="\t")
Try(write.table(table1,file=tempfile1,quote=FALSE,row.names=F,sep="\t"))
ttToptableTable <- tktoplevel(.affylmGUIglobals$ttMain)
tkwm.title(ttToptableTable,paste(dim(table1)[1],"genes were found differentially expressed using a delta= ", delta,"and a |FC| threshold=",fold.change, sep=" "))
xscr <-tkscrollbar(ttToptableTable, repeatinterval=5,orient="horizontal", command=function(...)tkxview(txt,...))
scr <- tkscrollbar(ttToptableTable, repeatinterval=5, command=function(...)tkyview(txt,...))
txt <- tktext(ttToptableTable, bg="white", font="courier",xscrollcommand=function(...)tkset(xscr,...), yscrollcommand=function(...)tkset(scr,...),wrap="none",width=100)
tkpack(scr, side="right", fill="y")
tkpack(xscr, side="bottom", fill="x")
tkpack(txt, side="left", fill="both", expand="yes")
chn <- tclvalue(tclopen( tempfile1))
tkinsert(txt, "end", tclvalue(tclread( chn)))
tclclose( chn)
tkconfigure(txt, state="disabled")
tkmark.set(txt,"insert","0.0")
tkfocus(txt)
tkconfigure(.affylmGUIglobals$ttMain,cursor="arrow")
topMenu2 <- tkmenu(ttToptableTable)
tkconfigure(ttToptableTable, menu=topMenu2)
fileMenu2 <- tkmenu(topMenu2, tearoff=FALSE)
tkadd(fileMenu2, "command", label="Save As", command=SaveTopTable) # ) # ,font=affylmGUIfontMenu)
tkadd(fileMenu2, "command", label="Close", command=function() tkdestroy(ttToptableTable)) # ) # ,font=affylmGUIfontMenu)
tkadd(topMenu2, "cascade", label="File", menu=fileMenu2) # ,font=affylmGUIfontMenu)
Try(tkconfigure(.affylmGUIglobals$ttMain,cursor="arrow"))
} else if (length(target.unique) > 2){
#groups definition
Try(tkmessageBox(title="siggenes analysis",message="Multi class unpaired case analysis not implemented, yet."))
#Try(for(i in 2:length(target.unique)){
# cl[which(targets==target.unique[i]) <- i-1
#})
#Try(sam.out <- sam(NormalizedAffyData, cl, rand = 1234567, gene.names = featureNames(NormalizedAffyData)))
#Try(tkmessageBox(title="siggenes analysis",message="Check the delta table on the main R window!."))
} else {Try(tkmessageBox(title="siggenes analysis",message="One class analysis not implemented!"))}
}
################writing the results in a tcl/tk table
".print.TclTk.table" <- function(mytable){
SaveTopTable <- function(mytable)
{
Try(FileName <- tclvalue(tkgetSaveFile(initialfile=paste("siggene.output.xls",sep=""),filetypes="{{Tab-Delimited Text Files} {.txt .xls}} {{All files} *}")))
Try(if(!nchar(FileName))
return())
Try(write.table(mytable,file=FileName,quote=FALSE,col.names=NA,sep="\t"))
}
}
################################################################################
#this functionis made to run RankProd analysis
#in the present implementation only same origin data can be considered
#the target format has the experiment covariate linked to its origin by an _
#the origin should be numeric
#ctrl_1
#ctrl_1
#ctrl_2
#ctrl_2
#trt_1
#trt_1
#trt_2
#trt_2
"rankProd" <- function(){
# require(RankProd) || stop("library RankProd could not be found !")
#error if no data are loaded
Try(whichArrayPlatform <- get("whichArrayPlatform",envir=affylmGUIenvironment))
if(whichArrayPlatform ==""){
Try(tkmessageBox(title="RankProd analysis",message="No arrays have been loaded. Please try New or Open from the File menu.",type="ok",icon="error"))
Try(tkfocus(.affylmGUIglobals$ttMain))
Try(return())
}
if(whichArrayPlatform=="AFFY"){
if(!affylmGUIenvironment$NormalizedAffyData.Available)
{
Try(tkmessageBox(title="Rank Product analysis",message="Probe set summary is not available!\nNext menu will give options for probe set summarization", type="ok", icon="info"))
Try(NormalizeNow())
Try(tkconfigure(.affylmGUIglobals$ttMain,cursor="watch"))
Try(NormalizedAffyData <- get("NormalizedAffyData",envir=affylmGUIenvironment))
Try(tkconfigure(.affylmGUIglobals$ttMain,cursor="arrow"))
}
}
if(whichArrayPlatform=="NGS"){
if(!affylmGUIenvironment$NGSconversion.available)
{
Try(tkmessageBox(title="Rank Product analysis",message="Rank or log2 conversion of the data counts are not made, yet!\nThe two conversion options are available in the Reformat NGS menu.", type="ok", icon="info"))
Try(tkconfigure(.affylmGUIglobals$ttMain,cursor="arrow"))
Try(return())
}
}
#########################
Try(tkconfigure(.affylmGUIglobals$ttMain,cursor="watch"))
Try(targets <- affylmGUIenvironment$Targets$Target)
Try(targets <- strsplit(targets, "_"))
Try(targets <- t(as.data.frame(targets)))
if(dim(targets)[2]==1){
Try(target.unique <- unique(targets[,1]))
Try(cl <- rep(0,dim(targets)[1]))
Try(cl[which(targets[,1]==target.unique[2])] <- 1)
Try(origin <- rep(1,dim(targets)[1]))
} else if(dim(targets)[2]>1){
Try(target.unique <- unique(targets[,1]))
Try(cl <- rep(0,dim(targets)[1]))
Try(cl[which(targets[,1]==target.unique[2])] <- 1)
Try(origin <- as.numeric(targets[,2]))
} else{
Try(tkmessageBox(title="RankProd analysis",message="The target file is not in the right format!\nCovariates should be linked to their origin (a number) by an underscore.\nIf the origin is only one it is not mandatory to indicate it"))
return()
}
Try(NormalizedAffyData <- get("NormalizedAffyData", env=affylmGUIenvironment))
if(length(target.unique) == 2){
#groups definition
#Try(tkmessageBox(title="RankProd analysis",message="Rank Product analysis for two-class case will be performed."))
Try(cl[which(targets==target.unique[2])] <- 1)
################################
Try(ttIfDialog<-tktoplevel(.affylmGUIglobals$ttMain))
Try(tkwm.deiconify(ttIfDialog))
Try(tkgrab.set(ttIfDialog))
Try(tkfocus(ttIfDialog))
Try(tkwm.title(ttIfDialog,"Selecting the parameters to Run RankProd analysis for two-class case"))
Try(tkgrid(tklabel(ttIfDialog,text=" ")))
Try(frame1 <- tkframe(ttIfDialog,relief="groove",borderwidth=2))
Try(HowManyQuestion1 <- tklabel(frame1,text="Number of permutations",font=.affylmGUIglobals$affylmGUIfont2))
Try(tkgrid(HowManyQuestion1))
Try(tkgrid.configure(HowManyQuestion1,columnspan=2,sticky="w"))
Try(permutationsTcl <- tclVar("100"))
Try(I1.but <- tkradiobutton(frame1,text="50",variable=permutationsTcl,value="50",font=.affylmGUIglobals$affylmGUIfont2))
Try(I2.but <- tkradiobutton(frame1,text="100",variable=permutationsTcl,value="100",font=.affylmGUIglobals$affylmGUIfont2))
Try(I3.but <- tkradiobutton(frame1,text="250",variable=permutationsTcl,value="250",font=.affylmGUIglobals$affylmGUIfont2))
Try(I4.but <- tkradiobutton(frame1,text="500",variable=permutationsTcl,value="500",font=.affylmGUIglobals$affylmGUIfont2))
Try(tkgrid(I1.but,sticky="w"))
Try(tkgrid(I2.but,sticky="w"))
Try(tkgrid(I3.but,sticky="w"))
Try(tkgrid(I4.but,sticky="w"))
Try(tkgrid.configure(HowManyQuestion1,I1.but,I2.but,I3.but,I4.but,sticky="w"))
Try(frame2 <- tkframe(ttIfDialog,relief="groove",borderwidth=2))
Try(cutoffLabel <- tklabel(frame2,text="Cut off threshold",font=.affylmGUIglobals$affylmGUIfont2))
Try(tkgrid(cutoffLabel,sticky="w"))
Try(tkgrid.configure(cutoffLabel,sticky="w"))
Try(cutoffTcl <- tclVar("0.05"))
Try(F1.but <- tkradiobutton(frame2,text="none",variable=cutoffTcl,value="1",font=.affylmGUIglobals$affylmGUIfont2))
Try(F2.but <- tkradiobutton(frame2,text="0.05",variable=cutoffTcl,value="0.05",font=.affylmGUIglobals$affylmGUIfont2))
Try(F3.but <- tkradiobutton(frame2,text="0.01",variable=cutoffTcl,value="0.01",font=.affylmGUIglobals$affylmGUIfont2))
Try(F4.but <- tkradiobutton(frame2,text="0.005",variable=cutoffTcl,value="0.005",font=.affylmGUIglobals$affylmGUIfont2))
Try(F5.but <- tkradiobutton(frame2,text="0.001",variable=cutoffTcl,value="0.001",font=.affylmGUIglobals$affylmGUIfont2))
Try(F6.but <- tkradiobutton(frame2,text="0.0005",variable=cutoffTcl,value="0.0005",font=.affylmGUIglobals$affylmGUIfont2))
Try(tkgrid(F1.but,sticky="w"))
Try(tkgrid(F2.but,sticky="w"))
Try(tkgrid(F3.but,sticky="w"))
Try(tkgrid(F4.but,sticky="w"))
Try(tkgrid(F5.but,sticky="w"))
Try(tkgrid(F6.but,sticky="w"))
Try(tkgrid.configure(cutoffLabel,F1.but,F2.but,F3.but,F4.but,F5.but, F6.but,sticky="w"))
Try(onOK <- function()
{
ReturnVal1 <- as.numeric(tclvalue(permutationsTcl))
ReturnVal2 <- as.numeric(tclvalue(cutoffTcl))
Try(ReturnVal <<- paste(ReturnVal1, ReturnVal2, sep=";"))
Try(tkgrab.release(ttIfDialog))
Try(tkdestroy(ttIfDialog))
Try(tkfocus(.affylmGUIglobals$ttMain))
})
Try(frame3 <- tkframe(ttIfDialog,borderwidth=2))
Try(onCancel <- function() {Try(ReturnVal <<- ""); Try(tkgrab.release(ttIfDialog));Try(tkdestroy(ttIfDialog));Try(tkfocus(.affylmGUIglobals$ttMain))})
Try(OK.but <-tkbutton(frame3,text=" OK ",command=onOK,font=.affylmGUIglobals$affylmGUIfont2))
Try(Cancel.but <-tkbutton(frame3,text=" Cancel ",command=onCancel,font=.affylmGUIglobals$affylmGUIfont2))
Try(tkgrid(tklabel(frame3,text=" "),OK.but,Cancel.but,tklabel(frame3,text=" ")))
Try(tkgrid(tklabel(ttIfDialog,text=" "),frame1,frame2,tklabel(ttIfDialog,text=" ")))
Try(tkgrid(tklabel(ttIfDialog,text=" ")))
Try(tkgrid(tklabel(ttIfDialog,text=" "),frame3,tklabel(ttIfDialog,text=" ")))
Try(tkgrid(tklabel(ttIfDialog,text=" ")))
Try(tkgrid.configure(frame1,frame3,sticky="w"))
Try(tkfocus(ttIfDialog))
Try(tkbind(ttIfDialog, "<Destroy>", function() {Try(tkgrab.release(ttIfDialog));Try(tkfocus(.affylmGUIglobals$ttMain));}))
Try(tkwait.window(ttIfDialog))
if(ReturnVal==""){
Try(tkconfigure(.affylmGUIglobals$ttMain,cursor="arrow"))
return()
}
Try(tmp<-strsplit(ReturnVal, ";"))
permutations= as.numeric(tmp[[1]][1])
threshold= as.numeric(tmp[[1]][2])
################################
if(dim(targets)[2]==1){
Try(RP.out <- RP(exprs(NormalizedAffyData), cl, num.perm = permutations, logged = TRUE, na.rm = FALSE, plot = FALSE, rand = 1234567, gene.names = featureNames(NormalizedAffyData)))
}else if(dim(targets)[2]==2){
Try(RP.out <- RPadvance(exprs(NormalizedAffyData), cl, origin, num.perm = permutations, logged = TRUE, na.rm = FALSE, plot = FALSE, rand = 1234567, gene.names = featureNames(NormalizedAffyData)))
}
Try( mytop <- topGene(RP.out, cutoff = threshold, method = "pfp", logged = TRUE, logbase = 2, gene.names = featureNames(NormalizedAffyData)))
Try(tmpRes <- paste("log2FC of ",dim(mytop[[1]])[1]," genes in ",target.unique[1]," < ",target.unique[2]," and ",dim(mytop[[2]])[1]," genes in ",target.unique[1], " > ",target.unique[2], sep=""))
Try(mbVal <- tkmessageBox(title="RankProd analysis", message=paste(dim(mytop[[1]])[1]," genes in ",target.unique[1]," < ",target.unique[2]," and ",dim(mytop[[2]])[1]," genes in ",target.unique[1], " > ",target.unique[2],"\nIf you are satisfied press YES to save the results.", sep=""),
icon="question",type="yesno",default="yes"
)#end of tkmessageBox
)#end of Try(mbVal..
if(tclvalue(mbVal)=="yes"){
Try( table1 <- mytop[[1]])
Try(tmpFC <- -log2(table1[,3]))
Try( table1[,3] <- tmpFC)
Try( table2 <- mytop[[2]])
Try(tmpFC <- -log2(table2[,3]))
Try( table2[,3] <- tmpFC)
Try( mytop <- rbind(table1, table2))
Try( dimnames(mytop)[[2]][3] <- tmpRes)
Try(mytop <- as.data.frame(mytop))
#rownames are changing after
Try(mytop <- mytop[order(rownames(mytop)),])
###############################################################adding annotation
#getDataEnv <- function(name, lib) {
# get(paste(lib, name, sep = ""), mode = "environment")
#}
Try(whichArrayPlatform <- get("whichArrayPlatform", envir=affylmGUIenvironment))
if((whichArrayPlatform == "AFFY" || whichArrayPlatform == "LARGE" || whichArrayPlatform == "ILLU" || whichArrayPlatform == "GENE") & .annotation(NormalizedAffyData)!=""){
Try(annLib <- .annotation(NormalizedAffyData))
if(annLib=="mogene10stv1"){
Try(annLib <- "mogene10sttranscriptcluster")
}
if(annLib=="hugene10stv1"){
Try(annLib <- "hugene10sttranscriptcluster")
}
if(annLib !=""){
Try(annlib1 <- as.character(unlist(strsplit(annLib, "\\."))))
if(length(annlib1) < 2) annLib <- paste(annLib, ".db", sep="")
Try(require(annLib, character.only = TRUE) || stop("need data package: ", annLib))
# Try(require("annotate", character.only = TRUE) || stop("need data package: annotate"))
}
#Try(geneNames <- as.character(unlist(mget(as.character(rownames(mytop)), env=getDataEnv("ENTREZID", annLib), ifnotfound=NA))))
if(annLib=="ath1121501.db"){
Try(annlib <- as.character(unlist(strsplit(annLib, ".db"))))
Try(geneNames <- lookUp(featureNames(NormalizedAffyData), annlib, "ACCNUM"))
Try(geneNames.n <- names(geneNames))
Try(geneNames <- as.character(unlist(geneNames)))
Try(names(geneNames) <- geneNames.n)
#Try(geneSymbols <- as.character(unlist(mget(featureNames(NormalizedAffyData), env=getDataEnv("SYMBOL", annLib), ifnotfound=NA))))
Try(geneSymbols <- lookUp(featureNames(NormalizedAffyData), annlib, "SYMBOL"))
Try(geneSymbols.n <- names(geneSymbols))
Try(geneSymbols <- as.character(unlist(geneSymbols)))
Try(names(geneSymbols) <- geneSymbols.n)
if(length(geneNames)!=length(geneSymbols)){
common <- intersect(names(geneNames),names(geneSymbols))
geneSymbols <- geneSymbols[which(names(geneSymbols) %in% common)]
if(!identical(names(geneSymbols), names(geneNames))){
geneSymbols <- rep(NA, length(geneNames))
names(geneSymbols) <- names(geneNames)
}
}
}else if(annLib=="yeast2.db"){
Try(annlib <- as.character(unlist(strsplit(annLib, ".db"))))
Try(geneNames <- as.character(unlist(mget(featureNames(NormalizedAffyData), env=getDataEnv("ORF", annLib), ifnotfound=NA))))
Try(geneSymbols <- as.character(unlist(mget(featureNames(NormalizedAffyData), env=getDataEnv("GENENAME", annLib), ifnotfound=NA))))
}else if(annLib==""){
Try(NormalizedAffyData <- get("NormalizedAffyData",envir=affylmGUIenvironment))
Try(genelist <- data.frame(ID=I(featureNames(NormalizedAffyData))))
Try(geneNames <- get("geneNames",envir=affylmGUIenvironment))#eg
Try(geneSymbols <- get("geneSymbols",envir=affylmGUIenvironment))#symbol
Try(tkconfigure(.affylmGUIglobals$ttMain,cursor="watch"))
Try(geneNames <- rep("-", dim(genelist)[1]))
Try(geneSymbols <- rep("-", dim(genelist)[1]))
Try(tkconfigure(.affylmGUIglobals$ttMain,cursor="arrow"))
Try(genelist <- cbind(as.matrix(featureNames(NormalizedAffyData)),as.matrix(geneNames),as.matrix(geneSymbols)))
Try(colnames(genelist) <- c("geneID","EG","SYMBOL"))
}else {
Try(annlib <- as.character(unlist(strsplit(annLib, ".db"))))
Try(geneNames <- lookUp(as.character(rownames(mytop)), annlib, "ENTREZID"))
Try(geneNames.n <- names(geneNames))
Try(geneNames <- as.character(unlist(geneNames)))
Try(names(geneNames) <- geneNames.n)
Try(geneNames <- geneNames[order(names(geneNames))])
#Try(geneSymbols <- as.character(unlist(mget(as.character(rownames(mytop)), env=getDataEnv("SYMBOL", annLib), ifnotfound=NA))))
Try(geneSymbols <- lookUp(as.character(rownames(mytop)), annlib, "SYMBOL"))
Try(geneSymbols.n <- names(geneSymbols))
Try(geneSymbols <- as.character(unlist(geneSymbols)))
Try(names(geneSymbols) <- geneSymbols.n)
Try(geneSymbols.n <- names(geneSymbols))
Try(geneSymbols <- geneSymbols[order(names(geneSymbols))])
}
geneNames <- geneNames[which(names(geneNames) %in% rownames(mytop))]
geneSymbols <- geneSymbols[which(names(geneSymbols) %in% rownames(mytop))]
if(!identical(names(geneNames), rownames(mytop))){
Try(tkmessageBox(title="RankProd analysis",message="Internal error 1001. Contact oneChannelGUI mantainer!"))
return()
}
Try(genelist <- cbind(as.matrix(rownames(mytop)),as.matrix(geneNames),as.matrix(geneSymbols)))
Try(colnames(genelist) <- c("AffyID","EG","Symbol"))
Try(mytop <- cbind(genelist, mytop))
} else {
Try(geneNames <- rep("-", dim(mytop)[1]))
Try(geneSymbols <- rep("-", dim(mytop)[1]))
Try(genelist <- cbind(as.matrix(rownames(mytop)),as.matrix(geneNames),as.matrix(geneSymbols)))
Try(colnames(genelist) <- c("AffyID","EG","Symbol"))
Try(mytop <- cbind(genelist, mytop))
}
###############################################################
SaveTopTable <- function()
{
Try(FileName <- tclvalue(tkgetSaveFile(initialfile=paste("RankProd.output.with.cutoff.",threshold,".xls",sep=""),filetypes="{{Tab-Delimited Text Files} {.txt .xls}} {{All files} *}")))
Try(if(!nchar(FileName))
return())
#Try(write.table(mytop,file=FileName,quote=FALSE,col.names=NA,sep="\t"))
Try(write.table(mytop,file=FileName,quote=FALSE,row.names=F,sep="\t"))
}
Try(SaveTopTable())
} else if(tclvalue(mbVal)=="no"){
Try(tkfocus(.affylmGUIglobals$ttMain))
Try(tkconfigure(.affylmGUIglobals$ttMain,cursor="arrow"))
return()
}
} else if (length(target.unique) > 2){
#groups definition
Try(tkmessageBox(title="RankProd analysis",message="Multi class unpaired case analysis not implemented, yet."))
} else {Try(tkmessageBox(title="RankProd analysis",message="One class analysis not implemented!"))}
Try(tkconfigure(.affylmGUIglobals$ttMain,cursor="arrow"))
}
################################################################################
Try the oneChannelGUI package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.