Nothing
R/classificationmenu.R
In oneChannelGUI: A graphical interface designed to facilitate analysis of microarrays and miRNA/RNA-seq data on laptops
Defines functions
pamr.confusion.mod
perm.pamr
perm.pdmclass
#set of functions, directly/indirectly involved, in oneChannelGUI classificationMenu
#oneChannelGUI ML.edesign present in the targetMenu
#oneChannelGUI trainTest running various classification methods
#contains oneChannelGUI SaveClassifier function used to save the set of probe sets to be used as classifier
# oneChannelGUI SaveTopTable called inside the function
###############################################################################
#thish function divide the data in traininig and test set for a specific covariate in the pData
"trainTest" <- function(){
SaveCovar <- function()
{
Try(FileName <- tclvalue(tkgetSaveFile(initialfile="names.phenoData.txt",filetypes="{{Tab-Delimited Text Files} {.txt .xls}} {{All files} *}")))
Try(if(!nchar(FileName)) return())
Try(write.table(names.pData,file=FileName,quote=FALSE,sep="\t", row.names = F))
}
#function used to save the set of probe sets to be used as classifier
SaveClassifier <- function()
{
Try(classifierFileName <- tclvalue(tkgetSaveFile(filetypes="{{Classifier Files} {.txt}} {{All files} *}")))
Try(if(!nchar(classifierFileName)) return())
Try(classifierFileName <- paste(classifierFileName,".txt",sep=""))
Try(write.table(myClassifier,file=classifierFileName,col.names=NA,sep="\t",quote=FALSE,row.names=TRUE))
}
#error if no data are loaded
Try(whichArrayPlatform <- get("whichArrayPlatform",envir=affylmGUIenvironment))
Try(MLdesign <- get("MLdesign",envir=affylmGUIenvironment))
if(whichArrayPlatform ==""){
Try(tkmessageBox(title="Classification 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())
} else if(is.character(MLdesign)){
Try(tkmessageBox(title="Classification analysis",message="You have not reorganized the covariates\nUse the - Create/view clinical parameters - function.",type="ok",icon="error"))
Try(tkfocus(.affylmGUIglobals$ttMain))
Try(return())
}
#########################selecting the covar for classification start
#defining the covariate for the classification
Try(NormalizedAffyData <- get("NormalizedAffyData", env=affylmGUIenvironment))
Try(names.pData <- as.data.frame(names(pData(NormalizedAffyData))))
Try(names(names.pData) <- "labelDescription")
Try(tempfile1 <- tempfile())
write.table(names.pData,file=tempfile1,quote=FALSE, col.names=NA,sep="\t")
ttToptableTable <- tktoplevel(.affylmGUIglobals$ttMain)
tkwm.title(ttToptableTable,"Experiment/clinical covar names")
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=SaveCovar) # ) # ,font=affylmGUIfontMenu)
tkadd(fileMenu2, "command", label="Close", command=function() tkdestroy(ttToptableTable)) # ) # ,font=affylmGUIfontMenu)
tkadd(topMenu2, "cascade", label="File", menu=fileMenu2) # ,font=affylmGUIfontMenu)
###########selecting the covariate for spltting the data set
Try(ttGetCovar<-tktoplevel(.affylmGUIglobals$ttMain))
Try(tkwm.deiconify(ttGetCovar))
Try(tkgrab.set(ttGetCovar))
Try(tkfocus(ttGetCovar))
Try(tkwm.title(ttGetCovar,"N. of Covariate"))
Try(tkgrid(tklabel(ttGetCovar,text=" ")))
Try(CovarText <- "")
Try(Local.Covar <- tclVar(init=CovarText))
Try(entry.Covar <-tkentry(ttGetCovar,width="3",font=.affylmGUIglobals$affylmGUIfont2,textvariable=Local.Covar,bg="white"))
Try(tkgrid(tklabel(ttGetCovar,text="Please enter the N. of the covariate you are interested",font=.affylmGUIglobals$affylmGUIfont2)))
Try(tkgrid(entry.Covar))
# onOK <- function()
# {
# Try(CovarText <- tclvalue(Local.Covar))
# if(nchar(CovarText)==0) {CovarText <- ""}
# Try(assign("CovarText",CovarText,affylmGUIenvironment))
# Try(tclvalue(.affylmGUIglobals$CovarTcl) <- CovarText)
# Try(tkgrab.release(ttGetCovar));Try(tkdestroy(ttGetCovar));Try(tkfocus(.affylmGUIglobals$ttMain))
# }
Try(
onOK <- function() {
Try(CovarText <<- tclvalue(Local.Covar))
Try(tkgrab.release(ttGetCovar))
Try(tkdestroy(ttGetCovar))
Try(tkfocus(.affylmGUIglobals$ttMain))
}
)
Try(OK.but <-tkbutton(ttGetCovar,text=" OK ",command=onOK,font=.affylmGUIglobals$affylmGUIfont2))
Try(tkgrid(tklabel(ttGetCovar,text=" ")))
Try(tkgrid(OK.but))
Try(tkgrid.configure(OK.but))
Try(tkgrid(tklabel(ttGetCovar,text=" ")))
Try(tkfocus(entry.Covar))
Try(tkbind(entry.Covar, "<Return>",onOK))
Try(tkbind(ttGetCovar, "<Destroy>", function(){Try(tkgrab.release(ttGetCovar));Try(tkfocus(.affylmGUIglobals$ttMain));return(0)}))
Try(tkwait.window(ttGetCovar))
Try(tkfocus(.affylmGUIglobals$ttMain))
Try(mycovar <- as.numeric(CovarText))
if(CovarText=="" || nchar(CovarText)==0){
Try(tkmessageBox(title="Classification analysis",message="No covariate was selected.\nAborting the analysis!"))
Try(return())
} else if (as.numeric(CovarText) > dim(names.pData)[1]){
Try(tkmessageBox(title="Classification analysis",message="The selected N. is not comprised the available covars.\nAborting the analysis!"))
Try(return())
}
Try(covar <- as.vector(unlist(pData(NormalizedAffyData)[as.numeric(CovarText)])))
Try(covar.unique <- unique(covar))
Try(covar.unique <- covar.unique[which(covar.unique!="NA")])
Try(tkmessageBox(title="Classification analysis",message=paste("The selected covariate contains", length(covar.unique), "groups",
"\nNot available data, if defined as NA, were discarded", collapse=" ")))
Try(covar.lab <- NULL)
Try(for(i in 1:length(covar.unique)){covar.lab[i] <- list(which(covar==covar.unique[i]))})
#defining training and test set
Try(startFun <- tclvalue(tkmessageBox(title="Defining a training set (2/3) and a test set (1/3)",message="Do you wish to create a test set and a training set?\nIf you answer no all data set will be used as training set.",type="yesno",icon="question")))
Try(
if (startFun=="yes"){
mytrain <- NULL
for(i in 1:length(covar.lab)){
mytrain <- c(mytrain, covar.lab[[i]][1:trunc(length(covar.lab[[i]])*2/3)])
}
mytest <- setdiff(as.vector(unlist(covar.lab)), mytrain)
trainAffyData <- NormalizedAffyData[,mytrain]
assign("trainAffyData", trainAffyData, env=affylmGUIenvironment)
assign("trainAffyData.available", TRUE, env=affylmGUIenvironment)
testAffyData <- NormalizedAffyData[,mytest]
assign("testAffyData", testAffyData, env=affylmGUIenvironment)
assign("testAffyData.available", TRUE, env=affylmGUIenvironment)
tkmessageBox(title="Classification analysis",message=paste("Train and test sets are ready for classification analysis:",
"\nTraining set:", dim(exprs(trainAffyData))[2], "samples",
"\nTest set:", dim(exprs(testAffyData))[2], "samples",collapse=" "))
} else {
mytrain <- NULL
for(i in 1:length(covar.lab)){
mytrain <- c(mytrain, covar.lab[[i]][1:length(covar.lab[[i]])])
}
trainAffyData <- NormalizedAffyData[,mytrain]
assign("trainAffyData", trainAffyData, env=affylmGUIenvironment)
assign("trainAffyData.available", TRUE, env=affylmGUIenvironment)
testAffyData <- ""
assign("testAffyData", testAffyData, env=affylmGUIenvironment)
assign("testAffyData.available", FALSE, env=affylmGUIenvironment)
bringToTop(-1)
}
)
#########################end selecting the covar for classification
Try(ttGetClassification <- tktoplevel(.affylmGUIglobals$ttMain))
Try(tkwm.deiconify(ttGetClassification))
Try(tkgrab.set(ttGetClassification))
Try(tkfocus(ttGetClassification))
Try(tkwm.title(ttGetClassification,"Selecting the classification method"))
#
Try(tkgrid(tklabel(ttGetClassification,text=" ")))
Try(ClassificationTcl <- tclVar("PAMR"))
Try(rbPAMR <- tkradiobutton(ttGetClassification,text="PAMR",variable=ClassificationTcl,value="PAMR",font=.affylmGUIglobals$affylmGUIfont2))
Try(rbPDMCLASS <- tkradiobutton(ttGetClassification,text="PDMCLASS",variable=ClassificationTcl,value="PDMCLASS",font=.affylmGUIglobals$affylmGUIfont2))
Try(rbRANDOM <- tkradiobutton(ttGetClassification,text="Probability of classification given a random set of data",variable=ClassificationTcl,value="RANDOM",font=.affylmGUIglobals$affylmGUIfont2))
Try(rbPCA<-tkradiobutton(ttGetClassification,text="PCA/HCL",variable=ClassificationTcl,value="PCA",font=.affylmGUIglobals$affylmGUIfont2))
# Try(rbMIPP<-tkradiobutton(ttGetClassification,text="MIPP",variable=ClassificationTcl,value="MIPP",font=.affylmGUIglobals$affylmGUIfont2))
Try(tkgrid(tklabel(ttGetClassification,text=" "),rbPAMR))
Try(tkgrid(tklabel(ttGetClassification,text=" "),rbPDMCLASS))
Try(tkgrid(tklabel(ttGetClassification,text=" "),rbRANDOM))
Try(tkgrid(tklabel(ttGetClassification,text=" "),rbPCA))
# Try(tkgrid(tklabel(ttGetClassification,text=" "),rbMIPP))
# Try(tkgrid.configure(rbPAMR,rbPDMCLASS,rbPCA, rbMIPP,columnspan=2,sticky="w"))
Try(tkgrid.configure(rbPAMR,rbPDMCLASS, rbRANDOM, rbPCA, columnspan=2,sticky="w"))
Try(tkgrid(tklabel(ttGetClassification,text=" "),tklabel(ttGetClassification,text=" ")))
#
Try(ReturnVal <- "")
Try(
onCancel <- function() {
Try(ReturnVal <<- "");
Try(tkgrab.release(ttGetClassification));
Try(tkdestroy(ttGetClassification));
Try(tkfocus(.affylmGUIglobals$ttMain))
}
)
Try(
onOK <- function() {
Try(ReturnVal <<- tclvalue(ClassificationTcl));
Try(tkgrab.release(ttGetClassification));
Try(tkdestroy(ttGetClassification));
Try(tkfocus(.affylmGUIglobals$ttMain))
}
)
#
Try(OK.but <- tkbutton(ttGetClassification,text="OK",command=onOK,font=.affylmGUIglobals$affylmGUIfont2))
Try(Cancel.but <- tkbutton(ttGetClassification,text="Cancel",command=onCancel,font=.affylmGUIglobals$affylmGUIfont2))
#
Try(tkgrid(tklabel(ttGetClassification,text=" "),OK.but,Cancel.but,tklabel(ttGetClassification,text=" ")))
Try(tkgrid.configure(OK.but,sticky="e"))
Try(tkgrid.configure(Cancel.but,sticky="w"))
Try(tkgrid(tklabel(ttGetClassification,text=" ")))
#
Try(tkbind(ttGetClassification,"<Destroy>",function() {ReturnVal <- "";Try(tkgrab.release(ttGetClassification));Try(tkfocus(.affylmGUIglobals$ttMain));}))
Try(tkbind(OK.but, "<Return>",onOK))
Try(tkbind(Cancel.but, "<Return>",onCancel))
#
Try(tkwait.window(ttGetClassification))
#selecting the Classification method
Try(if(ReturnVal=="") return())
Try(
if(ReturnVal=="PCA"){
tkconfigure(.affylmGUIglobals$ttMain,cursor="watch")
if(affylmGUIenvironment$testAffyData.available & affylmGUIenvironment$trainAffyData.available){
Try(par(mfrow=c(2,2)))
Try(covar <- as.vector(unlist(pData(trainAffyData)[mycovar])))
Try(x <- exprs(trainAffyData))
Try(pca <- prcomp(t(x)))
Try(hc <- hclust(dist(t(x)), "ave"))
Try(plot(pca$x[, 1:2], pch = ""))
Try(text(pca$x[, 1:2], covar))
Try(plot(hc, main="Samples HCL", xlab="", labels=covar))
Try(covar <- as.vector(unlist(pData(testAffyData)[mycovar])))
Try(x= exprs(testAffyData))
Try(pca <- prcomp(t(x)))
Try(hc <- hclust(dist(t(x)), "ave"))
Try(plot(pca$x[, 1:2], pch = ""))
Try(text(pca$x[, 1:2], covar))
Try(plot(hc, main="Samples HCL", xlab="", labels=covar))
} else if(affylmGUIenvironment$trainAffyData.available){
Try(par(mfrow=c(1,2)))
Try(covar <- as.vector(unlist(pData(trainAffyData)[mycovar])))
Try(x <- exprs(trainAffyData))
Try(pca <- prcomp(t(x)))
Try(hc <- hclust(dist(t(x)), "ave"))
Try(plot(pca$x[, 1:2], pch = ""))
Try(text(pca$x[, 1:2], covar))
Try(plot(hc, main="Samples HCL", xlab="", labels=covar))
}
}
)
##############################################
Try(
if(ReturnVal=="PAMR"){
tkconfigure(.affylmGUIglobals$ttMain,cursor="watch")
if(affylmGUIenvironment$testAffyData.available & affylmGUIenvironment$trainAffyData.available){
# require(pamr) || stop("library pamr could not be found !")
Try(covar <- as.vector(unlist(pData(trainAffyData)[mycovar])))
Try(myset.data <- list(x= as.matrix(exprs(trainAffyData)), y= covar, genenames = featureNames(trainAffyData), geneid = featureNames(trainAffyData)))
Try(myset.train <- pamr.train(myset.data))
Try(myset.cv <- pamr.cv(myset.train, myset.data))
Try(pamr.plotcv(myset.cv))
Try(tkmessageBox(title="PAMR analysis",message="Cross-validated misclassification error curves are shown in the main R window\nLook at them and define the threshold to be applied."))
######select the shrinking threshold
Try(ttGetShrink<-tktoplevel(.affylmGUIglobals$ttMain))
Try(tkwm.deiconify(ttGetShrink))
Try(tkgrab.set(ttGetShrink))
Try(tkfocus(ttGetShrink))
Try(tkwm.title(ttGetShrink,"Shrinking threshold"))
Try(tkgrid(tklabel(ttGetShrink,text=" ")))
Try(ShrinkText <- "")
Try(Local.Shrink <- tclVar(init=ShrinkText))
Try(entry.Shrink <-tkentry(ttGetShrink,width="3",font=.affylmGUIglobals$affylmGUIfont2,textvariable=Local.Shrink,bg="white"))
Try(tkgrid(tklabel(ttGetShrink,text="Please enter the shrinking threshold",font=.affylmGUIglobals$affylmGUIfont2)))
Try(tkgrid(entry.Shrink))
onOK <- function()
{
Try(ShrinkText <- tclvalue(Local.Shrink))
if(nchar(ShrinkText)==0)
ShrinkText <- 0
Try(assign("ShrinkText",as.numeric(ShrinkText),affylmGUIenvironment))
Try(tclvalue(.affylmGUIglobals$CovarTcl) <- ShrinkText)
Try(tkgrab.release(ttGetShrink));Try(tkdestroy(ttGetShrink));Try(tkfocus(.affylmGUIglobals$ttMain))
}
Try(OK.but <-tkbutton(ttGetShrink,text=" OK ",command=onOK,font=.affylmGUIglobals$affylmGUIfont2))
Try(tkgrid(tklabel(ttGetShrink,text=" ")))
Try(tkgrid(OK.but))
Try(tkgrid.configure(OK.but))
Try(tkgrid(tklabel(ttGetShrink,text=" ")))
Try(tkfocus(entry.Shrink))
Try(tkbind(entry.Shrink, "<Return>",onOK))
Try(tkbind(ttGetShrink, "<Destroy>", function(){Try(tkgrab.release(ttGetShrink));Try(tkfocus(.affylmGUIglobals$ttMain));return(0)}))
Try(tkwait.window(ttGetShrink))
Try(tkfocus(.affylmGUIglobals$ttMain))
Try(myShrink <- get("ShrinkText",envir=affylmGUIenvironment))
Try(if(max(myset.train$nonzero[which(trunc(myset.train$threshold)==trunc(as.numeric(myShrink)))]) <= 50){
pamr.plotcen(myset.train, myset.data, myShrink)
Try(tkmessageBox(title="PAMR analysis",message="The shrunken class centroids plots are shown in the main R window."))
})
############listing the confusion matrix
Try(pamr.confusion(myset.train, myShrink, extra=TRUE))
#plotting the results
Try(pamr.plotcvprob(myset.train, myset.data ,myShrink))
Try(tkmessageBox(title="PAMR analysis",message="Cross-validated sample probabilities from\nthe nearest shrunken centroid classifier\nare shown in the main R window."))
##################subsetting the test set
testFun <- tclvalue(tkmessageBox(title="PAMR analysis",message="Are you satisfied of your probe sets as classifier?",type="yesno",icon="question"))
if (testFun=="yes"){
####################################listing the classification probesets
Try(tempfile1 <- tempfile())
myClassifier <- pamr.listgenes(myset.train, myset.data, myShrink)
write.table(myClassifier,file=tempfile1,quote=FALSE, col.names=NA,sep="\t")
ttToptableTable <- tktoplevel(.affylmGUIglobals$ttMain)
tkwm.title(ttToptableTable,"List of genes that survive the thresholding")
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=SaveClassifier) # ) # ,font=affylmGUIfontMenu)
tkadd(fileMenu2, "command", label="Close", command=function() tkdestroy(ttToptableTable)) # ) # ,font=affylmGUIfontMenu)
tkadd(topMenu2, "cascade", label="File", menu=fileMenu2) # ,font=affylmGUIfontMenu)
####subset the test set
Try(testAffyData <- testAffyData[which(featureNames(testAffyData)%in% as.character(as.data.frame(pamr.listgenes(myset.train, myset.data, myShrink))$id)),])
Try(assign("testAffyData", testAffyData, env=affylmGUIenvironment))
Try(x <- exprs(testAffyData))
Try(dimnames(x)[[2]] <- as.vector(unlist(pData(testAffyData)[mycovar])))
Try(hc <- hclust(dist(t(x)), "ave") )
Try(plot(hc))
Try(tkmessageBox(title="PAMR analysis",message="The hierachical clustering of test set sample on the basis of the selected probe sets\nis shown in the main R window."))
} else bringToTop(-1)
} else if(affylmGUIenvironment$trainAffyData.available){
# require(pamr) || stop("library pamr could not be found !")
Try(covar <- as.vector(unlist(pData(trainAffyData)[mycovar])))
Try(myset.data <- list(x= as.matrix(exprs(trainAffyData)), y= covar, genenames = featureNames(trainAffyData), geneid = featureNames(trainAffyData)))
Try(myset.train <- pamr.train(myset.data))
Try(myset.cv <- pamr.cv(myset.train, myset.data))
Try(pamr.plotcv(myset.cv))
Try(tkmessageBox(title="PAMR analysis",message="Cross-validated misclassification error curves are shown in the main R window\nLook at them and define the threshold to be applied."))
######select the shrinking threshold
Try(ttGetShrink<-tktoplevel(.affylmGUIglobals$ttMain))
Try(tkwm.deiconify(ttGetShrink))
Try(tkgrab.set(ttGetShrink))
Try(tkfocus(ttGetShrink))
Try(tkwm.title(ttGetShrink,"Shrinking threshold"))
Try(tkgrid(tklabel(ttGetShrink,text=" ")))
Try(ShrinkText <- "")
Try(Local.Shrink <- tclVar(init=ShrinkText))
Try(entry.Shrink <-tkentry(ttGetShrink,width="3",font=.affylmGUIglobals$affylmGUIfont2,textvariable=Local.Shrink,bg="white"))
Try(tkgrid(tklabel(ttGetShrink,text="Please enter the shrinking threshold",font=.affylmGUIglobals$affylmGUIfont2)))
Try(tkgrid(entry.Shrink))
onOK <- function()
{
Try(ShrinkText <- tclvalue(Local.Shrink))
if(nchar(ShrinkText)==0)
ShrinkText <- 0
Try(assign("ShrinkText",as.numeric(ShrinkText),affylmGUIenvironment))
Try(tclvalue(.affylmGUIglobals$CovarTcl) <- ShrinkText)
Try(tkgrab.release(ttGetShrink));Try(tkdestroy(ttGetShrink));Try(tkfocus(.affylmGUIglobals$ttMain))
}
Try(OK.but <-tkbutton(ttGetShrink,text=" OK ",command=onOK,font=.affylmGUIglobals$affylmGUIfont2))
Try(tkgrid(tklabel(ttGetShrink,text=" ")))
Try(tkgrid(OK.but))
Try(tkgrid.configure(OK.but))
Try(tkgrid(tklabel(ttGetShrink,text=" ")))
Try(tkfocus(entry.Shrink))
Try(tkbind(entry.Shrink, "<Return>",onOK))
Try(tkbind(ttGetShrink, "<Destroy>", function(){Try(tkgrab.release(ttGetShrink));Try(tkfocus(.affylmGUIglobals$ttMain));return(0)}))
Try(tkwait.window(ttGetShrink))
Try(tkfocus(.affylmGUIglobals$ttMain))
Try(myShrink <- get("ShrinkText",envir=affylmGUIenvironment))
Try(if(max(myset.train$nonzero[which(trunc(myset.train$threshold)==trunc(as.numeric(myShrink)))]) <= 50){
pamr.plotcen(myset.train, myset.data, myShrink)
Try(tkmessageBox(title="PAMR analysis",message="The shrunken class centroids plots are shown in the main R window."))
})
############listing the confusion matrix
Try(pamr.confusion(myset.train, myShrink, extra=TRUE))
#plotting the results
Try(pamr.plotcvprob(myset.train, myset.data ,myShrink))
Try(tkmessageBox(title="PAMR analysis",message="Cross-validated sample probabilities from\nthe nearest shrunken centroid classifier\nare shown in the main R window."))
##################subsetting the test set
testFun <- tclvalue(tkmessageBox(title="PAMR analysis",message="Are you satisfied of your probe sets as classifier?",type="yesno",icon="question"))
if (testFun=="yes"){
####################################listing the classification probesets
Try(tempfile1 <- tempfile())
myClassifier <- pamr.listgenes(myset.train, myset.data, myShrink)
write.table(myClassifier,file=tempfile1,quote=FALSE, col.names=NA,sep="\t")
ttToptableTable <- tktoplevel(.affylmGUIglobals$ttMain)
tkwm.title(ttToptableTable,"List of genes that survive the thresholding")
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=SaveClassifier) # ) # ,font=affylmGUIfontMenu)
tkadd(fileMenu2, "command", label="Close", command=function() tkdestroy(ttToptableTable)) # ) # ,font=affylmGUIfontMenu)
tkadd(topMenu2, "cascade", label="File", menu=fileMenu2) # ,font=affylmGUIfontMenu)
} else bringToTop(-1)
}
tkconfigure(.affylmGUIglobals$ttMain,cursor="arrow")
}
)
###
Try(
if(ReturnVal=="PDMCLASS"){
tkconfigure(.affylmGUIglobals$ttMain,cursor="watch")
# require(pdmclass) || stop("library pdmclass could not be found !")
#selecting the classification method
Try(ttGetCMeth <- tktoplevel(.affylmGUIglobals$ttMain))
Try(tkwm.deiconify(ttGetCMeth))
Try(tkgrab.set(ttGetCMeth))
Try(tkfocus(ttGetCMeth))
Try(tkwm.title(ttGetCMeth,"Selecting the classification method"))
Try(tkgrid(tklabel(ttGetCMeth,text=" ")))
Try(CMethTcl <- tclVar("pls"))
Try(rbpls <- tkradiobutton(ttGetCMeth,text="Partial least squares",variable=CMethTcl,value="pls",font=.affylmGUIglobals$affylmGUIfont2))
Try(rbpcr <- tkradiobutton(ttGetCMeth,text="Principal components regression ",variable=CMethTcl,value="pcr",font=.affylmGUIglobals$affylmGUIfont2))
Try(rbridge<-tkradiobutton(ttGetCMeth,text="Ridge regression",variable=CMethTcl,value="ridge",font=.affylmGUIglobals$affylmGUIfont2))
Try(tkgrid(tklabel(ttGetCMeth,text=" "),rbpls))
Try(tkgrid(tklabel(ttGetCMeth,text=" "),rbpcr))
Try(tkgrid(tklabel(ttGetCMeth,text=" "),rbridge))
Try(tkgrid.configure(rbpls,rbpcr,rbridge,columnspan=2,sticky="w"))
Try(tkgrid(tklabel(ttGetCMeth,text=" "),tklabel(ttGetCMeth,text=" ")))
Try(ReturnVal1 <- "")
Try(
onCancel <- function() {
Try(ReturnVal1 <<- "");
Try(tkgrab.release(ttGetCMeth));
Try(tkdestroy(ttGetCMeth));
Try(tkfocus(.affylmGUIglobals$ttMain))
}
)
Try(
onOK <- function() {
Try(ReturnVal1 <<- tclvalue(CMethTcl));
Try(tkgrab.release(ttGetCMeth));
Try(tkdestroy(ttGetCMeth));
Try(tkfocus(.affylmGUIglobals$ttMain))
}
)
Try(OK.but <- tkbutton(ttGetCMeth,text="OK",command=onOK,font=.affylmGUIglobals$affylmGUIfont2))
Try(Cancel.but <- tkbutton(ttGetCMeth,text="Cancel",command=onCancel,font=.affylmGUIglobals$affylmGUIfont2))
Try(tkgrid(tklabel(ttGetCMeth,text=" "),OK.but,Cancel.but,tklabel(ttGetCMeth,text=" ")))
Try(tkgrid.configure(OK.but,sticky="e"))
Try(tkgrid.configure(Cancel.but,sticky="w"))
Try(tkgrid(tklabel(ttGetCMeth,text=" ")))
Try(tkbind(ttGetCMeth,"<Destroy>",function() {ReturnVal <- "";Try(tkgrab.release(ttGetCMeth));Try(tkfocus(.affylmGUIglobals$ttMain));}))
Try(tkbind(OK.but, "<Return>",onOK))
Try(tkbind(Cancel.but, "<Return>",onCancel))
Try(tkwait.window(ttGetCMeth))
Try(if(ReturnVal1=="") return())
####################################
if(affylmGUIenvironment$testAffyData.available & affylmGUIenvironment$trainAffyData.available){
covar <- as.vector(unlist(pData(trainAffyData)[mycovar]))
y <- as.factor(covar)
x <- t(exprs(trainAffyData))
#select the classification method
gn.class <- pdmClass(y ~ x, method = ReturnVal1)
#Try(tkmessageBox(title="PDM analysis",message="groups clustering is shown in the main R window."))
#there is an error in the plotting I have to understand why
#plot(gn.class, pch = levels(y))
predict(gn.class)
tst <- pdmClass.cv(y, x, method = ReturnVal1)
tmp.data <- confusion(tst, y)
Try(tkmessageBox(title="Penalized discriminant analysis",message="Classification errors are shown in the main R window."))
Try(cat("\n\n\n##########Classification error###################\n"))
Try(print(tmp.data))
Try(cat("#################################################\n\n\n"))
Try(mbVal <- tkmessageBox(title="Penalized discriminant analysis",
message="Do you wish to extract the the genes that have the most influence in differentiating between sample types?",
icon="question",type="yesno",default="yes"))
#print out
if(tclvalue(mbVal)=="yes"){
genes <- featureNames(trainAffyData)
#defining the number of genes to be extracted
Try(ttIfDialog<-tktoplevel(.affylmGUIglobals$ttMain))
Try(tkwm.deiconify(ttIfDialog))
Try(tkgrab.set(ttIfDialog))
Try(tkfocus(ttIfDialog))
Try(tkwm.title(ttIfDialog,"Selecting the top ranked genes"))
Try(tkgrid(tklabel(ttIfDialog,text=" ")))
Try(frame1 <- tkframe(ttIfDialog,relief="groove",borderwidth=2))
Try(HowManyQuestion1 <- tklabel(frame1,text="Number of permutations used to identify the top ranked genes",font=.affylmGUIglobals$affylmGUIfont2))
Try(tkgrid(HowManyQuestion1))
Try(tkgrid.configure(HowManyQuestion1,columnspan=2,sticky="w"))
Try(thresholdTcl <- tclVar("25"))
Try(I1.but <- tkradiobutton(frame1,text="25",variable=thresholdTcl,value="25",font=.affylmGUIglobals$affylmGUIfont2))
Try(I2.but <- tkradiobutton(frame1,text="50",variable=thresholdTcl,value="50",font=.affylmGUIglobals$affylmGUIfont2))
Try(I3.but <- tkradiobutton(frame1,text="100",variable=thresholdTcl,value="100",font=.affylmGUIglobals$affylmGUIfont2))
Try(I4.but <- tkradiobutton(frame1,text="250",variable=thresholdTcl,value="250",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(fractionLabel <- tklabel(frame2,text="Number of top ranked genes to be extracted",font=.affylmGUIglobals$affylmGUIfont2))
Try(tkgrid(fractionLabel,sticky="w"))
Try(tkgrid.configure(fractionLabel,sticky="w"))
Try(fractionTcl <- tclVar("25"))
Try(F1.but <- tkradiobutton(frame2,text="10",variable=fractionTcl,value="10",font=.affylmGUIglobals$affylmGUIfont2))
Try(F2.but <- tkradiobutton(frame2,text="50",variable=fractionTcl,value="50",font=.affylmGUIglobals$affylmGUIfont2))
Try(F3.but <- tkradiobutton(frame2,text="100",variable=fractionTcl,value="100",font=.affylmGUIglobals$affylmGUIfont2))
Try(F4.but <- tkradiobutton(frame2,text="250",variable=fractionTcl,value="250",font=.affylmGUIglobals$affylmGUIfont2))
Try(F5.but <- tkradiobutton(frame2,text="500",variable=fractionTcl,value="500",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.configure(fractionLabel,F1.but,F2.but,F3.but,F4.but,F5.but,sticky="w"))
Try(onOK <- function()
{
ReturnVal1 <- as.numeric(tclvalue(thresholdTcl))
ReturnVal2 <- as.numeric(tclvalue(fractionTcl))
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"))
Try(return())
}
tmp <- strsplit(ReturnVal, ";")
gene.size = as.numeric(tmp[[1]][2])
permutations = as.numeric(tmp[[1]][1])
#############################################
pdmOut <- pdmGenes(y ~ x, method = ReturnVal1, genelist = genes, list.length = gene.size, B = permutations)
#preparing a table for output
table1 <- pdmOut[[1]]
if(length(pdmOut) >1){
for( i in 2:length(pdmOut)){
table1 <- data.frame(table1, pdmOut[[i]])
}
}
names(table1) <- names(pdmOut)
SaveTopTable <- function()
{
Try(FileName <- tclvalue(tkgetSaveFile(initialfile=paste("pdm.top.classifier.genes",".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(tkconfigure(.affylmGUIglobals$ttMain,cursor="watch"))
Try(tempfile1 <- tempfile())
write.table(table1,file=tempfile1,quote=FALSE,col.names=NA,sep="\t")
ttToptableTable <- tktoplevel(.affylmGUIglobals$ttMain)
tkwm.title(ttToptableTable,paste("Top ranked genes", 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"))
}
#devo ancora fare la parte per la visualizzazione dei dati sul test set
} else if(affylmGUIenvironment$trainAffyData.available){
covar <- as.vector(unlist(pData(trainAffyData)[mycovar]))
y <- as.factor(covar)
x <- t(exprs(trainAffyData))
#select the classification method
gn.class <- pdmClass(y ~ x, method = ReturnVal1)
#Try(tkmessageBox(title="PDM analysis",message="groups clustering is shown in the main R window."))
#there is an error in the plotting I have to understand why
#plot(gn.class, pch = levels(y))
predict(gn.class)
tst <- pdmClass.cv(y, x, method = ReturnVal1)
Try(tkmessageBox(title="PDM analysis",message="Classification error rate is shown in the main R window."))
tmp.data <- confusion(tst, y)
Try(cat("\n\n\n##########Classification error###################\n"))
Try(print(tmp.data))
Try(cat("#################################################\n\n\n"))
Try(mbVal <- tkmessageBox(title="Penalized discriminant analysis",
message="Do you wish to extract the the genes that have the most influence in differentiating between sample types?",
icon="question",type="yesno",default="yes"))
#print out
if(tclvalue(mbVal)=="yes"){
genes <- featureNames(trainAffyData)
#defining the number of genes to be extracted
Try(ttIfDialog<-tktoplevel(.affylmGUIglobals$ttMain))
Try(tkwm.deiconify(ttIfDialog))
Try(tkgrab.set(ttIfDialog))
Try(tkfocus(ttIfDialog))
Try(tkwm.title(ttIfDialog,"Selecting the top ranked genes"))
Try(tkgrid(tklabel(ttIfDialog,text=" ")))
Try(frame1 <- tkframe(ttIfDialog,relief="groove",borderwidth=2))
Try(HowManyQuestion1 <- tklabel(frame1,text="Number of permutations used to identify the top ranked genes",font=.affylmGUIglobals$affylmGUIfont2))
Try(tkgrid(HowManyQuestion1))
Try(tkgrid.configure(HowManyQuestion1,columnspan=2,sticky="w"))
Try(thresholdTcl <- tclVar("25"))
Try(I1.but <- tkradiobutton(frame1,text="25",variable=thresholdTcl,value="25",font=.affylmGUIglobals$affylmGUIfont2))
Try(I2.but <- tkradiobutton(frame1,text="50",variable=thresholdTcl,value="50",font=.affylmGUIglobals$affylmGUIfont2))
Try(I3.but <- tkradiobutton(frame1,text="100",variable=thresholdTcl,value="100",font=.affylmGUIglobals$affylmGUIfont2))
Try(I4.but <- tkradiobutton(frame1,text="250",variable=thresholdTcl,value="250",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(fractionLabel <- tklabel(frame2,text="Number of top ranked genes to be extracted",font=.affylmGUIglobals$affylmGUIfont2))
Try(tkgrid(fractionLabel,sticky="w"))
Try(tkgrid.configure(fractionLabel,sticky="w"))
Try(fractionTcl <- tclVar("25"))
Try(F1.but <- tkradiobutton(frame2,text="10",variable=fractionTcl,value="10",font=.affylmGUIglobals$affylmGUIfont2))
Try(F2.but <- tkradiobutton(frame2,text="50",variable=fractionTcl,value="50",font=.affylmGUIglobals$affylmGUIfont2))
Try(F3.but <- tkradiobutton(frame2,text="100",variable=fractionTcl,value="100",font=.affylmGUIglobals$affylmGUIfont2))
Try(F4.but <- tkradiobutton(frame2,text="250",variable=fractionTcl,value="250",font=.affylmGUIglobals$affylmGUIfont2))
Try(F5.but <- tkradiobutton(frame2,text="500",variable=fractionTcl,value="500",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.configure(fractionLabel,F1.but,F2.but,F3.but,F4.but,F5.but,sticky="w"))
Try(onOK <- function()
{
ReturnVal1 <- as.numeric(tclvalue(thresholdTcl))
ReturnVal2 <- as.numeric(tclvalue(fractionTcl))
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==""){return()}
tmp <- strsplit(ReturnVal, ";")
gene.size = as.numeric(tmp[[1]][2])
permutations = as.numeric(tmp[[1]][1])
#############################################
pdmOut <- pdmGenes(y ~ x, method = ReturnVal1, genelist = genes, list.length = gene.size, B = permutations)
#preparing a table for output
table1 <- pdmOut[[1]]
if(length(pdmOut) >1){
for( i in 2:length(pdmOut)){
table1 <- data.frame(table1, pdmOut[[i]])
}
}
names(table1) <- names(pdmOut)
SaveTopTable <- function()
{
Try(FileName <- tclvalue(tkgetSaveFile(initialfile=paste("pdm.top.classifier.genes",".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(tkconfigure(.affylmGUIglobals$ttMain,cursor="watch"))
Try(tempfile1 <- tempfile())
write.table(table1,file=tempfile1,quote=FALSE,col.names=NA,sep="\t")
ttToptableTable <- tktoplevel(.affylmGUIglobals$ttMain)
tkwm.title(ttToptableTable,paste("Top ranked genes", 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{return()}
})
Try(
if(ReturnVal=="RANDOM"){
trainAffyData <- get("trainAffyData", env=affylmGUIenvironment)
covar <- as.vector(unlist(pData(trainAffyData)[mycovar]))
#selecting the number of sampling
Try(ttPermutations<-tktoplevel(.affylmGUIglobals$ttMain))
Try(tkwm.deiconify(ttPermutations))
Try(tkgrab.set(ttPermutations))
Try(tkfocus(ttPermutations))
Try(tkwm.title(ttPermutations,"Defining the number of sampling"))
Try(tkgrid(tklabel(ttPermutations,text=" ")))
Try(Permutationsnum <- "100")
Try(Local.Permutations <- tclVar(init=Permutationsnum))
Try(entry.Permutations <-tkentry(ttPermutations,width="4",font=.affylmGUIglobals$affylmGUIfont2,textvariable=Local.Permutations,bg="white"))
Try(tkgrid(tklabel(ttPermutations,text="Please enter the number of sampling you wish to perform.",font=.affylmGUIglobals$affylmGUIfont2)))
Try(tkgrid(entry.Permutations))
onOK <- function()
{
Try(Permutationsnum <- as.numeric(tclvalue(Local.Permutations)))
Try(assign("Permutations", as.numeric(tclvalue(Local.Permutations)),affylmGUIenvironment))
Try(tkgrab.release(ttPermutations));Try(tkdestroy(ttPermutations));Try(tkfocus(.affylmGUIglobals$ttMain))
}
Try(OK.but <-tkbutton(ttPermutations,text=" OK ",command=onOK,font=.affylmGUIglobals$affylmGUIfont2))
Try(tkgrid(tklabel(ttPermutations,text=" ")))
Try(tkgrid(OK.but))
Try(tkgrid.configure(OK.but))
Try(tkgrid(tklabel(ttPermutations,text=" ")))
Try(tkfocus(entry.Permutations))
Try(tkbind(entry.Permutations, "<Return>",onOK))
Try(tkbind(ttPermutations, "<Destroy>", function(){Try(tkgrab.release(ttPermutations));Try(tkfocus(.affylmGUIglobals$ttMain));return(0)}))
Try(tkwait.window(ttPermutations))
Try(tkfocus(.affylmGUIglobals$ttMain))
Try(permutations <- get("Permutations", env=affylmGUIenvironment))
#end selecting the number of sampling
#selecting the number of probesets belonging to a sample
Try(ttPSsize<-tktoplevel(.affylmGUIglobals$ttMain))
Try(tkwm.deiconify(ttPSsize))
Try(tkgrab.set(ttPSsize))
Try(tkfocus(ttPSsize))
Try(tkwm.title(ttPSsize,"Defining the number of elements belonging to a sample"))
Try(tkgrid(tklabel(ttPSsize,text=" ")))
Try(PSsizenum <- "10")
Try(Local.PSsize <- tclVar(init=PSsizenum))
Try(entry.PSsize <-tkentry(ttPSsize,width="4",font=.affylmGUIglobals$affylmGUIfont2,textvariable=Local.PSsize,bg="white"))
Try(tkgrid(tklabel(ttPSsize,text="Please enter the number of probesets you wish to have in a sample.",font=.affylmGUIglobals$affylmGUIfont2)))
Try(tkgrid(entry.PSsize))
onOK <- function()
{
Try(PSsizenum <- as.numeric(tclvalue(Local.PSsize)))
Try(assign("PSsize", as.numeric(tclvalue(Local.PSsize)),affylmGUIenvironment))
Try(tkgrab.release(ttPSsize));Try(tkdestroy(ttPSsize));Try(tkfocus(.affylmGUIglobals$ttMain))
}
Try(OK.but <-tkbutton(ttPSsize,text=" OK ",command=onOK,font=.affylmGUIglobals$affylmGUIfont2))
Try(tkgrid(tklabel(ttPSsize,text=" ")))
Try(tkgrid(OK.but))
Try(tkgrid.configure(OK.but))
Try(tkgrid(tklabel(ttPSsize,text=" ")))
Try(tkfocus(entry.PSsize))
Try(tkbind(entry.PSsize, "<Return>",onOK))
Try(tkbind(ttPSsize, "<Destroy>", function(){Try(tkgrab.release(ttPSsize));Try(tkfocus(.affylmGUIglobals$ttMain));return(0)}))
Try(tkwait.window(ttPSsize))
Try(tkfocus(.affylmGUIglobals$ttMain))
Try(mysample <- get("PSsize", env=affylmGUIenvironment))
#end selecting the number of element in a sample
#selecting the classification method
Try(ttGetClassification <- tktoplevel(.affylmGUIglobals$ttMain))
Try(tkwm.deiconify(ttGetClassification))
Try(tkgrab.set(ttGetClassification))
Try(tkfocus(ttGetClassification))
Try(tkwm.title(ttGetClassification,"Selecting the classification method"))
#
Try(tkgrid(tklabel(ttGetClassification,text=" ")))
Try(ClassificationTcl <- tclVar("PAMR"))
Try(rbPAMR <- tkradiobutton(ttGetClassification,text="PAMR",variable=ClassificationTcl,value="PAMR",font=.affylmGUIglobals$affylmGUIfont2))
Try(rbPDMCLASS <- tkradiobutton(ttGetClassification,text="PDMCLASS",variable=ClassificationTcl,value="PDMCLASS",font=.affylmGUIglobals$affylmGUIfont2))
Try(tkgrid(tklabel(ttGetClassification,text=" "),rbPAMR))
Try(tkgrid(tklabel(ttGetClassification,text=" "),rbPDMCLASS))
Try(tkgrid.configure(rbPAMR,rbPDMCLASS, columnspan=2,sticky="w"))
Try(tkgrid(tklabel(ttGetClassification,text=" "),tklabel(ttGetClassification,text=" ")))
#
Try(ReturnVal <- "")
Try(
onCancel <- function() {
Try(ReturnVal <<- "");
Try(tkgrab.release(ttGetClassification));
Try(tkdestroy(ttGetClassification));
Try(tkfocus(.affylmGUIglobals$ttMain))
}
)
Try(
onOK <- function() {
Try(ReturnVal <<- tclvalue(ClassificationTcl));
Try(tkgrab.release(ttGetClassification));
Try(tkdestroy(ttGetClassification));
Try(tkfocus(.affylmGUIglobals$ttMain))
}
)
#
Try(OK.but <- tkbutton(ttGetClassification,text="OK",command=onOK,font=.affylmGUIglobals$affylmGUIfont2))
Try(Cancel.but <- tkbutton(ttGetClassification,text="Cancel",command=onCancel,font=.affylmGUIglobals$affylmGUIfont2))
#
Try(tkgrid(tklabel(ttGetClassification,text=" "),OK.but,Cancel.but,tklabel(ttGetClassification,text=" ")))
Try(tkgrid.configure(OK.but,sticky="e"))
Try(tkgrid.configure(Cancel.but,sticky="w"))
Try(tkgrid(tklabel(ttGetClassification,text=" ")))
#
Try(tkbind(ttGetClassification,"<Destroy>",function() {ReturnVal <- "";Try(tkgrab.release(ttGetClassification));Try(tkfocus(.affylmGUIglobals$ttMain));}))
Try(tkbind(OK.but, "<Return>",onOK))
Try(tkbind(Cancel.but, "<Return>",onCancel))
#
Try(tkwait.window(ttGetClassification))
if(ReturnVal=="") {
tkconfigure(.affylmGUIglobals$ttMain,cursor="arrow")
return()
} else if(ReturnVal=="PAMR"){
err.rate.perm = NULL
for(i in 1:permutations){
err.rate.perm[i] <- .perm.pamr(trainAffyData, mysample, mycovar = covar)
}
Try(tkmessageBox(title="Classification specificity",message=paste("In", permutations,"random samples made of",mysample,"probesets\nThe probability to have a significant separation between classes is",length(which(err.rate.perm < 0.14))/permutations,sep=" "),icon="info"))
return(err.rate.perm)
} else if(ReturnVal=="PDMCLASS"){
# require(pdmclass) || stop("library pdmclass could not be found !")
#selecting the classification method
Try(ttGetCMeth <- tktoplevel(.affylmGUIglobals$ttMain))
Try(tkwm.deiconify(ttGetCMeth))
Try(tkgrab.set(ttGetCMeth))
Try(tkfocus(ttGetCMeth))
Try(tkwm.title(ttGetCMeth,"Selecting the classification method"))
Try(tkgrid(tklabel(ttGetCMeth,text=" ")))
Try(CMethTcl <- tclVar("pls"))
Try(rbpls <- tkradiobutton(ttGetCMeth,text="Partial least squares",variable=CMethTcl,value="pls",font=.affylmGUIglobals$affylmGUIfont2))
Try(rbpcr <- tkradiobutton(ttGetCMeth,text="Principal components regression ",variable=CMethTcl,value="pcr",font=.affylmGUIglobals$affylmGUIfont2))
Try(rbridge<-tkradiobutton(ttGetCMeth,text="Ridge regression",variable=CMethTcl,value="ridge",font=.affylmGUIglobals$affylmGUIfont2))
Try(tkgrid(tklabel(ttGetCMeth,text=" "),rbpls))
Try(tkgrid(tklabel(ttGetCMeth,text=" "),rbpcr))
Try(tkgrid(tklabel(ttGetCMeth,text=" "),rbridge))
Try(tkgrid.configure(rbpls,rbpcr,rbridge,columnspan=2,sticky="w"))
Try(tkgrid(tklabel(ttGetCMeth,text=" "),tklabel(ttGetCMeth,text=" ")))
Try(ReturnVal1 <- "")
Try(
onCancel <- function() {
Try(ReturnVal1 <<- "");
Try(tkgrab.release(ttGetCMeth));
Try(tkdestroy(ttGetCMeth));
Try(tkfocus(.affylmGUIglobals$ttMain))
}
)
Try(
onOK <- function() {
Try(ReturnVal1 <<- tclvalue(CMethTcl));
Try(tkgrab.release(ttGetCMeth));
Try(tkdestroy(ttGetCMeth));
Try(tkfocus(.affylmGUIglobals$ttMain))
}
)
Try(OK.but <- tkbutton(ttGetCMeth,text="OK",command=onOK,font=.affylmGUIglobals$affylmGUIfont2))
Try(Cancel.but <- tkbutton(ttGetCMeth,text="Cancel",command=onCancel,font=.affylmGUIglobals$affylmGUIfont2))
Try(tkgrid(tklabel(ttGetCMeth,text=" "),OK.but,Cancel.but,tklabel(ttGetCMeth,text=" ")))
Try(tkgrid.configure(OK.but,sticky="e"))
Try(tkgrid.configure(Cancel.but,sticky="w"))
Try(tkgrid(tklabel(ttGetCMeth,text=" ")))
Try(tkbind(ttGetCMeth,"<Destroy>",function() {ReturnVal <- "";Try(tkgrab.release(ttGetCMeth));Try(tkfocus(.affylmGUIglobals$ttMain));}))
Try(tkbind(OK.but, "<Return>",onOK))
Try(tkbind(Cancel.but, "<Return>",onCancel))
Try(tkwait.window(ttGetCMeth))
Try(if(ReturnVal1=="") {
return()
})
####################################
err.rate.perm <- NULL
for(i in 1:permutations){
err.rate.perm[i] <- .perm.pdmclass(trainAffyData, mysample, mycovar = covar, ReturnVal1 = ReturnVal1)
}
Try(tkmessageBox(title="Classification specificity",message=paste("In", permutations,"random samples made of",mysample,"probesets\nThe probability to have a significant separation between classes is",length(which(err.rate.perm < 0.14))/permutations,sep=" "),icon="info"))
tkconfigure(.affylmGUIglobals$ttMain,cursor="arrow")
return(err.rate.perm)
}
})
tkconfigure(.affylmGUIglobals$ttMain,cursor="arrow")
}
################################################################################
.pamr.confusion.mod <- function (fit, threshold, extra = TRUE)
{
ii <- (1:length(fit$threshold))[fit$threshold >= threshold]
ii <- ii[1]
predicted <- fit$yhat[, ii]
if (!is.null(fit$y)) {
true <- fit$y[fit$sample.subset]
tt <- table(true, predicted)
}
else {
true <- fit$proby[fit$sample.subset, ]
ytemp <- apply(true, 1, which.is.max)
temp <- c(predicted, names(table(ytemp)))
nams <- names(table(temp))
Yhat <- model.matrix(~factor(temp) - 1, data = list(y = temp))
Yhat <- Yhat[1:length(predicted), ]
tt <- matrix(NA, nrow = length(fit$prior), ncol = length(fit$prior))
for (i in 1:length(fit$prior)) {
for (j in 1:length(fit$prior)) {
tt[i, j] <- sum(true[, i] * Yhat[, j])
}
}
dimnames(tt) <- list(names(table(ytemp)), nams)
}
if (extra) {
tt1 <- tt
diag(tt1) <- 0
tt <- cbind(tt, apply(tt1, 1, sum)/apply(tt, 1, sum))
dimnames(tt)[[2]][ncol(tt)] <- "Class Error rate"
# print(tt)
#cat(c("Overall error rate=", round(sum(tt1)/sum(tt),
# 3)), fill = TRUE)
return(round(sum(tt1)/sum(tt),3))
}
if (!extra) {
return(tt)
}
}
#this script return only error rate
# mysample is the size of genes to be used for the pamr analysis
.perm.pamr <- function(eset,mysample,mycovar){
# require(Biobase) || stop("library Biobase could not be found !")
# require(pamr) || stop("library pamr could not be found !")
S100 <- sample(seq(1,dim(eset)[1]), mysample)
myset.data <- list(x= as.matrix(eset[S100,]), y= mycovar, genenames = rownames(eset)[S100], geneid = rownames(eset)[S100])
myset.train <- pamr.train(myset.data)
return(.pamr.confusion.mod(myset.train, 0, extra=TRUE))
}
.perm.pdmclass <- function(eset,mysample,mycovar, ReturnVal1){
# require(Biobase) || stop("library Biobase could not be found !")
# require(pdmclass) || stop("library pdmclass could not be found !")
S100 <- sample(seq(1,dim(eset)[1]), mysample)
y <- as.factor(mycovar)
x <- t(exprs(eset[S100,]))
gn.class <- pdmClass(y ~ x, method = ReturnVal1)
predict(gn.class)
tst <- pdmClass.cv(y, x, method = ReturnVal1)
tmp.data <- confusion(tst, y)
my.out <- as.numeric(attr(tmp.data, "error"))
return(my.out)
}
################################################################################
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.
Defines functions pamr.confusion.mod perm.pamr perm.pdmclass
#set of functions, directly/indirectly involved, in oneChannelGUI classificationMenu
#oneChannelGUI ML.edesign present in the targetMenu
#oneChannelGUI trainTest running various classification methods
#contains oneChannelGUI SaveClassifier function used to save the set of probe sets to be used as classifier
# oneChannelGUI SaveTopTable called inside the function
###############################################################################
#thish function divide the data in traininig and test set for a specific covariate in the pData
"trainTest" <- function(){
SaveCovar <- function()
{
Try(FileName <- tclvalue(tkgetSaveFile(initialfile="names.phenoData.txt",filetypes="{{Tab-Delimited Text Files} {.txt .xls}} {{All files} *}")))
Try(if(!nchar(FileName)) return())
Try(write.table(names.pData,file=FileName,quote=FALSE,sep="\t", row.names = F))
}
#function used to save the set of probe sets to be used as classifier
SaveClassifier <- function()
{
Try(classifierFileName <- tclvalue(tkgetSaveFile(filetypes="{{Classifier Files} {.txt}} {{All files} *}")))
Try(if(!nchar(classifierFileName)) return())
Try(classifierFileName <- paste(classifierFileName,".txt",sep=""))
Try(write.table(myClassifier,file=classifierFileName,col.names=NA,sep="\t",quote=FALSE,row.names=TRUE))
}
#error if no data are loaded
Try(whichArrayPlatform <- get("whichArrayPlatform",envir=affylmGUIenvironment))
Try(MLdesign <- get("MLdesign",envir=affylmGUIenvironment))
if(whichArrayPlatform ==""){
Try(tkmessageBox(title="Classification 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())
} else if(is.character(MLdesign)){
Try(tkmessageBox(title="Classification analysis",message="You have not reorganized the covariates\nUse the - Create/view clinical parameters - function.",type="ok",icon="error"))
Try(tkfocus(.affylmGUIglobals$ttMain))
Try(return())
}
#########################selecting the covar for classification start
#defining the covariate for the classification
Try(NormalizedAffyData <- get("NormalizedAffyData", env=affylmGUIenvironment))
Try(names.pData <- as.data.frame(names(pData(NormalizedAffyData))))
Try(names(names.pData) <- "labelDescription")
Try(tempfile1 <- tempfile())
write.table(names.pData,file=tempfile1,quote=FALSE, col.names=NA,sep="\t")
ttToptableTable <- tktoplevel(.affylmGUIglobals$ttMain)
tkwm.title(ttToptableTable,"Experiment/clinical covar names")
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=SaveCovar) # ) # ,font=affylmGUIfontMenu)
tkadd(fileMenu2, "command", label="Close", command=function() tkdestroy(ttToptableTable)) # ) # ,font=affylmGUIfontMenu)
tkadd(topMenu2, "cascade", label="File", menu=fileMenu2) # ,font=affylmGUIfontMenu)
###########selecting the covariate for spltting the data set
Try(ttGetCovar<-tktoplevel(.affylmGUIglobals$ttMain))
Try(tkwm.deiconify(ttGetCovar))
Try(tkgrab.set(ttGetCovar))
Try(tkfocus(ttGetCovar))
Try(tkwm.title(ttGetCovar,"N. of Covariate"))
Try(tkgrid(tklabel(ttGetCovar,text=" ")))
Try(CovarText <- "")
Try(Local.Covar <- tclVar(init=CovarText))
Try(entry.Covar <-tkentry(ttGetCovar,width="3",font=.affylmGUIglobals$affylmGUIfont2,textvariable=Local.Covar,bg="white"))
Try(tkgrid(tklabel(ttGetCovar,text="Please enter the N. of the covariate you are interested",font=.affylmGUIglobals$affylmGUIfont2)))
Try(tkgrid(entry.Covar))
# onOK <- function()
# {
# Try(CovarText <- tclvalue(Local.Covar))
# if(nchar(CovarText)==0) {CovarText <- ""}
# Try(assign("CovarText",CovarText,affylmGUIenvironment))
# Try(tclvalue(.affylmGUIglobals$CovarTcl) <- CovarText)
# Try(tkgrab.release(ttGetCovar));Try(tkdestroy(ttGetCovar));Try(tkfocus(.affylmGUIglobals$ttMain))
# }
Try(
onOK <- function() {
Try(CovarText <<- tclvalue(Local.Covar))
Try(tkgrab.release(ttGetCovar))
Try(tkdestroy(ttGetCovar))
Try(tkfocus(.affylmGUIglobals$ttMain))
}
)
Try(OK.but <-tkbutton(ttGetCovar,text=" OK ",command=onOK,font=.affylmGUIglobals$affylmGUIfont2))
Try(tkgrid(tklabel(ttGetCovar,text=" ")))
Try(tkgrid(OK.but))
Try(tkgrid.configure(OK.but))
Try(tkgrid(tklabel(ttGetCovar,text=" ")))
Try(tkfocus(entry.Covar))
Try(tkbind(entry.Covar, "<Return>",onOK))
Try(tkbind(ttGetCovar, "<Destroy>", function(){Try(tkgrab.release(ttGetCovar));Try(tkfocus(.affylmGUIglobals$ttMain));return(0)}))
Try(tkwait.window(ttGetCovar))
Try(tkfocus(.affylmGUIglobals$ttMain))
Try(mycovar <- as.numeric(CovarText))
if(CovarText=="" || nchar(CovarText)==0){
Try(tkmessageBox(title="Classification analysis",message="No covariate was selected.\nAborting the analysis!"))
Try(return())
} else if (as.numeric(CovarText) > dim(names.pData)[1]){
Try(tkmessageBox(title="Classification analysis",message="The selected N. is not comprised the available covars.\nAborting the analysis!"))
Try(return())
}
Try(covar <- as.vector(unlist(pData(NormalizedAffyData)[as.numeric(CovarText)])))
Try(covar.unique <- unique(covar))
Try(covar.unique <- covar.unique[which(covar.unique!="NA")])
Try(tkmessageBox(title="Classification analysis",message=paste("The selected covariate contains", length(covar.unique), "groups",
"\nNot available data, if defined as NA, were discarded", collapse=" ")))
Try(covar.lab <- NULL)
Try(for(i in 1:length(covar.unique)){covar.lab[i] <- list(which(covar==covar.unique[i]))})
#defining training and test set
Try(startFun <- tclvalue(tkmessageBox(title="Defining a training set (2/3) and a test set (1/3)",message="Do you wish to create a test set and a training set?\nIf you answer no all data set will be used as training set.",type="yesno",icon="question")))
Try(
if (startFun=="yes"){
mytrain <- NULL
for(i in 1:length(covar.lab)){
mytrain <- c(mytrain, covar.lab[[i]][1:trunc(length(covar.lab[[i]])*2/3)])
}
mytest <- setdiff(as.vector(unlist(covar.lab)), mytrain)
trainAffyData <- NormalizedAffyData[,mytrain]
assign("trainAffyData", trainAffyData, env=affylmGUIenvironment)
assign("trainAffyData.available", TRUE, env=affylmGUIenvironment)
testAffyData <- NormalizedAffyData[,mytest]
assign("testAffyData", testAffyData, env=affylmGUIenvironment)
assign("testAffyData.available", TRUE, env=affylmGUIenvironment)
tkmessageBox(title="Classification analysis",message=paste("Train and test sets are ready for classification analysis:",
"\nTraining set:", dim(exprs(trainAffyData))[2], "samples",
"\nTest set:", dim(exprs(testAffyData))[2], "samples",collapse=" "))
} else {
mytrain <- NULL
for(i in 1:length(covar.lab)){
mytrain <- c(mytrain, covar.lab[[i]][1:length(covar.lab[[i]])])
}
trainAffyData <- NormalizedAffyData[,mytrain]
assign("trainAffyData", trainAffyData, env=affylmGUIenvironment)
assign("trainAffyData.available", TRUE, env=affylmGUIenvironment)
testAffyData <- ""
assign("testAffyData", testAffyData, env=affylmGUIenvironment)
assign("testAffyData.available", FALSE, env=affylmGUIenvironment)
bringToTop(-1)
}
)
#########################end selecting the covar for classification
Try(ttGetClassification <- tktoplevel(.affylmGUIglobals$ttMain))
Try(tkwm.deiconify(ttGetClassification))
Try(tkgrab.set(ttGetClassification))
Try(tkfocus(ttGetClassification))
Try(tkwm.title(ttGetClassification,"Selecting the classification method"))
#
Try(tkgrid(tklabel(ttGetClassification,text=" ")))
Try(ClassificationTcl <- tclVar("PAMR"))
Try(rbPAMR <- tkradiobutton(ttGetClassification,text="PAMR",variable=ClassificationTcl,value="PAMR",font=.affylmGUIglobals$affylmGUIfont2))
Try(rbPDMCLASS <- tkradiobutton(ttGetClassification,text="PDMCLASS",variable=ClassificationTcl,value="PDMCLASS",font=.affylmGUIglobals$affylmGUIfont2))
Try(rbRANDOM <- tkradiobutton(ttGetClassification,text="Probability of classification given a random set of data",variable=ClassificationTcl,value="RANDOM",font=.affylmGUIglobals$affylmGUIfont2))
Try(rbPCA<-tkradiobutton(ttGetClassification,text="PCA/HCL",variable=ClassificationTcl,value="PCA",font=.affylmGUIglobals$affylmGUIfont2))
# Try(rbMIPP<-tkradiobutton(ttGetClassification,text="MIPP",variable=ClassificationTcl,value="MIPP",font=.affylmGUIglobals$affylmGUIfont2))
Try(tkgrid(tklabel(ttGetClassification,text=" "),rbPAMR))
Try(tkgrid(tklabel(ttGetClassification,text=" "),rbPDMCLASS))
Try(tkgrid(tklabel(ttGetClassification,text=" "),rbRANDOM))
Try(tkgrid(tklabel(ttGetClassification,text=" "),rbPCA))
# Try(tkgrid(tklabel(ttGetClassification,text=" "),rbMIPP))
# Try(tkgrid.configure(rbPAMR,rbPDMCLASS,rbPCA, rbMIPP,columnspan=2,sticky="w"))
Try(tkgrid.configure(rbPAMR,rbPDMCLASS, rbRANDOM, rbPCA, columnspan=2,sticky="w"))
Try(tkgrid(tklabel(ttGetClassification,text=" "),tklabel(ttGetClassification,text=" ")))
#
Try(ReturnVal <- "")
Try(
onCancel <- function() {
Try(ReturnVal <<- "");
Try(tkgrab.release(ttGetClassification));
Try(tkdestroy(ttGetClassification));
Try(tkfocus(.affylmGUIglobals$ttMain))
}
)
Try(
onOK <- function() {
Try(ReturnVal <<- tclvalue(ClassificationTcl));
Try(tkgrab.release(ttGetClassification));
Try(tkdestroy(ttGetClassification));
Try(tkfocus(.affylmGUIglobals$ttMain))
}
)
#
Try(OK.but <- tkbutton(ttGetClassification,text="OK",command=onOK,font=.affylmGUIglobals$affylmGUIfont2))
Try(Cancel.but <- tkbutton(ttGetClassification,text="Cancel",command=onCancel,font=.affylmGUIglobals$affylmGUIfont2))
#
Try(tkgrid(tklabel(ttGetClassification,text=" "),OK.but,Cancel.but,tklabel(ttGetClassification,text=" ")))
Try(tkgrid.configure(OK.but,sticky="e"))
Try(tkgrid.configure(Cancel.but,sticky="w"))
Try(tkgrid(tklabel(ttGetClassification,text=" ")))
#
Try(tkbind(ttGetClassification,"<Destroy>",function() {ReturnVal <- "";Try(tkgrab.release(ttGetClassification));Try(tkfocus(.affylmGUIglobals$ttMain));}))
Try(tkbind(OK.but, "<Return>",onOK))
Try(tkbind(Cancel.but, "<Return>",onCancel))
#
Try(tkwait.window(ttGetClassification))
#selecting the Classification method
Try(if(ReturnVal=="") return())
Try(
if(ReturnVal=="PCA"){
tkconfigure(.affylmGUIglobals$ttMain,cursor="watch")
if(affylmGUIenvironment$testAffyData.available & affylmGUIenvironment$trainAffyData.available){
Try(par(mfrow=c(2,2)))
Try(covar <- as.vector(unlist(pData(trainAffyData)[mycovar])))
Try(x <- exprs(trainAffyData))
Try(pca <- prcomp(t(x)))
Try(hc <- hclust(dist(t(x)), "ave"))
Try(plot(pca$x[, 1:2], pch = ""))
Try(text(pca$x[, 1:2], covar))
Try(plot(hc, main="Samples HCL", xlab="", labels=covar))
Try(covar <- as.vector(unlist(pData(testAffyData)[mycovar])))
Try(x= exprs(testAffyData))
Try(pca <- prcomp(t(x)))
Try(hc <- hclust(dist(t(x)), "ave"))
Try(plot(pca$x[, 1:2], pch = ""))
Try(text(pca$x[, 1:2], covar))
Try(plot(hc, main="Samples HCL", xlab="", labels=covar))
} else if(affylmGUIenvironment$trainAffyData.available){
Try(par(mfrow=c(1,2)))
Try(covar <- as.vector(unlist(pData(trainAffyData)[mycovar])))
Try(x <- exprs(trainAffyData))
Try(pca <- prcomp(t(x)))
Try(hc <- hclust(dist(t(x)), "ave"))
Try(plot(pca$x[, 1:2], pch = ""))
Try(text(pca$x[, 1:2], covar))
Try(plot(hc, main="Samples HCL", xlab="", labels=covar))
}
}
)
##############################################
Try(
if(ReturnVal=="PAMR"){
tkconfigure(.affylmGUIglobals$ttMain,cursor="watch")
if(affylmGUIenvironment$testAffyData.available & affylmGUIenvironment$trainAffyData.available){
# require(pamr) || stop("library pamr could not be found !")
Try(covar <- as.vector(unlist(pData(trainAffyData)[mycovar])))
Try(myset.data <- list(x= as.matrix(exprs(trainAffyData)), y= covar, genenames = featureNames(trainAffyData), geneid = featureNames(trainAffyData)))
Try(myset.train <- pamr.train(myset.data))
Try(myset.cv <- pamr.cv(myset.train, myset.data))
Try(pamr.plotcv(myset.cv))
Try(tkmessageBox(title="PAMR analysis",message="Cross-validated misclassification error curves are shown in the main R window\nLook at them and define the threshold to be applied."))
######select the shrinking threshold
Try(ttGetShrink<-tktoplevel(.affylmGUIglobals$ttMain))
Try(tkwm.deiconify(ttGetShrink))
Try(tkgrab.set(ttGetShrink))
Try(tkfocus(ttGetShrink))
Try(tkwm.title(ttGetShrink,"Shrinking threshold"))
Try(tkgrid(tklabel(ttGetShrink,text=" ")))
Try(ShrinkText <- "")
Try(Local.Shrink <- tclVar(init=ShrinkText))
Try(entry.Shrink <-tkentry(ttGetShrink,width="3",font=.affylmGUIglobals$affylmGUIfont2,textvariable=Local.Shrink,bg="white"))
Try(tkgrid(tklabel(ttGetShrink,text="Please enter the shrinking threshold",font=.affylmGUIglobals$affylmGUIfont2)))
Try(tkgrid(entry.Shrink))
onOK <- function()
{
Try(ShrinkText <- tclvalue(Local.Shrink))
if(nchar(ShrinkText)==0)
ShrinkText <- 0
Try(assign("ShrinkText",as.numeric(ShrinkText),affylmGUIenvironment))
Try(tclvalue(.affylmGUIglobals$CovarTcl) <- ShrinkText)
Try(tkgrab.release(ttGetShrink));Try(tkdestroy(ttGetShrink));Try(tkfocus(.affylmGUIglobals$ttMain))
}
Try(OK.but <-tkbutton(ttGetShrink,text=" OK ",command=onOK,font=.affylmGUIglobals$affylmGUIfont2))
Try(tkgrid(tklabel(ttGetShrink,text=" ")))
Try(tkgrid(OK.but))
Try(tkgrid.configure(OK.but))
Try(tkgrid(tklabel(ttGetShrink,text=" ")))
Try(tkfocus(entry.Shrink))
Try(tkbind(entry.Shrink, "<Return>",onOK))
Try(tkbind(ttGetShrink, "<Destroy>", function(){Try(tkgrab.release(ttGetShrink));Try(tkfocus(.affylmGUIglobals$ttMain));return(0)}))
Try(tkwait.window(ttGetShrink))
Try(tkfocus(.affylmGUIglobals$ttMain))
Try(myShrink <- get("ShrinkText",envir=affylmGUIenvironment))
Try(if(max(myset.train$nonzero[which(trunc(myset.train$threshold)==trunc(as.numeric(myShrink)))]) <= 50){
pamr.plotcen(myset.train, myset.data, myShrink)
Try(tkmessageBox(title="PAMR analysis",message="The shrunken class centroids plots are shown in the main R window."))
})
############listing the confusion matrix
Try(pamr.confusion(myset.train, myShrink, extra=TRUE))
#plotting the results
Try(pamr.plotcvprob(myset.train, myset.data ,myShrink))
Try(tkmessageBox(title="PAMR analysis",message="Cross-validated sample probabilities from\nthe nearest shrunken centroid classifier\nare shown in the main R window."))
##################subsetting the test set
testFun <- tclvalue(tkmessageBox(title="PAMR analysis",message="Are you satisfied of your probe sets as classifier?",type="yesno",icon="question"))
if (testFun=="yes"){
####################################listing the classification probesets
Try(tempfile1 <- tempfile())
myClassifier <- pamr.listgenes(myset.train, myset.data, myShrink)
write.table(myClassifier,file=tempfile1,quote=FALSE, col.names=NA,sep="\t")
ttToptableTable <- tktoplevel(.affylmGUIglobals$ttMain)
tkwm.title(ttToptableTable,"List of genes that survive the thresholding")
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=SaveClassifier) # ) # ,font=affylmGUIfontMenu)
tkadd(fileMenu2, "command", label="Close", command=function() tkdestroy(ttToptableTable)) # ) # ,font=affylmGUIfontMenu)
tkadd(topMenu2, "cascade", label="File", menu=fileMenu2) # ,font=affylmGUIfontMenu)
####subset the test set
Try(testAffyData <- testAffyData[which(featureNames(testAffyData)%in% as.character(as.data.frame(pamr.listgenes(myset.train, myset.data, myShrink))$id)),])
Try(assign("testAffyData", testAffyData, env=affylmGUIenvironment))
Try(x <- exprs(testAffyData))
Try(dimnames(x)[[2]] <- as.vector(unlist(pData(testAffyData)[mycovar])))
Try(hc <- hclust(dist(t(x)), "ave") )
Try(plot(hc))
Try(tkmessageBox(title="PAMR analysis",message="The hierachical clustering of test set sample on the basis of the selected probe sets\nis shown in the main R window."))
} else bringToTop(-1)
} else if(affylmGUIenvironment$trainAffyData.available){
# require(pamr) || stop("library pamr could not be found !")
Try(covar <- as.vector(unlist(pData(trainAffyData)[mycovar])))
Try(myset.data <- list(x= as.matrix(exprs(trainAffyData)), y= covar, genenames = featureNames(trainAffyData), geneid = featureNames(trainAffyData)))
Try(myset.train <- pamr.train(myset.data))
Try(myset.cv <- pamr.cv(myset.train, myset.data))
Try(pamr.plotcv(myset.cv))
Try(tkmessageBox(title="PAMR analysis",message="Cross-validated misclassification error curves are shown in the main R window\nLook at them and define the threshold to be applied."))
######select the shrinking threshold
Try(ttGetShrink<-tktoplevel(.affylmGUIglobals$ttMain))
Try(tkwm.deiconify(ttGetShrink))
Try(tkgrab.set(ttGetShrink))
Try(tkfocus(ttGetShrink))
Try(tkwm.title(ttGetShrink,"Shrinking threshold"))
Try(tkgrid(tklabel(ttGetShrink,text=" ")))
Try(ShrinkText <- "")
Try(Local.Shrink <- tclVar(init=ShrinkText))
Try(entry.Shrink <-tkentry(ttGetShrink,width="3",font=.affylmGUIglobals$affylmGUIfont2,textvariable=Local.Shrink,bg="white"))
Try(tkgrid(tklabel(ttGetShrink,text="Please enter the shrinking threshold",font=.affylmGUIglobals$affylmGUIfont2)))
Try(tkgrid(entry.Shrink))
onOK <- function()
{
Try(ShrinkText <- tclvalue(Local.Shrink))
if(nchar(ShrinkText)==0)
ShrinkText <- 0
Try(assign("ShrinkText",as.numeric(ShrinkText),affylmGUIenvironment))
Try(tclvalue(.affylmGUIglobals$CovarTcl) <- ShrinkText)
Try(tkgrab.release(ttGetShrink));Try(tkdestroy(ttGetShrink));Try(tkfocus(.affylmGUIglobals$ttMain))
}
Try(OK.but <-tkbutton(ttGetShrink,text=" OK ",command=onOK,font=.affylmGUIglobals$affylmGUIfont2))
Try(tkgrid(tklabel(ttGetShrink,text=" ")))
Try(tkgrid(OK.but))
Try(tkgrid.configure(OK.but))
Try(tkgrid(tklabel(ttGetShrink,text=" ")))
Try(tkfocus(entry.Shrink))
Try(tkbind(entry.Shrink, "<Return>",onOK))
Try(tkbind(ttGetShrink, "<Destroy>", function(){Try(tkgrab.release(ttGetShrink));Try(tkfocus(.affylmGUIglobals$ttMain));return(0)}))
Try(tkwait.window(ttGetShrink))
Try(tkfocus(.affylmGUIglobals$ttMain))
Try(myShrink <- get("ShrinkText",envir=affylmGUIenvironment))
Try(if(max(myset.train$nonzero[which(trunc(myset.train$threshold)==trunc(as.numeric(myShrink)))]) <= 50){
pamr.plotcen(myset.train, myset.data, myShrink)
Try(tkmessageBox(title="PAMR analysis",message="The shrunken class centroids plots are shown in the main R window."))
})
############listing the confusion matrix
Try(pamr.confusion(myset.train, myShrink, extra=TRUE))
#plotting the results
Try(pamr.plotcvprob(myset.train, myset.data ,myShrink))
Try(tkmessageBox(title="PAMR analysis",message="Cross-validated sample probabilities from\nthe nearest shrunken centroid classifier\nare shown in the main R window."))
##################subsetting the test set
testFun <- tclvalue(tkmessageBox(title="PAMR analysis",message="Are you satisfied of your probe sets as classifier?",type="yesno",icon="question"))
if (testFun=="yes"){
####################################listing the classification probesets
Try(tempfile1 <- tempfile())
myClassifier <- pamr.listgenes(myset.train, myset.data, myShrink)
write.table(myClassifier,file=tempfile1,quote=FALSE, col.names=NA,sep="\t")
ttToptableTable <- tktoplevel(.affylmGUIglobals$ttMain)
tkwm.title(ttToptableTable,"List of genes that survive the thresholding")
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=SaveClassifier) # ) # ,font=affylmGUIfontMenu)
tkadd(fileMenu2, "command", label="Close", command=function() tkdestroy(ttToptableTable)) # ) # ,font=affylmGUIfontMenu)
tkadd(topMenu2, "cascade", label="File", menu=fileMenu2) # ,font=affylmGUIfontMenu)
} else bringToTop(-1)
}
tkconfigure(.affylmGUIglobals$ttMain,cursor="arrow")
}
)
###
Try(
if(ReturnVal=="PDMCLASS"){
tkconfigure(.affylmGUIglobals$ttMain,cursor="watch")
# require(pdmclass) || stop("library pdmclass could not be found !")
#selecting the classification method
Try(ttGetCMeth <- tktoplevel(.affylmGUIglobals$ttMain))
Try(tkwm.deiconify(ttGetCMeth))
Try(tkgrab.set(ttGetCMeth))
Try(tkfocus(ttGetCMeth))
Try(tkwm.title(ttGetCMeth,"Selecting the classification method"))
Try(tkgrid(tklabel(ttGetCMeth,text=" ")))
Try(CMethTcl <- tclVar("pls"))
Try(rbpls <- tkradiobutton(ttGetCMeth,text="Partial least squares",variable=CMethTcl,value="pls",font=.affylmGUIglobals$affylmGUIfont2))
Try(rbpcr <- tkradiobutton(ttGetCMeth,text="Principal components regression ",variable=CMethTcl,value="pcr",font=.affylmGUIglobals$affylmGUIfont2))
Try(rbridge<-tkradiobutton(ttGetCMeth,text="Ridge regression",variable=CMethTcl,value="ridge",font=.affylmGUIglobals$affylmGUIfont2))
Try(tkgrid(tklabel(ttGetCMeth,text=" "),rbpls))
Try(tkgrid(tklabel(ttGetCMeth,text=" "),rbpcr))
Try(tkgrid(tklabel(ttGetCMeth,text=" "),rbridge))
Try(tkgrid.configure(rbpls,rbpcr,rbridge,columnspan=2,sticky="w"))
Try(tkgrid(tklabel(ttGetCMeth,text=" "),tklabel(ttGetCMeth,text=" ")))
Try(ReturnVal1 <- "")
Try(
onCancel <- function() {
Try(ReturnVal1 <<- "");
Try(tkgrab.release(ttGetCMeth));
Try(tkdestroy(ttGetCMeth));
Try(tkfocus(.affylmGUIglobals$ttMain))
}
)
Try(
onOK <- function() {
Try(ReturnVal1 <<- tclvalue(CMethTcl));
Try(tkgrab.release(ttGetCMeth));
Try(tkdestroy(ttGetCMeth));
Try(tkfocus(.affylmGUIglobals$ttMain))
}
)
Try(OK.but <- tkbutton(ttGetCMeth,text="OK",command=onOK,font=.affylmGUIglobals$affylmGUIfont2))
Try(Cancel.but <- tkbutton(ttGetCMeth,text="Cancel",command=onCancel,font=.affylmGUIglobals$affylmGUIfont2))
Try(tkgrid(tklabel(ttGetCMeth,text=" "),OK.but,Cancel.but,tklabel(ttGetCMeth,text=" ")))
Try(tkgrid.configure(OK.but,sticky="e"))
Try(tkgrid.configure(Cancel.but,sticky="w"))
Try(tkgrid(tklabel(ttGetCMeth,text=" ")))
Try(tkbind(ttGetCMeth,"<Destroy>",function() {ReturnVal <- "";Try(tkgrab.release(ttGetCMeth));Try(tkfocus(.affylmGUIglobals$ttMain));}))
Try(tkbind(OK.but, "<Return>",onOK))
Try(tkbind(Cancel.but, "<Return>",onCancel))
Try(tkwait.window(ttGetCMeth))
Try(if(ReturnVal1=="") return())
####################################
if(affylmGUIenvironment$testAffyData.available & affylmGUIenvironment$trainAffyData.available){
covar <- as.vector(unlist(pData(trainAffyData)[mycovar]))
y <- as.factor(covar)
x <- t(exprs(trainAffyData))
#select the classification method
gn.class <- pdmClass(y ~ x, method = ReturnVal1)
#Try(tkmessageBox(title="PDM analysis",message="groups clustering is shown in the main R window."))
#there is an error in the plotting I have to understand why
#plot(gn.class, pch = levels(y))
predict(gn.class)
tst <- pdmClass.cv(y, x, method = ReturnVal1)
tmp.data <- confusion(tst, y)
Try(tkmessageBox(title="Penalized discriminant analysis",message="Classification errors are shown in the main R window."))
Try(cat("\n\n\n##########Classification error###################\n"))
Try(print(tmp.data))
Try(cat("#################################################\n\n\n"))
Try(mbVal <- tkmessageBox(title="Penalized discriminant analysis",
message="Do you wish to extract the the genes that have the most influence in differentiating between sample types?",
icon="question",type="yesno",default="yes"))
#print out
if(tclvalue(mbVal)=="yes"){
genes <- featureNames(trainAffyData)
#defining the number of genes to be extracted
Try(ttIfDialog<-tktoplevel(.affylmGUIglobals$ttMain))
Try(tkwm.deiconify(ttIfDialog))
Try(tkgrab.set(ttIfDialog))
Try(tkfocus(ttIfDialog))
Try(tkwm.title(ttIfDialog,"Selecting the top ranked genes"))
Try(tkgrid(tklabel(ttIfDialog,text=" ")))
Try(frame1 <- tkframe(ttIfDialog,relief="groove",borderwidth=2))
Try(HowManyQuestion1 <- tklabel(frame1,text="Number of permutations used to identify the top ranked genes",font=.affylmGUIglobals$affylmGUIfont2))
Try(tkgrid(HowManyQuestion1))
Try(tkgrid.configure(HowManyQuestion1,columnspan=2,sticky="w"))
Try(thresholdTcl <- tclVar("25"))
Try(I1.but <- tkradiobutton(frame1,text="25",variable=thresholdTcl,value="25",font=.affylmGUIglobals$affylmGUIfont2))
Try(I2.but <- tkradiobutton(frame1,text="50",variable=thresholdTcl,value="50",font=.affylmGUIglobals$affylmGUIfont2))
Try(I3.but <- tkradiobutton(frame1,text="100",variable=thresholdTcl,value="100",font=.affylmGUIglobals$affylmGUIfont2))
Try(I4.but <- tkradiobutton(frame1,text="250",variable=thresholdTcl,value="250",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(fractionLabel <- tklabel(frame2,text="Number of top ranked genes to be extracted",font=.affylmGUIglobals$affylmGUIfont2))
Try(tkgrid(fractionLabel,sticky="w"))
Try(tkgrid.configure(fractionLabel,sticky="w"))
Try(fractionTcl <- tclVar("25"))
Try(F1.but <- tkradiobutton(frame2,text="10",variable=fractionTcl,value="10",font=.affylmGUIglobals$affylmGUIfont2))
Try(F2.but <- tkradiobutton(frame2,text="50",variable=fractionTcl,value="50",font=.affylmGUIglobals$affylmGUIfont2))
Try(F3.but <- tkradiobutton(frame2,text="100",variable=fractionTcl,value="100",font=.affylmGUIglobals$affylmGUIfont2))
Try(F4.but <- tkradiobutton(frame2,text="250",variable=fractionTcl,value="250",font=.affylmGUIglobals$affylmGUIfont2))
Try(F5.but <- tkradiobutton(frame2,text="500",variable=fractionTcl,value="500",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.configure(fractionLabel,F1.but,F2.but,F3.but,F4.but,F5.but,sticky="w"))
Try(onOK <- function()
{
ReturnVal1 <- as.numeric(tclvalue(thresholdTcl))
ReturnVal2 <- as.numeric(tclvalue(fractionTcl))
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"))
Try(return())
}
tmp <- strsplit(ReturnVal, ";")
gene.size = as.numeric(tmp[[1]][2])
permutations = as.numeric(tmp[[1]][1])
#############################################
pdmOut <- pdmGenes(y ~ x, method = ReturnVal1, genelist = genes, list.length = gene.size, B = permutations)
#preparing a table for output
table1 <- pdmOut[[1]]
if(length(pdmOut) >1){
for( i in 2:length(pdmOut)){
table1 <- data.frame(table1, pdmOut[[i]])
}
}
names(table1) <- names(pdmOut)
SaveTopTable <- function()
{
Try(FileName <- tclvalue(tkgetSaveFile(initialfile=paste("pdm.top.classifier.genes",".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(tkconfigure(.affylmGUIglobals$ttMain,cursor="watch"))
Try(tempfile1 <- tempfile())
write.table(table1,file=tempfile1,quote=FALSE,col.names=NA,sep="\t")
ttToptableTable <- tktoplevel(.affylmGUIglobals$ttMain)
tkwm.title(ttToptableTable,paste("Top ranked genes", 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"))
}
#devo ancora fare la parte per la visualizzazione dei dati sul test set
} else if(affylmGUIenvironment$trainAffyData.available){
covar <- as.vector(unlist(pData(trainAffyData)[mycovar]))
y <- as.factor(covar)
x <- t(exprs(trainAffyData))
#select the classification method
gn.class <- pdmClass(y ~ x, method = ReturnVal1)
#Try(tkmessageBox(title="PDM analysis",message="groups clustering is shown in the main R window."))
#there is an error in the plotting I have to understand why
#plot(gn.class, pch = levels(y))
predict(gn.class)
tst <- pdmClass.cv(y, x, method = ReturnVal1)
Try(tkmessageBox(title="PDM analysis",message="Classification error rate is shown in the main R window."))
tmp.data <- confusion(tst, y)
Try(cat("\n\n\n##########Classification error###################\n"))
Try(print(tmp.data))
Try(cat("#################################################\n\n\n"))
Try(mbVal <- tkmessageBox(title="Penalized discriminant analysis",
message="Do you wish to extract the the genes that have the most influence in differentiating between sample types?",
icon="question",type="yesno",default="yes"))
#print out
if(tclvalue(mbVal)=="yes"){
genes <- featureNames(trainAffyData)
#defining the number of genes to be extracted
Try(ttIfDialog<-tktoplevel(.affylmGUIglobals$ttMain))
Try(tkwm.deiconify(ttIfDialog))
Try(tkgrab.set(ttIfDialog))
Try(tkfocus(ttIfDialog))
Try(tkwm.title(ttIfDialog,"Selecting the top ranked genes"))
Try(tkgrid(tklabel(ttIfDialog,text=" ")))
Try(frame1 <- tkframe(ttIfDialog,relief="groove",borderwidth=2))
Try(HowManyQuestion1 <- tklabel(frame1,text="Number of permutations used to identify the top ranked genes",font=.affylmGUIglobals$affylmGUIfont2))
Try(tkgrid(HowManyQuestion1))
Try(tkgrid.configure(HowManyQuestion1,columnspan=2,sticky="w"))
Try(thresholdTcl <- tclVar("25"))
Try(I1.but <- tkradiobutton(frame1,text="25",variable=thresholdTcl,value="25",font=.affylmGUIglobals$affylmGUIfont2))
Try(I2.but <- tkradiobutton(frame1,text="50",variable=thresholdTcl,value="50",font=.affylmGUIglobals$affylmGUIfont2))
Try(I3.but <- tkradiobutton(frame1,text="100",variable=thresholdTcl,value="100",font=.affylmGUIglobals$affylmGUIfont2))
Try(I4.but <- tkradiobutton(frame1,text="250",variable=thresholdTcl,value="250",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(fractionLabel <- tklabel(frame2,text="Number of top ranked genes to be extracted",font=.affylmGUIglobals$affylmGUIfont2))
Try(tkgrid(fractionLabel,sticky="w"))
Try(tkgrid.configure(fractionLabel,sticky="w"))
Try(fractionTcl <- tclVar("25"))
Try(F1.but <- tkradiobutton(frame2,text="10",variable=fractionTcl,value="10",font=.affylmGUIglobals$affylmGUIfont2))
Try(F2.but <- tkradiobutton(frame2,text="50",variable=fractionTcl,value="50",font=.affylmGUIglobals$affylmGUIfont2))
Try(F3.but <- tkradiobutton(frame2,text="100",variable=fractionTcl,value="100",font=.affylmGUIglobals$affylmGUIfont2))
Try(F4.but <- tkradiobutton(frame2,text="250",variable=fractionTcl,value="250",font=.affylmGUIglobals$affylmGUIfont2))
Try(F5.but <- tkradiobutton(frame2,text="500",variable=fractionTcl,value="500",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.configure(fractionLabel,F1.but,F2.but,F3.but,F4.but,F5.but,sticky="w"))
Try(onOK <- function()
{
ReturnVal1 <- as.numeric(tclvalue(thresholdTcl))
ReturnVal2 <- as.numeric(tclvalue(fractionTcl))
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==""){return()}
tmp <- strsplit(ReturnVal, ";")
gene.size = as.numeric(tmp[[1]][2])
permutations = as.numeric(tmp[[1]][1])
#############################################
pdmOut <- pdmGenes(y ~ x, method = ReturnVal1, genelist = genes, list.length = gene.size, B = permutations)
#preparing a table for output
table1 <- pdmOut[[1]]
if(length(pdmOut) >1){
for( i in 2:length(pdmOut)){
table1 <- data.frame(table1, pdmOut[[i]])
}
}
names(table1) <- names(pdmOut)
SaveTopTable <- function()
{
Try(FileName <- tclvalue(tkgetSaveFile(initialfile=paste("pdm.top.classifier.genes",".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(tkconfigure(.affylmGUIglobals$ttMain,cursor="watch"))
Try(tempfile1 <- tempfile())
write.table(table1,file=tempfile1,quote=FALSE,col.names=NA,sep="\t")
ttToptableTable <- tktoplevel(.affylmGUIglobals$ttMain)
tkwm.title(ttToptableTable,paste("Top ranked genes", 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{return()}
})
Try(
if(ReturnVal=="RANDOM"){
trainAffyData <- get("trainAffyData", env=affylmGUIenvironment)
covar <- as.vector(unlist(pData(trainAffyData)[mycovar]))
#selecting the number of sampling
Try(ttPermutations<-tktoplevel(.affylmGUIglobals$ttMain))
Try(tkwm.deiconify(ttPermutations))
Try(tkgrab.set(ttPermutations))
Try(tkfocus(ttPermutations))
Try(tkwm.title(ttPermutations,"Defining the number of sampling"))
Try(tkgrid(tklabel(ttPermutations,text=" ")))
Try(Permutationsnum <- "100")
Try(Local.Permutations <- tclVar(init=Permutationsnum))
Try(entry.Permutations <-tkentry(ttPermutations,width="4",font=.affylmGUIglobals$affylmGUIfont2,textvariable=Local.Permutations,bg="white"))
Try(tkgrid(tklabel(ttPermutations,text="Please enter the number of sampling you wish to perform.",font=.affylmGUIglobals$affylmGUIfont2)))
Try(tkgrid(entry.Permutations))
onOK <- function()
{
Try(Permutationsnum <- as.numeric(tclvalue(Local.Permutations)))
Try(assign("Permutations", as.numeric(tclvalue(Local.Permutations)),affylmGUIenvironment))
Try(tkgrab.release(ttPermutations));Try(tkdestroy(ttPermutations));Try(tkfocus(.affylmGUIglobals$ttMain))
}
Try(OK.but <-tkbutton(ttPermutations,text=" OK ",command=onOK,font=.affylmGUIglobals$affylmGUIfont2))
Try(tkgrid(tklabel(ttPermutations,text=" ")))
Try(tkgrid(OK.but))
Try(tkgrid.configure(OK.but))
Try(tkgrid(tklabel(ttPermutations,text=" ")))
Try(tkfocus(entry.Permutations))
Try(tkbind(entry.Permutations, "<Return>",onOK))
Try(tkbind(ttPermutations, "<Destroy>", function(){Try(tkgrab.release(ttPermutations));Try(tkfocus(.affylmGUIglobals$ttMain));return(0)}))
Try(tkwait.window(ttPermutations))
Try(tkfocus(.affylmGUIglobals$ttMain))
Try(permutations <- get("Permutations", env=affylmGUIenvironment))
#end selecting the number of sampling
#selecting the number of probesets belonging to a sample
Try(ttPSsize<-tktoplevel(.affylmGUIglobals$ttMain))
Try(tkwm.deiconify(ttPSsize))
Try(tkgrab.set(ttPSsize))
Try(tkfocus(ttPSsize))
Try(tkwm.title(ttPSsize,"Defining the number of elements belonging to a sample"))
Try(tkgrid(tklabel(ttPSsize,text=" ")))
Try(PSsizenum <- "10")
Try(Local.PSsize <- tclVar(init=PSsizenum))
Try(entry.PSsize <-tkentry(ttPSsize,width="4",font=.affylmGUIglobals$affylmGUIfont2,textvariable=Local.PSsize,bg="white"))
Try(tkgrid(tklabel(ttPSsize,text="Please enter the number of probesets you wish to have in a sample.",font=.affylmGUIglobals$affylmGUIfont2)))
Try(tkgrid(entry.PSsize))
onOK <- function()
{
Try(PSsizenum <- as.numeric(tclvalue(Local.PSsize)))
Try(assign("PSsize", as.numeric(tclvalue(Local.PSsize)),affylmGUIenvironment))
Try(tkgrab.release(ttPSsize));Try(tkdestroy(ttPSsize));Try(tkfocus(.affylmGUIglobals$ttMain))
}
Try(OK.but <-tkbutton(ttPSsize,text=" OK ",command=onOK,font=.affylmGUIglobals$affylmGUIfont2))
Try(tkgrid(tklabel(ttPSsize,text=" ")))
Try(tkgrid(OK.but))
Try(tkgrid.configure(OK.but))
Try(tkgrid(tklabel(ttPSsize,text=" ")))
Try(tkfocus(entry.PSsize))
Try(tkbind(entry.PSsize, "<Return>",onOK))
Try(tkbind(ttPSsize, "<Destroy>", function(){Try(tkgrab.release(ttPSsize));Try(tkfocus(.affylmGUIglobals$ttMain));return(0)}))
Try(tkwait.window(ttPSsize))
Try(tkfocus(.affylmGUIglobals$ttMain))
Try(mysample <- get("PSsize", env=affylmGUIenvironment))
#end selecting the number of element in a sample
#selecting the classification method
Try(ttGetClassification <- tktoplevel(.affylmGUIglobals$ttMain))
Try(tkwm.deiconify(ttGetClassification))
Try(tkgrab.set(ttGetClassification))
Try(tkfocus(ttGetClassification))
Try(tkwm.title(ttGetClassification,"Selecting the classification method"))
#
Try(tkgrid(tklabel(ttGetClassification,text=" ")))
Try(ClassificationTcl <- tclVar("PAMR"))
Try(rbPAMR <- tkradiobutton(ttGetClassification,text="PAMR",variable=ClassificationTcl,value="PAMR",font=.affylmGUIglobals$affylmGUIfont2))
Try(rbPDMCLASS <- tkradiobutton(ttGetClassification,text="PDMCLASS",variable=ClassificationTcl,value="PDMCLASS",font=.affylmGUIglobals$affylmGUIfont2))
Try(tkgrid(tklabel(ttGetClassification,text=" "),rbPAMR))
Try(tkgrid(tklabel(ttGetClassification,text=" "),rbPDMCLASS))
Try(tkgrid.configure(rbPAMR,rbPDMCLASS, columnspan=2,sticky="w"))
Try(tkgrid(tklabel(ttGetClassification,text=" "),tklabel(ttGetClassification,text=" ")))
#
Try(ReturnVal <- "")
Try(
onCancel <- function() {
Try(ReturnVal <<- "");
Try(tkgrab.release(ttGetClassification));
Try(tkdestroy(ttGetClassification));
Try(tkfocus(.affylmGUIglobals$ttMain))
}
)
Try(
onOK <- function() {
Try(ReturnVal <<- tclvalue(ClassificationTcl));
Try(tkgrab.release(ttGetClassification));
Try(tkdestroy(ttGetClassification));
Try(tkfocus(.affylmGUIglobals$ttMain))
}
)
#
Try(OK.but <- tkbutton(ttGetClassification,text="OK",command=onOK,font=.affylmGUIglobals$affylmGUIfont2))
Try(Cancel.but <- tkbutton(ttGetClassification,text="Cancel",command=onCancel,font=.affylmGUIglobals$affylmGUIfont2))
#
Try(tkgrid(tklabel(ttGetClassification,text=" "),OK.but,Cancel.but,tklabel(ttGetClassification,text=" ")))
Try(tkgrid.configure(OK.but,sticky="e"))
Try(tkgrid.configure(Cancel.but,sticky="w"))
Try(tkgrid(tklabel(ttGetClassification,text=" ")))
#
Try(tkbind(ttGetClassification,"<Destroy>",function() {ReturnVal <- "";Try(tkgrab.release(ttGetClassification));Try(tkfocus(.affylmGUIglobals$ttMain));}))
Try(tkbind(OK.but, "<Return>",onOK))
Try(tkbind(Cancel.but, "<Return>",onCancel))
#
Try(tkwait.window(ttGetClassification))
if(ReturnVal=="") {
tkconfigure(.affylmGUIglobals$ttMain,cursor="arrow")
return()
} else if(ReturnVal=="PAMR"){
err.rate.perm = NULL
for(i in 1:permutations){
err.rate.perm[i] <- .perm.pamr(trainAffyData, mysample, mycovar = covar)
}
Try(tkmessageBox(title="Classification specificity",message=paste("In", permutations,"random samples made of",mysample,"probesets\nThe probability to have a significant separation between classes is",length(which(err.rate.perm < 0.14))/permutations,sep=" "),icon="info"))
return(err.rate.perm)
} else if(ReturnVal=="PDMCLASS"){
# require(pdmclass) || stop("library pdmclass could not be found !")
#selecting the classification method
Try(ttGetCMeth <- tktoplevel(.affylmGUIglobals$ttMain))
Try(tkwm.deiconify(ttGetCMeth))
Try(tkgrab.set(ttGetCMeth))
Try(tkfocus(ttGetCMeth))
Try(tkwm.title(ttGetCMeth,"Selecting the classification method"))
Try(tkgrid(tklabel(ttGetCMeth,text=" ")))
Try(CMethTcl <- tclVar("pls"))
Try(rbpls <- tkradiobutton(ttGetCMeth,text="Partial least squares",variable=CMethTcl,value="pls",font=.affylmGUIglobals$affylmGUIfont2))
Try(rbpcr <- tkradiobutton(ttGetCMeth,text="Principal components regression ",variable=CMethTcl,value="pcr",font=.affylmGUIglobals$affylmGUIfont2))
Try(rbridge<-tkradiobutton(ttGetCMeth,text="Ridge regression",variable=CMethTcl,value="ridge",font=.affylmGUIglobals$affylmGUIfont2))
Try(tkgrid(tklabel(ttGetCMeth,text=" "),rbpls))
Try(tkgrid(tklabel(ttGetCMeth,text=" "),rbpcr))
Try(tkgrid(tklabel(ttGetCMeth,text=" "),rbridge))
Try(tkgrid.configure(rbpls,rbpcr,rbridge,columnspan=2,sticky="w"))
Try(tkgrid(tklabel(ttGetCMeth,text=" "),tklabel(ttGetCMeth,text=" ")))
Try(ReturnVal1 <- "")
Try(
onCancel <- function() {
Try(ReturnVal1 <<- "");
Try(tkgrab.release(ttGetCMeth));
Try(tkdestroy(ttGetCMeth));
Try(tkfocus(.affylmGUIglobals$ttMain))
}
)
Try(
onOK <- function() {
Try(ReturnVal1 <<- tclvalue(CMethTcl));
Try(tkgrab.release(ttGetCMeth));
Try(tkdestroy(ttGetCMeth));
Try(tkfocus(.affylmGUIglobals$ttMain))
}
)
Try(OK.but <- tkbutton(ttGetCMeth,text="OK",command=onOK,font=.affylmGUIglobals$affylmGUIfont2))
Try(Cancel.but <- tkbutton(ttGetCMeth,text="Cancel",command=onCancel,font=.affylmGUIglobals$affylmGUIfont2))
Try(tkgrid(tklabel(ttGetCMeth,text=" "),OK.but,Cancel.but,tklabel(ttGetCMeth,text=" ")))
Try(tkgrid.configure(OK.but,sticky="e"))
Try(tkgrid.configure(Cancel.but,sticky="w"))
Try(tkgrid(tklabel(ttGetCMeth,text=" ")))
Try(tkbind(ttGetCMeth,"<Destroy>",function() {ReturnVal <- "";Try(tkgrab.release(ttGetCMeth));Try(tkfocus(.affylmGUIglobals$ttMain));}))
Try(tkbind(OK.but, "<Return>",onOK))
Try(tkbind(Cancel.but, "<Return>",onCancel))
Try(tkwait.window(ttGetCMeth))
Try(if(ReturnVal1=="") {
return()
})
####################################
err.rate.perm <- NULL
for(i in 1:permutations){
err.rate.perm[i] <- .perm.pdmclass(trainAffyData, mysample, mycovar = covar, ReturnVal1 = ReturnVal1)
}
Try(tkmessageBox(title="Classification specificity",message=paste("In", permutations,"random samples made of",mysample,"probesets\nThe probability to have a significant separation between classes is",length(which(err.rate.perm < 0.14))/permutations,sep=" "),icon="info"))
tkconfigure(.affylmGUIglobals$ttMain,cursor="arrow")
return(err.rate.perm)
}
})
tkconfigure(.affylmGUIglobals$ttMain,cursor="arrow")
}
################################################################################
.pamr.confusion.mod <- function (fit, threshold, extra = TRUE)
{
ii <- (1:length(fit$threshold))[fit$threshold >= threshold]
ii <- ii[1]
predicted <- fit$yhat[, ii]
if (!is.null(fit$y)) {
true <- fit$y[fit$sample.subset]
tt <- table(true, predicted)
}
else {
true <- fit$proby[fit$sample.subset, ]
ytemp <- apply(true, 1, which.is.max)
temp <- c(predicted, names(table(ytemp)))
nams <- names(table(temp))
Yhat <- model.matrix(~factor(temp) - 1, data = list(y = temp))
Yhat <- Yhat[1:length(predicted), ]
tt <- matrix(NA, nrow = length(fit$prior), ncol = length(fit$prior))
for (i in 1:length(fit$prior)) {
for (j in 1:length(fit$prior)) {
tt[i, j] <- sum(true[, i] * Yhat[, j])
}
}
dimnames(tt) <- list(names(table(ytemp)), nams)
}
if (extra) {
tt1 <- tt
diag(tt1) <- 0
tt <- cbind(tt, apply(tt1, 1, sum)/apply(tt, 1, sum))
dimnames(tt)[[2]][ncol(tt)] <- "Class Error rate"
# print(tt)
#cat(c("Overall error rate=", round(sum(tt1)/sum(tt),
# 3)), fill = TRUE)
return(round(sum(tt1)/sum(tt),3))
}
if (!extra) {
return(tt)
}
}
#this script return only error rate
# mysample is the size of genes to be used for the pamr analysis
.perm.pamr <- function(eset,mysample,mycovar){
# require(Biobase) || stop("library Biobase could not be found !")
# require(pamr) || stop("library pamr could not be found !")
S100 <- sample(seq(1,dim(eset)[1]), mysample)
myset.data <- list(x= as.matrix(eset[S100,]), y= mycovar, genenames = rownames(eset)[S100], geneid = rownames(eset)[S100])
myset.train <- pamr.train(myset.data)
return(.pamr.confusion.mod(myset.train, 0, extra=TRUE))
}
.perm.pdmclass <- function(eset,mysample,mycovar, ReturnVal1){
# require(Biobase) || stop("library Biobase could not be found !")
# require(pdmclass) || stop("library pdmclass could not be found !")
S100 <- sample(seq(1,dim(eset)[1]), mysample)
y <- as.factor(mycovar)
x <- t(exprs(eset[S100,]))
gn.class <- pdmClass(y ~ x, method = ReturnVal1)
predict(gn.class)
tst <- pdmClass.cv(y, x, method = ReturnVal1)
tmp.data <- confusion(tst, y)
my.out <- as.numeric(attr(tmp.data, "error"))
return(my.out)
}
################################################################################
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.