Nothing
FactoPCA <-
function() #FactoPCA function which will ba called by OK button of the PCA window
{
# Creation des fonctions pour les options via nouvelle fenetre graphique
#! fonction pour le choix des variables qualitatives supplementaires
Fillu.funct<-defmacro(label, firstLabel, expr=
{ #function to choose supplementary categorical variables
env<-environment()
variablefact<-NULL #creation of an empty object: variablefact
.FilluLabel<-tclVar(paste(firstLabel, "", sep=" "))
.factors<-Factors()
OnFillu<-function() #function launched by clicking on button "select supplementary factors"
{
if(length(.factors)==0) errorCondition(recall=NULL, message=.Facto_gettext("No Factor available")) #message if no factor in the dataset
FilluWin<-tktoplevel() #creation of a new tcltk window
tkwm.title(FilluWin,.Facto_gettext("Choice of supplementary factors")) #title of the window
#creation de la fonction FOK.funct
FOK.funct<-function() #function launched by clicking on OK after having chosen sup fact
{
fact.select<-listfact.nom[as.numeric(tkcurselection(listfact))+1] #creation of a list box with factors
if(length(fact.select)==0) { #if nothing selected, no factor affected to variablefact and the window is closed
assign("variablefact", NULL, envir=env)
tclvalue(.FilluLabel)<-paste(firstLabel, "", sep=" ")
tkconfigure(Fillu.but, fg="black")
tkdestroy(FilluWin)
return()
}
assign("variablefact", fact.select, envir=env) #else, selected factors are affected to variablefact then the window is closed
tclvalue(.FilluLabel)<-paste(label, "", sep=" ")
tkconfigure(Fillu.but, fg="blue") #button "select sup fact" becomes blue
tkdestroy(FilluWin)
}
# creation et mise en page de la fenetre Fillu
listfact<-tklistbox(FilluWin,selectmode="extended",exportselection="FALSE",yscrollcommand=function(...)tkset(scrfact,...)) #empty list box
scrfact <-tkscrollbar(FilluWin,repeatinterval=5,command=function(...)tkyview(listfact,...)) #scroll bar
listfact.nom<-NULL
indice<-0
for (i in (1:ncol(donnee))) {
if (is.factor(donnee[,i])) { #we're interested only in categorical variables
tkinsert(listfact,"end",vars[i]) #list box is completed with all available factors
listfact.nom<-c(listfact.nom,vars[i])
if(vars[i] %in% variablefact) tkselection.set(listfact, indice) #factors' selection
indice<-indice+1
}
}
FOK.but<-tkbutton(FilluWin, text="OK", width=16,command=FOK.funct) #OK button to launch the function above
#page setting
tkgrid(tklabel(FilluWin, text="")) #blank line
tkgrid(tklabel(FilluWin, text = .Facto_gettext("Select supplementary factor(s)"), fg = "blue"), column=1, columnspan = 1, sticky = "ew") #text
tkgrid(listfact, scrfact, sticky = "nw") #list box and scroll bar side by side
tkgrid.configure(scrfact, sticky = "ens", columnspan=1) #scroll bar's configuration
tkgrid.configure(listfact, sticky = "ew", column=1, columnspan=1) #list box's config
tkgrid(tklabel(FilluWin, text="")) #blank line
tkgrid(FOK.but, column=1,columnspan=1, sticky="ew") #OK button
tkgrid(tklabel(FilluWin, text="")) #blank line
tkgrid.columnconfigure(FilluWin,0, minsize=25) #window configuration: column nb 0 with size 25
tkgrid.columnconfigure(FilluWin,2, minsize=25) #window configuration: column nb 2 with size 25
}
FilluFrame<-tkframe(IlluFrame) #new frame of main window to put "select sup fact" button
if(length(.factors)==0){ #if no factors in the dataset, grey button with message
Fillu.but<-tkbutton(FilluFrame, text=.Facto_gettext("No factors available"), borderwidth=3)
tkconfigure(Fillu.but, fg="grey")
}
else Fillu.but<-tkbutton(FilluFrame, textvariable=.FilluLabel, command=OnFillu, borderwidth=3) #else, function OnFillu is launched
tkgrid(Fillu.but, sticky="ew") #setting of this button in the new frame
## Fillu.but<-tkbutton(FilluFrame, textvariable=.FilluLabel, command=OnFillu, borderwidth=3)
## tkgrid(Fillu.but, sticky="ew")
})
#! fonction pour le choix des variables quantitatives supplementaires
Dillu.funct<-defmacro(label, firstLabel, expr= #function to choose supplementary continuous variables
{
env<-environment()
variableillu<-NULL #creation of an empty object: variableillu
.DilluLabel<-tclVar(paste(firstLabel, "", sep=" "))
OnDillu<-function() #function launched by clicking on "select sup variables"
{
DilluWin<-tktoplevel() #creation of a new tcltk window
tkwm.title(DilluWin,.Facto_gettext("Select supplementary variables")) #title of the window
#creation de la fonction DOK.funct
DOK.funct<-function() #function launched by clicking on OK after habing chosen sup cont variables
{
vsup.select<-listvar.nom[as.numeric(tkcurselection(listvar))+1] #list box
if(length(vsup.select)==0) #if nothing selected, no variable affected to variableillu and the window is closed
{
assign("variableillu", NULL, envir=env)
tclvalue(.DilluLabel)<-paste(firstLabel, "", sep=" ")
tkconfigure(Dillu.but, fg="black")
tkdestroy(DilluWin)
return()
}
assign("variableillu", vsup.select, envir=env) #else, chosen variables are affected to variableillu and then the window is closed
tclvalue(.DilluLabel)<-paste(label, "", sep=" ")
tkconfigure(Dillu.but, fg="blue") #"select sup var" button becomes blue
tkdestroy(DilluWin)
}
# creation et mise en page de la fenetre Dillu
listvar<-tklistbox(DilluWin,selectmode="extended",exportselection="FALSE",yscrollcommand=function(...)tkset(scrvar,...)) #empty list box
scrvar <-tkscrollbar(DilluWin,repeatinterval=5,command=function(...)tkyview(listvar,...)) #scroll bar
listvar.nom<-NULL
indice<-0
for (i in (1:ncol(donnee))) {
if (is.numeric(donnee[,i])) { #we're interested only in numerical variables
tkinsert(listvar,"end",vars[i]) #continuous variables are put in list box
listvar.nom<-c(listvar.nom,vars[i])
if(vars[i] %in% variableillu) tkselection.set(listvar, indice) #selected cont var
indice<-indice+1
}
}
DOK.but<-tkbutton(DilluWin, text="OK", width=16,command=DOK.funct) #OK button to launch the function above
tkgrid(tklabel(DilluWin, text="")) #page setting: blank line
tkgrid(tklabel(DilluWin, text = .Facto_gettext("Select supplementary variable(s)"), fg = "blue"), column=1, columnspan = 1, sticky = "ew") #text
tkgrid(listvar, scrvar, sticky = "nw") #list box and scroll bar side by side
tkgrid.configure(scrvar, sticky = "ens", columnspan=1) #scroll bar's configuration
tkgrid.configure(listvar, sticky = "ew", column=1, columnspan=1) #list box's configuration
tkgrid(tklabel(DilluWin, text="")) #blank line
tkgrid(DOK.but, column=1,columnspan=1, sticky="ew") #OK button
tkgrid(tklabel(DilluWin, text="")) #blank line
tkgrid.columnconfigure(DilluWin,0, minsize=25) #window configuration: column 0 will be of size 25
tkgrid.columnconfigure(DilluWin,2, minsize=25) #window configuration: column 2 will be of size 25
}
DilluFrame<-tkframe(IlluFrame) #new frame on the main window to put "select sup var" button
Dillu.but<-tkbutton(DilluFrame, textvariable=.DilluLabel, command=OnDillu, borderwidth=3) #"select sup var" button
tkgrid(Dillu.but, sticky="ew") #"select sup var" button put in its frame
})
#! fonction pour le choix des individus supplementaires
Iillu.funct<-defmacro(label, firstLabel, expr= #function to choose sup individuals
{
env<-environment()
individuillu<-NULL #creation of an empty object: individuillu
.IilluLabel<-tclVar(paste(firstLabel, "", sep=" "))
OnIillu<-function() #function launched by clicking on "select sup ind"
{
IilluWin<-tktoplevel() #creation of a new tcltk window
tkwm.title(IilluWin,.Facto_gettext("Select supplementary individuals")) #title of the window
#creation de la fonction IOK.funct
IOK.funct<-function() #function to select sup ind
{
ind.select<-rows[as.numeric(tkcurselection(listind))+1] #list box
if(length(ind.select)==0) #if no ind selected, nothing put in individuillu and the window is closed
{
assign("individuillu", NULL, envir=env)
tclvalue(.IilluLabel)<-paste(firstLabel, "", sep=" ")
tkconfigure(Iillu.but, fg="black")
tkdestroy(IilluWin)
return()
}
assign("individuillu", ind.select, envir=env) #else selected ind are put in individuillu then the window is closed
# tclvalue(.IilluLabel)<-paste(label, ": OK", sep=" ")
tclvalue(.IilluLabel)<-paste(label, "", sep=" ")
tkconfigure(Iillu.but, fg="blue") #"select sup ind" button becomes blue
tkdestroy(IilluWin)
}
# creation et mise en page de la fenetre Fillu
listind<-tklistbox(IilluWin,selectmode="extended",exportselection="FALSE",yscrollcommand=function(...)tkset(scrind,...)) #empty list box
scrind <-tkscrollbar(IilluWin,repeatinterval=5,command=function(...)tkyview(listind,...)) #scroll bar
indice<-0
for (i in (1:nrow(donnee))) {
tkinsert(listind,"end",rows[i]) # On renseigne la liste #list box is completed with individuals
if(rows[i] %in% individuillu) tkselection.set(listind,indice) #selected individuals
indice<-indice+1
}
IOK.but<-tkbutton(IilluWin, text="OK", width=16,command=IOK.funct) #OK button to launch the function above
tkgrid(tklabel(IilluWin, text="")) #page setting: blank line
tkgrid(tklabel(IilluWin, text = .Facto_gettext("Select supplementary individual(s)"), fg = "blue"), column=1, columnspan = 1, sticky = "ew") #text
tkgrid(listind, scrind, sticky = "nw") #list box and scroll bar side by side
tkgrid.configure(scrind, sticky = "ens", columnspan=1) #scroll bar's config
tkgrid.configure(listind, sticky = "ew", column=1, columnspan=1) #list box's config
tkgrid(tklabel(IilluWin, text="")) #blank line
tkgrid(IOK.but, column=1,columnspan=1, sticky="ew") #OK button
tkgrid(tklabel(IilluWin, text="")) #blank line
tkgrid.columnconfigure(IilluWin,0, minsize=25) #configuration of column nb 0: size 25
tkgrid.columnconfigure(IilluWin,2, minsize=25) #configuration of column nb 2: size 25
}
IilluFrame<-tkframe(IlluFrame) #new frame in the main window
Iillu.but<-tkbutton(IilluFrame, textvariable=.IilluLabel, command=OnIillu, borderwidth=3) #creation of "select sup ind" button
tkgrid(Iillu.but, sticky="ew") #new button put in new frame
})
#! fonction pour la gestion des options graphiques
PLOT.PCA<-defmacro(label, firstLabel, expr= #function to choose graphical options
{
env<-environment()
compteur.graph<-0 #variables initialization
#declaration des variables
Rchoix<-TRUE #plotting graph of individuals
RTitle<-NULL #title for graph of ind
Rinvisible<-NULL #invisible elements for graph of ind
Rlabel<-c("ind", "ind.sup", "quali") #different lables for graph of ind
Rcol.ind<-Rcol.ind.tmp<-"black" #color for ind
Rcol.ind.sup<-Rcol.ind.sup.tmp<-"blue" #color for sup ind
Rcol.quali<-Rcol.quali.tmp<-"magenta" #color for sup fact
Rhabillage<-"none" #color according...
RXlimInd<-NULL #limit for x axes
RYlimInd<-NULL #limit for y axes
Wchoix=TRUE #plotting graph of variables
WTitle<-NULL #title of graph of var
Wlabel<-c("var", "quanti.sup") #labels
Wlim.cos<-0. #selection on cos2
Wcol.quanti.sup<-Wcol.quanti.sup.tmp<-"blue" #color for sup var
Wcol.var<-Wcol.var.tmp<-"black" #color for var
WXlimVar<-NULL #limit for x axes
WYlimVar<-NULL #limit for y axes
.PlotLabel<-tclVar(paste(firstLabel, "", sep=" "))
OnPlot<-function() #function to be launched by clicking on "graphical options" button
{
PlotWin<-tktoplevel() #new tcltk window
tkwm.title(PlotWin, .Facto_gettext("Graphical options")) #title
tkwm.geometry(PlotWin, "-100+50") #size
#creation de la fonction onOKsub
onOKsub<-function() #function launched by clicking on OK
{
assign("compteur.graph", compteur.graph+1, envir=env) #after clicking on OK, "graph opt" button becomes blue
# if(compteur.graph>0) tclvalue(.PlotLabel)<-paste(label, ": Seen", sep=" ")
if(compteur.graph>0) tclvalue(.PlotLabel)<-paste(label, "", sep=" ")
tkconfigure(Plot.but, fg="blue")
# gestion des entrees de la partie graphique des individus
if(tclvalue(ind.check.value)==1) assign("Rchoix", TRUE, envir=env) #if the user has chosen to plot the graph of individuals, TRUE is affected to Rchoix, else FALSE is affected
else assign("Rchoix", FALSE, envir=env)
if(Rchoix) #if Rchoix is TRUE
{
if (tclvalue(Titre)==" ") assign("RTitle", NULL, envir=env) #if the user did not write anything for the title, then RTitle becomes NULL, else it takes what the user wrote
assign("RTitle", tclvalue(Titre), envir=env)
label.tmp.ind<-tclvalue(label.ind.checkValue)
label.tmp.ind.sup<-tclvalue(label.ind.sup.checkValue)
label.tmp.quali.sup<-tclvalue(label.quali.sup.checkValue)
assign("Rlabel", NULL, envir=env) #at first Rlabel is NULL, then it is completed with "ind", "ind.sup" and "quali" if the user has chosen to plot those labels
if(label.tmp.ind==1) assign("Rlabel", c(Rlabel, "ind"), envir=env)
if(label.tmp.ind.sup==1) assign("Rlabel", c(Rlabel, "ind.sup"), envir=env)
if(label.tmp.quali.sup==1) assign("Rlabel", c(Rlabel, "quali"), envir=env)
assign("Rcol.ind", Rcol.ind.tmp, envir=env) #Rcol.ind takes the color the user has chosen for individuals
assign("Rcol.ind.sup", Rcol.ind.sup.tmp, envir=env) #Rcol.ind.sup takes the color the user has chosen for sup individuals
assign("Rcol.quali", Rcol.quali.tmp, envir=env) #Rcol.quali takes the color the user has chosen for sup factors
inv.ind.tmp<-tclvalue(inv.ind.checkValue)
inv.ind.sup.tmp<-tclvalue(inv.ind.sup.checkValue)
inv.quali.tmp<-tclvalue(inv.quali.checkValue)
assign("Rinvisible", NULL, envir=env) #at first Rinvisible is NULL, then it is completed with "ind", "ind.sup" and "quali" if the user has chosen to hide those elements
if(inv.ind.tmp=="1") assign("Rinvisible", c(Rinvisible, "ind"), envir=env)
if(inv.ind.sup.tmp=="1") assign("Rinvisible", c(Rinvisible, "ind.sup"), envir=env)
if(inv.quali.tmp=="1") assign("Rinvisible", c(Rinvisible, "quali"), envir=env)
habillage.tmp<-listgraph.nom[as.numeric(tkcurselection(listgraph))+1] #individuals are colored according to what the user chose
if(length(habillage.tmp)==0) assign("Rhabillage","none", envir=env) #if nothing chosen, hbillage ="none"
else assign("Rhabillage", habillage.tmp, envir=env)
if(tclvalue(XlimIndMin)=="" | tclvalue(XlimIndMax)=="") assign("RXlimInd", NULL, envir=env) #when no choice for x limits, RXlimInd=NULL
else assign("RXlimInd", c(as.numeric(tclvalue(XlimIndMin)), as.numeric(tclvalue(XlimIndMax))), envir=env) #else RXlimInd is what the user chose
if(tclvalue(YlimIndMin)=="" | tclvalue(YlimIndMax)=="") assign("RYlimInd", NULL, envir=env) #when no choice for y limits, RYlimInd=NULL
else assign("RYlimInd", c(as.numeric(tclvalue(YlimIndMin)), as.numeric(tclvalue(YlimIndMax))), envir=env) #else RYlimInd is what the user chose
}
# gestion des entrees de la partie graphique des variables
if(tclvalue(var.check.value)==1) assign("Wchoix", TRUE, envir=env) #if the user has chosen to plot the graph of variables, TRUE is affected to Wchoix, else FALSE is affected
else assign("Wchoix", FALSE, envir=env)
if(Wchoix) #if Wchoix=T
{
if (tclvalue(WTitre)==" ") assign("WTitle", NULL, envir=env) #if the user did not write anything for the title, then WTitle becomes NULL, else it takes what the user wrote
assign("WTitle", tclvalue(WTitre), envir=env)
assign("Wlim.cos", tclvalue(WlimCosValue), envir=env) #Wlim.cos takes the value the user chose
label.tmp.var<-tclvalue(label.var.checkValue)
label.tmp.quanti.sup<-tclvalue(label.quanti.sup.checkValue)
assign("Wlabel", NULL, envir=env) #at first Wlabel is NULL, then it is completed with "var" and "quanti.sup" if the user has chosen to plot those labels
if(label.tmp.var==1) assign("Wlabel", c(Wlabel, "var"), envir=env)
if(label.tmp.quanti.sup==1) assign("Wlabel", c(Wlabel, "quanti.sup"), envir=env)
assign("Wcol.var", Wcol.var.tmp, envir=env) #Wcol.var takes the color the user has chosen for active variables
assign("Wcol.quanti.sup", Wcol.quanti.sup.tmp, envir=env) #Wcol.quanti.sup takes the color the user has chosen for supplementary variables
}
tkdestroy(PlotWin) #window is closed
}
# construction de la partie graphique des individus
PlotIndFrame<-tkframe(PlotWin, borderwidth=5, relief="groove") #new frame for all the choices concerning graph of individuals
RchoixFrame<-tkframe(PlotIndFrame,borderwidth=2) #frame for the button to choose whether or not to plot the graph of individuals
ind.check<-tkcheckbutton(RchoixFrame) #creation of a check button
if(Rchoix) ind.check.value<-tclVar("1") #ind.check.value=1 if Rchoix=T
else ind.check.value<-tclVar("0") #else ind.check.value=0
tkconfigure(ind.check, variable=ind.check.value) #assigning variable to check button: will appear as clicked or unclicked according to ind.check.value (1 or 0)
tkgrid(tklabel(RchoixFrame, text=.Facto_gettext("Plot individuals graph"), font=font2),ind.check) #positionning text and check button side by side
tkgrid(tklabel(RchoixFrame, text=" ")) #blank line
RTitleFrame<-tkframe(PlotIndFrame,borderwidth=2) #frame for the title
if (is.null(RTitle)) Titre <- tclVar(" ") #default value is nothing
else Titre<-tclVar(RTitle) #if the user writes sth, it becomes the value of RTitle
Titre.entry <-tkentry(RTitleFrame,width="40",textvariable=Titre) #case to enter the title
tkgrid(tklabel(RTitleFrame,text=.Facto_gettext("Title of the graph")),Titre.entry) #positionning text and case side by side
RinvisibleFrame<-tkframe(PlotIndFrame,borderwidth=2) #frame for invisible elements
inv.ind.check<-tkcheckbutton(RinvisibleFrame) #check button for individuals
if ("ind" %in% Rinvisible) inv.ind.checkValue<-tclVar("1") #inv.ind.checkValue=1 if "ind" is in Rinvisible
else inv.ind.checkValue<-tclVar("0")
inv.ind.sup.check<-tkcheckbutton(RinvisibleFrame) #check button for sup individuals
if ("ind.sup" %in% Rinvisible) inv.ind.sup.checkValue<-tclVar("1") #inv.ind.sup.checkValue=1 if "ind.sup" is in Rinvisible
else inv.ind.sup.checkValue<-tclVar("0")
inv.quali.check<-tkcheckbutton(RinvisibleFrame) #check button for sup individuals
if ("quali" %in% Rinvisible) inv.quali.checkValue<-tclVar("1") #inv.quali.checkValue<=1 if "quali" is in Rinvisible
else inv.quali.checkValue<-tclVar("0")
tkconfigure(inv.ind.check, variable=inv.ind.checkValue) #assigning inv.ind.checkValue to check button, button will appear clicked or unclicked according to it
tkconfigure(inv.ind.sup.check, variable=inv.ind.sup.checkValue) #assigning inv.ind.sup.checkValue to check button
tkconfigure(inv.quali.check, variable=inv.quali.checkValue) #assigning inv.ind.sup.checkValue to check button
if (!is.null(variablefact)|!is.null(individuillu)){ #if there are supplementary factors or individuals
tkgrid(tklabel(RinvisibleFrame, text=.Facto_gettext("Hide some elements:")), columnspan=6, sticky="w") #positionning text
tkgrid(tklabel(RinvisibleFrame, text="ind"),inv.ind.check, tklabel(RinvisibleFrame, text="ind sup"),inv.ind.sup.check, tklabel(RinvisibleFrame, text="quali"),inv.quali.check, sticky="w") #and check buttons
}
RlabelFrame<-tkframe(PlotIndFrame,borderwidth=2) #frame for labels
label.ind.check<-tkcheckbutton(RlabelFrame) #check button for labels of individuals
if ("ind" %in% Rlabel) label.ind.checkValue<-tclVar("1") #label.ind.checkValue=1 if "ind" is in Rlabel
else label.ind.checkValue<-tclVar("0")
tkconfigure(label.ind.check, variable=label.ind.checkValue) #assigning label.ind.checkValue to the button
tkgrid(tklabel(RlabelFrame, text=.Facto_gettext("Label for the active individuals")),label.ind.check) #positionning text and button
label.ind.sup.check<-tkcheckbutton(RlabelFrame) #check button for labels of sup individuals
if ("ind.sup" %in% Rlabel) label.ind.sup.checkValue<-tclVar("1") #label.ind.sup.checkValue=1 if "ind.sup" is in Rlabel
else label.ind.sup.checkValue<-tclVar("0")
tkconfigure(label.ind.sup.check, variable=label.ind.sup.checkValue) #assigning label.ind.sup.heckValue to the button
if(!is.null(individuillu)) tkgrid(tklabel(RlabelFrame, text=.Facto_gettext("Label for the supplementary individuals")),label.ind.sup.check) #positionning text and button
label.quali.sup.check<-tkcheckbutton(RlabelFrame) #check button for labels of sup fact
if ("quali" %in% Rlabel) label.quali.sup.checkValue<-tclVar("1") #label.quali.sup.checkValue=1 if "ind.sup" is in Rlabel
else label.quali.sup.checkValue<-tclVar("1")
tkconfigure(label.quali.sup.check, variable=label.quali.sup.checkValue) #assigning label.quali.sup.checkValue to the button
if(!is.null(variablefact)) tkgrid(tklabel(RlabelFrame, text=.Facto_gettext("Label for the supplementary factor")), label.quali.sup.check) #positionning text and button
RcolFrame<-tkframe(PlotIndFrame,borderwidth=2) #frame for choice of colors
Rcol.ind.value <- Rcol.ind
canvas.ind <- tkcanvas(RcolFrame,width="80",height="25",bg=Rcol.ind.value) #button to change color of individuals
ChangeColor.ind <- function() #function to change color of individuals
{
Rcol.ind.value<-tclvalue(tcl("tk_chooseColor",initialcolor=Rcol.ind.value,title=.Facto_gettext("Choose a color"))) #assigning chosen color to Rcol.ind.value
if (nchar(Rcol.ind.value)>0)
{
tkconfigure(canvas.ind,bg=Rcol.ind.value) #canva's color becomes the chosen one
assign("Rcol.ind.tmp", Rcol.ind.value, envir=env) #assigning Rcol.ind.value to Rcol.ind.tmp
}
}
ChangeColor.ind.button <- tkbutton(RcolFrame,text=.Facto_gettext("Change Color"),command=ChangeColor.ind) #button to launch function above
tkgrid(tklabel(RcolFrame, text=.Facto_gettext("Color of the active individuals")),canvas.ind,ChangeColor.ind.button) #settings: text, canva and button
Rcol.ind.sup.value<-Rcol.ind.sup #same for supplementary individuals
canvas.ind.sup <- tkcanvas(RcolFrame,width="80",height="25",bg=Rcol.ind.sup.value)
ChangeColor.ind.sup <- function()
{
Rcol.ind.sup.value<-tclvalue(tcl("tk_chooseColor",initialcolor=Rcol.ind.sup.value,title=.Facto_gettext("Choose a color")))
if (nchar(Rcol.ind.sup.value)>0)
{
tkconfigure(canvas.ind.sup,bg=Rcol.ind.sup.value)
assign("Rcol.ind.sup.tmp", Rcol.ind.sup.value, envir=env)
}
}
ChangeColor.ind.sup.button <- tkbutton(RcolFrame,text=.Facto_gettext("Change Color"),command=ChangeColor.ind.sup)
if(!is.null(individuillu)) tkgrid(tklabel(RcolFrame, text=.Facto_gettext("color for supplementary individuals")),canvas.ind.sup,ChangeColor.ind.sup.button)
Rcol.quali.value<- Rcol.quali #same for sup factors
canvas.quali <- tkcanvas(RcolFrame,width="80",height="25",bg=Rcol.quali.value)
ChangeColor.quali <- function()
{
Rcol.quali.value<-tclvalue(tcl("tk_chooseColor",initialcolor=Rcol.quali.value,title=.Facto_gettext("Choose a color")))
if (nchar(Rcol.quali.value)>0)
{
tkconfigure(canvas.quali,bg=Rcol.quali.value)
assign("Rcol.quali.tmp", Rcol.quali.value, envir=env)
}
}
ChangeColor.quali.button <- tkbutton(RcolFrame,text=.Facto_gettext("Change Color"),command=ChangeColor.quali)
if(!is.null(variablefact)) tkgrid(tklabel(RcolFrame, text=.Facto_gettext("Color for factors")),canvas.quali,ChangeColor.quali.button)
RhabillageFrame<-tkframe(PlotIndFrame,borderwidth=2) #new frame for coloring individuals according to sth
listgraph<-tklistbox(RhabillageFrame,height=4, selectmode="single",exportselection="FALSE",yscrollcommand=function(...) tkset(scrgraph,...)) #empty list box
scrgraph <-tkscrollbar(RhabillageFrame,repeatinterval=5,command=function(...)tkyview(listgraph,...)) #scroll bar
listgraph.nom<-"ind"
tkinsert(listgraph,"end",.Facto_gettext("by.individual")) #putting "by.individual" in the list box
if(Rhabillage=="ind") tkselection.set(listgraph, 0) #color by individual if the user chose it
indice<-1
## for (i in 1:ncol(donnee)) {
## if(is.factor(donnee[,i])) {
## tkinsert(listgraph,"end",vars[i])
## listgraph.nom<-c(listgraph.nom,vars[i])
## if(vars[i]==Rhabillage) tkselection.set(listgraph, indice)
## indice<-indice+1
## }
## }
if (!is.null(variablefact)){ #if there are supplementary variables, they are added to the list box
for (j in 1:ncol(donnee)){
if(vars[j] %in% variablefact){
tkinsert(listgraph,"end",vars[j])
listgraph.nom<-c(listgraph.nom,vars[j])
if(Rhabillage==vars[j]) tkselection.set(listgraph, indice) #selection of the chosen factor
indice<-indice+1
}}
}
tkgrid(tklabel(RhabillageFrame, text=.Facto_gettext("Coloring for individuals"))) #settings: text
tkgrid(listgraph, scrgraph, sticky = "nw") #list box and scroll bar
tkgrid.configure(scrgraph, sticky = "wns") #configuration for scroll bar
tkgrid.configure(listgraph, sticky = "ew") #config for list box
RlimFrame<-tkframe(PlotIndFrame,borderwidth=2) #new frame for x and y limits
if(is.null(RXlimInd)) XlimIndMin<-tclVar("") #if nothing is written, XlimIndMin=NULL
else XlimIndMin<-tclVar(paste(RXlimInd[1])) #else it equal to RXlimInd
XlimIndMin.entry <-tkentry(RlimFrame,width="5",textvariable=XlimIndMin) #entry for x minimum limit value
if (is.null(RXlimInd)) XlimIndMax<- tclVar("") #same for x maximum limit
else XlimIndMax<-tclVar(paste(RXlimInd[1]))
XlimIndMax.entry <-tkentry(RlimFrame,width="5",textvariable=XlimIndMax)
tkgrid(tklabel(RlimFrame,text=.Facto_gettext("x limits of the graph:")),XlimIndMin.entry, XlimIndMax.entry) #positionning of text, entry for min and entry for max limits for axis x
if(is.null(RYlimInd)) YlimIndMin<- tclVar("") #same for y axis
else YlimIndMin<-tclVar(paste(RYlimInd[1]))
YlimIndMin.entry <-tkentry(RlimFrame,width="5",textvariable=YlimIndMin)
if (is.null(RYlimInd)) YlimIndMax<- tclVar("")
else YlimIndMax<-tclVar(paste(RYlimInd[2]))
YlimIndMax.entry <-tkentry(RlimFrame,width="5",textvariable=YlimIndMax)
tkgrid(tklabel(RlimFrame,text=.Facto_gettext("y limits of the graph:")),YlimIndMin.entry,YlimIndMax.entry)
#mise en page des differents frames de PlotIndFrame
tkgrid(RchoixFrame) #positionning of the different frames:
tkgrid(RTitleFrame) #title frame
tkgrid(RinvisibleFrame) #invisible elements frame
tkgrid(RlabelFrame) #labels frame
tkgrid(tklabel(PlotIndFrame, text=" ")) #blank line
tkgrid(RcolFrame) #colors frame
tkgrid(RhabillageFrame) #coloring frame
tkgrid(tklabel(PlotIndFrame, text=" ")) #blank line
tkgrid(RlimFrame) #axes limits frame
tkgrid(tklabel(PlotIndFrame, text=" ")) #blank line
# construction de la partie graphique des variables
PlotVarFrame<-tkframe(PlotWin, borderwidth=5, relief="groove") #frame for all the choices for the variables graph
WchoixFrame<-tkframe(PlotVarFrame,borderwidth=2)
var.check<-tkcheckbutton(WchoixFrame) #frame for choosing whether or not to plot the variables graph
if(Wchoix) var.check.value<-tclVar("1") #1 if yes
else var.check.value<-tclVar("0") #else 0
tkconfigure(var.check, variable=var.check.value) #assigning value to check button (appears clicked or unclicked
tkgrid(tklabel(WchoixFrame, text=.Facto_gettext("Plot variables graph"), font=font2),var.check) #positionning
tkgrid(tklabel(WchoixFrame, text=" ")) #blank line
WTitleFrame<-tkframe(PlotVarFrame,borderwidth=2) #title frame
if (is.null(WTitle)) WTitre <- tclVar(" ")
else WTitre<-tclVar(WTitle)
WTitre.entry <-tkentry(WTitleFrame,width="40",textvariable=WTitre)
tkgrid(tklabel(WTitleFrame,text=.Facto_gettext("Title of the graph")),WTitre.entry)
WcosFrame<-tkframe(PlotVarFrame,borderwidth=2) #cos2 frame
WlimCosValue<-tclVar(paste(Wlim.cos)) #WlimCosValue=default value at first
WlimCos.entry<-tkentry(WcosFrame, width=5, textvariable=WlimCosValue) #creation of the entry for the user to type a value
tkgrid(tklabel(WcosFrame,text=.Facto_gettext("Draw variables with a cos2 >:")),WlimCos.entry) #positionning text and entry in the frame
WlabelFrame<-tkframe(PlotVarFrame,borderwidth=2) #labels frame
label.var.check<-tkcheckbutton(WlabelFrame)
if ("var" %in% Wlabel) label.var.checkValue<-tclVar("1")
else label.var.checkValue<-tclVar("0")
tkconfigure(label.var.check, variable=label.var.checkValue)
tkgrid(tklabel(WlabelFrame, text=.Facto_gettext("Labels for the active variables")),label.var.check)
label.quanti.sup.check<-tkcheckbutton(WlabelFrame)
if ("quanti.sup" %in% Wlabel) label.quanti.sup.checkValue<-tclVar("1")
else label.quanti.sup.checkValue<-tclVar("0")
tkconfigure(label.quanti.sup.check, variable=label.quanti.sup.checkValue)
if(!is.null(variableillu)) tkgrid(tklabel(WlabelFrame, text=.Facto_gettext("Labels for the supplementary variables")),label.quanti.sup.check)
WcolFrame<-tkframe(PlotVarFrame,borderwidth=2) #color frame
Wcol.var.value <- Wcol.var
canvas.var <- tkcanvas(WcolFrame,width="80",height="25",bg=Wcol.var.value)
ChangeColor.var <- function()
{
Wcol.var.value<-tclvalue(tcl("tk_chooseColor",initialcolor=Wcol.var.value,title=.Facto_gettext("Choose a color")))
if (nchar(Wcol.var.value)>0) {
tkconfigure(canvas.var,bg=Wcol.var.value)
assign("Wcol.var.tmp", Wcol.var.value, envir=env)
}
}
ChangeColor.var.button <- tkbutton(WcolFrame,text=.Facto_gettext("Change Color"),command=ChangeColor.var)
tkgrid(tklabel(WcolFrame, text=.Facto_gettext("Color for active variables")),canvas.var,ChangeColor.var.button)
Wcol.quanti.sup.value<-Wcol.quanti.sup
canvas.quanti.sup <- tkcanvas(WcolFrame,width="80",height="25",bg=Wcol.quanti.sup.value)
ChangeColor.quanti.sup <- function()
{
Wcol.quanti.sup.value<-tclvalue(tcl("tk_chooseColor",initialcolor=Wcol.quanti.sup.value,title=.Facto_gettext("Choose a color")))
if (nchar(Wcol.quanti.sup.value)>0) {
tkconfigure(canvas.quanti.sup,bg=Wcol.quanti.sup.value)
assign("Wcol.quanti.sup.tmp", Wcol.quanti.sup.value, envir=env)
}
}
ChangeColor.quanti.sup.button <- tkbutton(WcolFrame,text=.Facto_gettext("Change Color"),command=ChangeColor.quanti.sup)
if(!is.null(variableillu)) tkgrid(tklabel(WcolFrame, text=.Facto_gettext("Color for supplementary variables")),canvas.quanti.sup,ChangeColor.quanti.sup.button)
#mise en page des differents frames de PlotVarFrame #positionning all frames
tkgrid(WchoixFrame) #plotting or not frame
tkgrid(WTitleFrame) #title frame
tkgrid(WcosFrame) #cos2 frame
tkgrid(WlabelFrame) #labels frame
tkgrid(tklabel(PlotVarFrame, text=" ")) #blank line
tkgrid(WcolFrame) #color frame
tkgrid(tklabel(PlotVarFrame, text=" ")) #blank line
subOKCancelHelp(PlotWin, "plot.PCA") #creating OK, Cancel and Help buttons. Help being associated to ?plot.PCA
tkgrid(PlotIndFrame,PlotVarFrame) #positionning of individuals and variables frames side by side
tkgrid.configure(PlotVarFrame, sticky="n")
tkgrid(subButtonsFrame, sticky="ew", columnspan=2) #positionning buttons OK, Cancel and Help
}
PlotFrame<-tkframe(IlluFrame) #new frame in the main window
Plot.but<-tkbutton(PlotFrame, textvariable=.PlotLabel, command=OnPlot, borderwidth=3) #creation of a new button in that new frame. Clicking on this button will open the window with graphical options
tkgrid(Plot.but, sticky="ew") #positionning the new button
})
#! fonction pour la reinitialisation des parametres
Reinitializ.funct<-function() #function to re-initialize everything
{
tkdestroy(top) #window is closed
FactoPCA() #and re-opened
}
#! fonction pour le choix des elements de sortie #choice of output options
Sortie.funct<-defmacro(label, firstLabel, expr=
{
env<-environment()
compteur.sortie<-0
#declaration des variables
RFichier <- "" #write results in a file
Rpropre<-FALSE #print eigenvalues
Rvariable<-FALSE #print results for active variables
Rindividu<-FALSE #print results for active individuals
Rindsup<-FALSE #print results for supplementary individuals
Rquantisup<-FALSE #print results for supplementary variables
Rqualisup<-FALSE #print results for supplementary factors
Rdescdim<-FALSE #print results of the description of dimensions
.SortieLabel<-tclVar(paste(firstLabel, "", sep=" "))
OnSortie<-function() #function launched by clicking on the "outputs" button
{
SortieWin<-tktoplevel() #new tcltk window
tkwm.title(SortieWin,.Facto_gettext("Outputs")) #title
#creation de la fonction onOKsub
onOK.sortie<-function() #function launched by clicking on OK
{
assign("compteur.sortie", compteur.sortie+1, envir=env) #when clicking on OK, "compteur.sortie" goes from 0 to 1 and the "output" button of the main window becomes blue
if(compteur.sortie>0) tclvalue(.SortieLabel)<-paste(label, "", sep=" ")
tkconfigure(Sortie.but, fg="blue")
if(tclvalue(eigValue)=="1") assign("Rpropre", TRUE, envir=env) #if "eigenvalues" check button is checked, Rpropre is TRUE
else assign("Rpropre", FALSE, envir=env) #else it is FALSE
if(tclvalue(varValue)=="1") assign("Rvariable", TRUE, envir=env)
else assign("Rvariable", FALSE, envir=env)
if(tclvalue(indValue)=="1") assign("Rindividu", TRUE, envir=env)
else assign("Rindividu", FALSE, envir=env)
if(tclvalue(ind.sup.Value)=="1") assign("Rindsup", TRUE, envir=env)
else assign("Rindsup", FALSE, envir=env)
if(tclvalue(quanti.sup.Value)=="1") assign("Rquantisup", TRUE, envir=env)
else assign("Rquantisup", FALSE, envir=env)
if(tclvalue(quali.sup.Value)=="1") assign("Rqualisup", TRUE, envir=env)
else assign("Rqualisup", FALSE, envir=env)
if(tclvalue(descdimValue)=="1") assign("Rdescdim", TRUE, envir=env)
else assign("Rdescdim", FALSE, envir=env)
if (tclvalue(Fichier)=="") assign("RFichier", NULL, envir=env)
assign("RFichier", tclvalue(Fichier), envir=env)
tkdestroy(SortieWin)
}
eig.lab <-tklabel(SortieWin, text=.Facto_gettext("Eigenvalues")) #label for the "eigenvalues" check button
eig.check <- tkcheckbutton(SortieWin) #creation of the check button
if(Rpropre) eigValue <- tclVar("1") #variable eigValue is equal to 1 or 0 according to the value or Rpropre
else eigValue <- tclVar("0")
tkconfigure(eig.check,variable=eigValue) #the button appears checked or unchecked according to eigValue
var.lab<-tklabel(SortieWin,text=.Facto_gettext("Results for active variables"))
var.check <- tkcheckbutton(SortieWin)
if(Rvariable) varValue <- tclVar("1")
else varValue <- tclVar("0")
tkconfigure(var.check,variable=varValue)
ind.lab<-tklabel(SortieWin,text=.Facto_gettext("Results for active individuals"))
ind.check <- tkcheckbutton(SortieWin)
if(Rindividu) indValue <- tclVar("1")
else indValue <- tclVar("0")
tkconfigure(ind.check,variable=indValue)
ind.sup.lab<-tklabel(SortieWin,text=.Facto_gettext("Results for supplementary individuals"))
ind.sup.check <- tkcheckbutton(SortieWin)
if(Rindsup) ind.sup.Value <- tclVar("1")
else ind.sup.Value <- tclVar("0")
tkconfigure(ind.sup.check,variable=ind.sup.Value)
quanti.sup.lab<-tklabel(SortieWin,text=.Facto_gettext("Results for supplementary variables"))
quanti.sup.check <- tkcheckbutton(SortieWin)
if(Rquantisup) quanti.sup.Value <- tclVar("1")
else quanti.sup.Value <- tclVar("0")
tkconfigure(quanti.sup.check,variable=quanti.sup.Value)
quali.sup.lab<-tklabel(SortieWin,text=.Facto_gettext("Results for supplementary factors"))
quali.sup.check <- tkcheckbutton(SortieWin)
if(Rqualisup) quali.sup.Value <- tclVar("1")
else quali.sup.Value <- tclVar("0")
tkconfigure(quali.sup.check,variable=quali.sup.Value)
descdim.lab<-tklabel(SortieWin, text=.Facto_gettext("Description of the dimensions"))
descdim.check<-tkcheckbutton(SortieWin)
if(Rdescdim) descdimValue<-tclVar("1")
else descdimValue<-tclVar("0")
tkconfigure(descdim.check,variable=descdimValue)
RFichierFrame<-tkframe(SortieWin,borderwidth=2)
if (is.null(RFichier)) Fichier <- tclVar("")
else Fichier<-tclVar(RFichier)
Fichier.entry <-tkentry(RFichierFrame,width="40",textvariable=Fichier)
tkgrid(tklabel(RFichierFrame,text=.Facto_gettext("Print results on a 'csv' file")),Fichier.entry)
SortieOK.but<-tkbutton(SortieWin,text="OK",width=16,command=onOK.sortie) #OK button associated to the function above
tkgrid(tklabel(SortieWin, text = .Facto_gettext("Select output options"), fg ="blue"), columnspan = 2, sticky = "w") #settings. Text
tkgrid(tklabel(SortieWin, text = " ")) #blank line
tkgrid(eig.lab,eig.check,sticky="w") #"eigenvalues" check button
tkgrid(var.lab,var.check,sticky="w") #"results for var" check button
tkgrid(ind.lab,ind.check,sticky="w") #"results for ind" check button
if (!is.null(individuillu)) tkgrid(ind.sup.lab,ind.sup.check,sticky="w") #"results for sup ind" check button if sup ind have been selected
if (!is.null(variableillu)) tkgrid(quanti.sup.lab,quanti.sup.check,sticky="w") #"results for sup var" check button if sup var have been selected
if (!is.null(variablefact)) tkgrid(quali.sup.lab,quali.sup.check,sticky="w") #"results for sup fact" check button if sup fact have been selected
tkgrid(descdim.lab,descdim.check,sticky="w") #"results for description of the dimension" check button
tkgrid(tklabel(SortieWin, text = " ")) #blank line
tkgrid(RFichierFrame) #frame for the option to print or not results in a file
tkgrid(SortieOK.but) #OK button
}
SortieFrame<-tkframe(IlluFrame) #new frame in the main window
Sortie.but<-tkbutton(SortieFrame, textvariable=.SortieLabel, command=OnSortie, borderwidth=3) #"output" button
tkgrid(Sortie.but, sticky="ew") #new button positionned in the new frame
})
#! fonction HCPC
Hcpc.funct<-defmacro(label, firstLabel, expr=
{
env<-environment()
.HcpcLabel<-tclVar(paste(firstLabel, "", sep=" "))
compteur.hcpc<-0
Rclassif<-0 #variable for the choice: perform HCPC or not
Rmeth <- -1 #variable for the choice of the method
Rconsolid<-0 #variable for the choice of consolidation
Rgraphhcpc<-1 #variable for graphs
Rreshcpc<-0 #variable for printing results
Rminhcpc<-3 #variable for the minimum nb of clusters
Rmaxhcpc<-10 #variable for the maximum nb of clusters
OnHCPC <- function() #function launched by clicking on "perform HCPC after PCA"
{
HcpcWin<-tktoplevel() #creation of a tcltk window
tkwm.title(HcpcWin, .Facto_gettext("HCPC options")) #title of the window
onOKHcpc <- function() #function launched by clicking on OK
{
assign("compteur.hcpc", compteur.hcpc+1, envir=env) #"perform HCPC after PCA" button becomes blue after licking on OK
if(compteur.hcpc>0) tclvalue(.HcpcLabel)<-paste(label, "", sep=" ")
tkconfigure(Hcpc.but, fg="blue")
if(tclvalue(methValue)=="0") assign("Rmeth", 0, envir=env) #assigning value to Rmeth: 0 or -1
else assign("Rmeth", -1, envir=env)
if(tclvalue(consolidValue)=="1") assign("Rconsolid",TRUE, envir=env) #assigning value to Rconsolid: TRUE or FALSE
else assign("Rconsolid",FALSE,envir=env)
if(tclvalue(graphhcpcValue)=="1") assign("Rgraphhcpc",TRUE,envir=env) #assigning value to Rgraphhcpc: TRUE or FALSE
else assign("Rgraphhcpc",FALSE,envir=env)
if(tclvalue(reshcpcValue)=="1") assign("Rreshcpc",TRUE,envir=env) #assigning value to Rreshcpc: TRUE or FALSE
else assign("Rreshcpc",FALSE,envir=env)
assign("Rminhcpc",as.numeric(tclvalue(minhcpc)),envir=env) #assigning value to Rminhcpc: numeric value
assign("Rmaxhcpc",as.numeric(tclvalue(maxhcpc)),envir=env) #assigning value to Rmaxhcpc: numeric value
assign("Rclassif",TRUE,envir=env) #assigning value to Rclassif: TRUE
tkdestroy(HcpcWin) #window is closed
}
OKHcpc.but<-tkbutton(HcpcWin, text="OK", width=8,command=onOKHcpc) #OK button
onCancelHcpc <- function() #function launched by clicking on Cancel button
{
assign("Rclassif",FALSE,envir=env) #Rclassif=FALSE
tkdestroy(HcpcWin) #the window is closed
}
CancelHcpc.but<-tkbutton(HcpcWin, text="Cancel", width=8,command=onCancelHcpc) #Cancel button
tkgrid(tklabel(HcpcWin, text="")) #settings: blank line
tkgrid(tklabel(HcpcWin, text = .Facto_gettext("Hierarchical Clustering on Principal Components"), fg = "darkred"), column=1, columnspan = 8, sticky = "ew") #settings: text
meth1 <- tkradiobutton (HcpcWin) #creation of a radio button
meth1.lab <- tklabel(HcpcWin,text=.Facto_gettext("interactive")) #label of the button
meth2 <- tkradiobutton (HcpcWin) #other radio button
meth2.lab <- tklabel(HcpcWin,text=.Facto_gettext("automatic")) #label
methValue <- tclVar(paste(Rmeth)) #variable associated with the radio buttons
meth.lab <- tklabel(HcpcWin,text=.Facto_gettext("Choice of the number of clusters:")) #main label
tkconfigure(meth1,variable=methValue,value="0") #assigning value to the first radio button
tkconfigure(meth2,variable=methValue,value="-1") #assigning value to the second radio button
minmaxhcpc.label<-tklabel(HcpcWin,text=.Facto_gettext("The optimal number of clusters is chosen between:")) #text for the choice of the nb of clusters
minhcpc<-tclVar(paste(Rminhcpc))
maxhcpc<-tclVar(paste(Rmaxhcpc))
minhcpc.entry <-tkentry(HcpcWin,width="3",textvariable=minhcpc) #text zone for the min nb
maxhcpc.entry <-tkentry(HcpcWin,width="3",textvariable=maxhcpc) #text zone for the max nb
consolid.lab <- tklabel(HcpcWin,text=.Facto_gettext("Consolidate clusters")) #label for consolidation
consolid.check <- tkcheckbutton(HcpcWin) #check button
if(Rconsolid) consolidValue<-tclVar("1") #assigning value according to Rconsolid's value
else consolidValue<-tclVar("0")
tkconfigure(consolid.check,variable=consolidValue) #assigning consolidValue to the check button
graphhcpc.lab <- tklabel(HcpcWin,text=.Facto_gettext("Print graphs")) #label for graphs
graphhcpc.check <- tkcheckbutton(HcpcWin) #check button
if(Rgraphhcpc) graphhcpcValue <- tclVar("1") #value depending on Rgraphhcpc
else graphhcpcValue <- tclVar("0")
tkconfigure(graphhcpc.check,variable=graphhcpcValue) #assigning graphhcpcValue to the check button
reshcpc.lab <- tklabel(HcpcWin,text=.Facto_gettext("Print results for clusters")) #label
reshcpc.check <- tkcheckbutton(HcpcWin) #check button
if(Rreshcpc) reshcpcValue<-tclVar("1") #value depending on Rreshcpc
else reshcpcValue <- tclVar("0")
tkconfigure(reshcpc.check,variable=reshcpcValue) #assigning reshcpcValue to the check button
tkgrid(tklabel(HcpcWin,text=.Facto_gettext("Options for the clustering"), fg = "blue"), column=1, columnspan=8, sticky="we") #settings: text
tkgrid(tklabel(HcpcWin,text=""),column=1,columnspan=4,sticky="w") #blank line
tkgrid(tklabel(HcpcWin,text=sprintf(.Facto_gettext("Clustering is performed on the first %s dimensions of PCA"),tclvalue(ncp.val))),column=1,columnspan=4,sticky="w") #text which takes the nb of dimensions chosen in the main window
# tkgrid(tklabel(HcpcWin,text=paste(.Facto_gettext("Clustering is performed on the first "),tclvalue(ncp.val), .Facto_gettext(" dimensions of PCA"),sep="")),column=1,columnspan=4,sticky="w") #text which takes the nb of dimensions chosen in the main window
tkgrid(tklabel(HcpcWin,text=.Facto_gettext("(Modify in the main options to change this number)")),column=1,columnspan=4,sticky="w") #text
tkgrid(tklabel(HcpcWin,text="")) #blank line
tkgrid(meth.lab,meth1.lab,meth1) #positionning text concerning the choice of the method and the first radio button side by side)
tkgrid(meth2.lab,meth2) #positionning radio button nb 2 and its label
tkgrid(tklabel(HcpcWin,text="")) #blank line
tkgrid(minmaxhcpc.label,minhcpc.entry , maxhcpc.entry) #positionning everything that concerns the nb of clusters
tkgrid(tklabel(HcpcWin,text="")) #blank line
tkgrid(consolid.lab,consolid.check) #positionning text and button for consolidation
tkgrid(graphhcpc.lab,graphhcpc.check) #positionning label and button for graphs
tkgrid(reshcpc.lab,reshcpc.check) #positionning label and button for results
tkgrid(tklabel(HcpcWin,text="")) #blank line
tkgrid(OKHcpc.but, CancelHcpc.but) #OK and Cancel buttons
tkgrid(tklabel(HcpcWin, text="")) #blank line
tkgrid.configure(minmaxhcpc.label,meth.lab,consolid.lab,graphhcpc.lab,reshcpc.lab,column=1,columnspan=4,sticky="w") #configuration of everything with the number of the column it will appear in (8 columns in a window) and the position in the column (w: west, e: east)
tkgrid.configure(minhcpc.entry,column=7,columnspan=1,sticky="e")
tkgrid.configure(maxhcpc.entry,column=8,columnspan=1,sticky="w")
tkgrid.configure(meth1,meth2,consolid.check,graphhcpc.check,reshcpc.check,column=8,sticky="e")
tkgrid.configure(meth1.lab,column=6,columnspan=2,sticky="w")
tkgrid.configure(meth2.lab,column=6,columnspan=2,sticky="w")
tkgrid.configure(OKHcpc.but,column=2,columnspan=1,sticky="w")
tkgrid.configure(CancelHcpc.but,column=6,columnspan=1,sticky="e")
tkgrid.columnconfigure(HcpcWin,0, minsize=3) #configuration of the size of some columns
tkgrid.columnconfigure(HcpcWin,5, minsize=5)
tkgrid.columnconfigure(HcpcWin,8, minsize=3)
}
Hcpc2Frame<-tkframe(HcpcFrame) #new frame in the HCPC frame
Hcpc.but<-tkbutton(Hcpc2Frame, textvariable=.HcpcLabel, command=OnHCPC, borderwidth=3) #button in this new frame
tkgrid(Hcpc.but, sticky="ew") #positionning the button
})
#! fonction associee au bouton Appliquer, execute sans detruire la fenetre top
OnAppliquer<-function() #funtion launched by clicking on "Apply"
{
# liste de toutes les variables interne creees (** mise en forme incomplete)
# sur la fenetre principale
# listdesc **
# resu.val **
# ncp.val **
# reduitValue **
# Axe1
# Axe2
# dans les boutons des fenetres illustratives
# variablefact **
# variableillu **
# individuillu **
# dans le bouton Plot PCA
# Rchoix
# RTitle
# Rlabel
# Rcol.ind
# Rcol.ind.sup
# Rcol.quali
# Rhabillage **
# RXlimInd
# RYlimInd
# Wchoix
# WTitle
# Wlabel
# Wlim.cos
# Wcol.quanti.sup
# Wcol.var
# WXlimVar
# WYlimVar
# dans le bouton affichage sortie
# Rpropre
# Rvariable
# Rindividu
# Rindsup
# Rquantisup
# Rqualisup
# recuperation des parametres de la fenetre principale
nom.res<-tclvalue(resu.val) #putting resu.val in nom.res
if (length(which(ls(envir = .GlobalEnv, all.names = TRUE)==nom.res))>0) justDoIt(paste('remove (',nom.res,')')) #if object res already exists, it's removed
if(length(as.numeric(tkcurselection(listdesc)))<2) varActives<-listdesc.nom
else varActives<-listdesc.nom[as.numeric(tkcurselection(listdesc))+1]
varActives <- varActives[!(varActives%in%variableillu)] #varActives is the list of selected active variables
reduction<-TRUE #scaling=T by default
if(tclvalue(reduitValue)=="0") reduction<-FALSE #if "sclaing" check button is unchecked, scaling=F
ncp<-as.numeric(tclvalue(ncp.val)) #putting chosen nb of dim in ncp
Axe<-c(as.numeric(tclvalue(Axe1)), as.numeric(tclvalue(Axe2))) #putting chosen axes in Axe
# gestion du tableau de donnees pour l'ACP
if(!is.null(individuillu)) { #if sup ind have been chosen, active ind are the remaining ones
ind.actif<-rows[-which(rows %in% individuillu)]
if(!is.null(variableillu)) { #a new dataset is created by the function commande.data which uses everything concerning active and supplementary variables and individuals. Different cases are separated according to presence or absence of those elements
if(!is.null(variablefact)) commande.data<-paste(activeDataSet(),'.', 'PCA', '<-', activeDataSet(), '[c("', paste(ind.actif, collapse='", "'), '", "', paste(individuillu, collapse='", "'), '") ,c("', paste(varActives, collapse='", "'), '", "', paste(variableillu, collapse='", "'), '", "', paste(variablefact, collapse='", "'), '")]', sep="")
else commande.data<-paste(activeDataSet(),'.', 'PCA', '<-', activeDataSet(), '[c("', paste(ind.actif, collapse='", "'), '", "', paste(individuillu, collapse='", "'), '") ,c("', paste(varActives, collapse='", "'), '", "', paste(variableillu, collapse='", "'), '")]', sep="")
}
else {
if(!is.null(variablefact)) commande.data<-paste(activeDataSet(),'.', 'PCA', '<-', activeDataSet(), '[c("', paste(ind.actif, collapse='", "'), '", "', paste(individuillu, collapse='", "'), '") ,c("', paste(varActives, collapse='", "'), '", "', paste(variablefact, collapse='", "'), '")]', sep="")
else commande.data<-paste(activeDataSet(),'.', 'PCA', '<-', activeDataSet(), '[c("', paste(ind.actif, collapse='", "'), '", "', paste(individuillu, collapse='", "'), '") ,c("', paste(varActives, collapse='", "'), '")]', sep="")
}
}
else
{
if(!is.null(variableillu)) {
if(!is.null(variablefact)) commande.data<-paste(activeDataSet(),'.', 'PCA', '<-', activeDataSet(), '[, c("', paste(varActives, collapse='", "'), '", "', paste(variableillu, collapse='", "'), '", "', paste(variablefact, collapse='", "'), '")]', sep="")
else commande.data<-paste(activeDataSet(),'.', 'PCA', '<-', activeDataSet(), '[, c("', paste(varActives, collapse='", "'), '", "', paste(variableillu, collapse='", "'), '")]', sep="")
}
else {
if(!is.null(variablefact)) commande.data<-paste(activeDataSet(),'.', 'PCA', '<-', activeDataSet(), '[, c("', paste(varActives, collapse='", "'), '", "', paste(variablefact, collapse='", "'), '")]', sep="")
else commande.data<-paste(activeDataSet(),'.', 'PCA', '<-', activeDataSet(), '[, c("', paste(varActives, collapse='", "'), '")]', sep="")
}
}
justDoIt(commande.data) #commande.data is launched
logger(commande.data)
donnee.depart<-activeDataSet()
activeDataSet(paste(activeDataSet(),'.', 'PCA', sep="")) #the new dataset (where columns and rows have been re-ordered) is called dataset_name.PCA
# gestion de la commande realisant l'ACP
if(!is.null(individuillu)) {
ind.actif<-rows[-which(rows %in% individuillu)]
if(!is.null(variableillu)) { #PCA is performed by commande.acp which uses the name of the active dataset (created right above), scale.unit, ncp, ind.sup, quanti.sup and quali.sup. graph is FALSE by default
if(!is.null(variablefact)) commande.acp<-paste(nom.res, '<-PCA(', activeDataSet(), ', scale.unit=', reduction, ', ncp=', ncp, ', ind.sup=c(', nrow(get(getRcmdr(".activeDataSet")))-length(individuillu)+1, ': ', nrow(get(getRcmdr(".activeDataSet"))), '), quanti.sup=c(', length(varActives)+1, ': ', length(varActives)+ length(variableillu), '), quali.sup=c(', length(varActives)+length(variableillu)+1, ': ', length(varActives)+length(variableillu)+length(variablefact), '), graph = FALSE)', sep="")
else commande.acp<-paste(nom.res, '<-PCA(', activeDataSet(), ', scale.unit=', reduction, ', ncp=', ncp, ', ind.sup=c(', nrow(get(getRcmdr(".activeDataSet")))-length(individuillu)+1, ': ', nrow(get(getRcmdr(".activeDataSet"))), '), quanti.sup=c(', length(varActives)+1, ': ', length(varActives)+ length(variableillu), '), graph = FALSE)', sep="")
}
else {
if(!is.null(variablefact)) commande.acp<-paste(nom.res, '<-PCA(', activeDataSet(), ', scale.unit=', reduction, ', ncp=', ncp, ', ind.sup=c(', nrow(get(getRcmdr(".activeDataSet")))-length(individuillu)+1, ': ', nrow(get(getRcmdr(".activeDataSet"))), '), quali.sup=c(', length(varActives)+1, ': ', length(varActives)+length(variablefact), '), graph = FALSE)', sep="")
else commande.acp<-paste(nom.res, '<-PCA(', activeDataSet(), ', scale.unit=', reduction, ', ncp=', ncp, ', ind.sup=c(', nrow(get(getRcmdr(".activeDataSet")))-length(individuillu)+1, ': ', nrow(get(getRcmdr(".activeDataSet"))), '), graph = FALSE)', sep="")
}
}
else {
if(!is.null(variableillu)) {
if(!is.null(variablefact)) commande.acp<-paste(nom.res, '<-PCA(', activeDataSet(), ' , scale.unit=', reduction, ', ncp=', ncp, ', quanti.sup=c(', length(varActives)+1, ': ', length(varActives)+ length(variableillu), '), quali.sup=c(', length(varActives)+length(variableillu)+1, ': ', length(varActives)+length(variableillu)+length(variablefact), '), graph = FALSE)', sep="")
else commande.acp<-paste(nom.res, '<-PCA(', activeDataSet(), ' , scale.unit=', reduction, ', ncp=', ncp, ', quanti.sup=c(', length(varActives)+1, ': ', length(varActives)+ length(variableillu), '), graph = FALSE)', sep="")
}
else{
if(!is.null(variablefact)) commande.acp<-paste(nom.res, '<-PCA(', activeDataSet(), ' , scale.unit=', reduction, ', ncp=', ncp, ', quali.sup=c(', length(varActives)+1, ': ', length(varActives)+length(variablefact), '), graph = FALSE)', sep="")
else commande.acp<-paste(nom.res, '<-PCA(', activeDataSet(), ' , scale.unit=', reduction, ', ncp=', ncp, ', graph = FALSE)', sep="")
}
}
justDoIt(commande.acp) #commande.acp is performed
logger(commande.acp)
justDoIt(paste(nom.res,'$call$call <-',deparse(commande.acp),sep=""))
#Commande de la fonction HCPC
if(Rclassif==TRUE){ #if Rclassif is TRUE then HCPC is performed with options chosen by the user
commande.hcpc<-paste(nom.res,'.hcpc', '<-HCPC(', nom.res, ' ,nb.clust=', Rmeth, ',consol=', Rconsolid,',min=', Rminhcpc,',max=',Rmaxhcpc,',graph=', Rgraphhcpc, ')', sep="")
justDoIt(commande.hcpc)
logger(commande.hcpc)
if ((Axe[1]!=1)||(Axe[2]!=2)){
command.plothcpc <- paste('plot(',nom.res,'.hcpc, axes=c(', paste(Axe, collapse=", "), '),new.plot=TRUE)',sep="")
justDoIt(command.plothcpc)
logger(command.plothcpc)
command.plothcpc2 <- paste('plot(',nom.res,'.hcpc, choice="map",axes=c(', paste(Axe, collapse=", "), '),draw.tree=FALSE, new.plot=TRUE)',sep="")
justDoIt(command.plothcpc2)
logger(command.plothcpc2)
}
if(Rreshcpc==TRUE){ #if Rreshcpc is TRUE then results are printed
doItAndPrint(paste(nom.res,'.hcpc$data.clust[,ncol(res.hcpc$data.clust),drop=F]', sep=""))
doItAndPrint(paste(nom.res,'.hcpc$desc.var', sep=""))
doItAndPrint(paste(nom.res,'.hcpc$desc.axes', sep=""))
doItAndPrint(paste(nom.res,'.hcpc$desc.ind', sep=""))
}
}
# gestion des graphiques
if (length(which(ls(envir = .GlobalEnv, all.names = TRUE)==nom.res))>0) {if (get(nom.res)$eig[1,2]==100) doItAndPrint(paste('"No graph can be plot: data are unidimensional"'))} #error message in case data are unidimensional
if((Rchoix)&length(which(ls(envir = .GlobalEnv, all.names = TRUE)==nom.res))>0){ #command for the graph of individuals
if (get(nom.res)$eig[1,2]!=100) {
if ((Rhabillage!="none") & (Rhabillage!="ind")) {
Rhabillage<-which(colnames(get(getRcmdr(".activeDataSet")))==Rhabillage)
if(length(Rhabillage)==0) Rhabillage<-"none"
}
if (Rhabillage=="none") Rhabillage<-paste('"', Rhabillage, '"', sep="")
if (Rhabillage=="ind") Rhabillage<-paste('"', Rhabillage, '"', sep="")
commande.plotInd<-paste('plot.PCA(', nom.res, ', axes=c(', paste(Axe, collapse=", "), '), choix="ind", habillage=', Rhabillage, ', col.ind="', Rcol.ind, '", col.ind.sup="', Rcol.ind.sup, '", col.quali="', Rcol.quali, '", label=c("', paste(Rlabel, collapse='", "'), '"),new.plot=TRUE', sep="")
if (!is.null(RXlimInd)) commande.plotInd<-paste(commande.plotInd, ', xlim=c(', paste(RXlimInd, collapse=", "), ')')
if (!is.null(RYlimInd)) commande.plotInd<-paste(commande.plotInd, ', ylim=c(', paste(RYlimInd, collapse=", "), ')')
if (!is.null(Rinvisible)) commande.plotInd<-paste(commande.plotInd, ', invisible=c("', paste(Rinvisible, collapse='", "'),'")', sep='')
if (is.null(RTitle)) commande.plotInd <- paste(commande.plotInd,')', sep="")
else {
if (RTitle ==" ") commande.plotInd <- paste(commande.plotInd,')', sep="")
else commande.plotInd <- paste(commande.plotInd,', title="', RTitle,'")', sep="")
}
commande.plotInd <- paste0("print(",commande.plotInd,")")
justDoIt(commande.plotInd)
logger(commande.plotInd)
}}
if((Wchoix)&length(which(ls(envir = .GlobalEnv, all.names = TRUE)==nom.res))>0){ #command for the graph of variables
if (get(nom.res)$eig[1,2]!=100) {
commande.plotVar<-paste('plot.PCA(', nom.res, ', axes=c(', paste(Axe, collapse=", "), '), choix="var", new.plot=TRUE, col.var="', Wcol.var, '", col.quanti.sup="', Wcol.quanti.sup, '", label=c("', paste(Wlabel, collapse='", "'), '"), lim.cos2.var=', Wlim.cos, sep="")
if (is.null(WTitle)) commande.plotVar <- paste(commande.plotVar,')', sep="")
else {
if (WTitle ==" ") commande.plotVar <- paste(commande.plotVar,')', sep="")
else commande.plotVar <- paste(commande.plotVar,', title="', WTitle,'")', sep="")
}
commande.plotVar <- paste0("print(",commande.plotVar,")")
justDoIt(commande.plotVar)
logger(commande.plotVar)
}}
# gestion de l'edition de certains resultats
doItAndPrint(paste('summary(',nom.res,', nb.dec = 3, nbelements=10, nbind = 10, ncp = 3, file="")', sep=""))
if (RFichier==""){ #printing the results
if(Rpropre) doItAndPrint(paste( nom.res, '$eig', sep=""))
if(Rvariable) doItAndPrint(paste( nom.res, '$var', sep=""))
if(Rindividu) doItAndPrint(paste( nom.res, '$ind', sep=""))
if(Rindsup) doItAndPrint(paste( nom.res, '$ind.sup', sep=""))
if(Rquantisup) doItAndPrint(paste( nom.res, '$quanti.sup', sep=""))
if(Rqualisup) doItAndPrint(paste( nom.res, '$quali.sup', sep=""))
if(Rdescdim) doItAndPrint( paste('dimdesc(', nom.res, ', axes=1:',ncp,')', sep=""))
}
else { #or saving them in a file
Fich = RFichier
if (substr(Fich,1,1)!='"') Fich = paste('"',Fich,sep='')
if (substr(Fich,nchar(Fich),nchar(Fich))!='"') Fich = paste(Fich,'"',sep='')
append = FALSE
if(Rpropre){
doItAndPrint(paste('write.infile(', nom.res, '$eig, file =',Fich,',append=',append,')', sep=""))
append = TRUE
}
if(Rvariable){
doItAndPrint(paste('write.infile(', nom.res, '$var, file =',Fich,',append=',append,')', sep=""))
append = TRUE
}
if(Rindividu){
doItAndPrint(paste('write.infile(', nom.res, '$ind, file =',Fich,',append=',append,')', sep=""))
append = TRUE
}
if(Rindsup){
doItAndPrint(paste('write.infile(', nom.res, '$ind.sup, file =',Fich,',append=',append,')', sep=""))
append = TRUE
}
if(Rquantisup){
doItAndPrint(paste('write.infile(', nom.res, '$quanti.sup, file =',Fich,',append=',append,')', sep=""))
append = TRUE
}
if(Rqualisup){
doItAndPrint(paste('write.infile(', nom.res, '$quali.sup, file =',Fich,',append=',append,')', sep=""))
append = TRUE
}
if(Rdescdim) doItAndPrint(paste('write.infile(dimdesc(', nom.res, ', axes=1:',ncp,'), file =',Fich,',append=',append,')', sep=""))
}
# Re-chargement du tableau de depart et supression du tableau temporaire
activeDataSet(donnee.depart) #reloading of the "real" dataset
justDoIt(paste('remove(',activeDataSet(),'.PCA)',sep="")) #the new one is removed
logger(paste('remove(',activeDataSet(),'.PCA)',sep=""))
}
#! fonction associee au bouton OK, execute et detruit l'interface graphique #function associated with the OK button
onOK<-function()
{
OnAppliquer() #OnAppliquer function is performed
closeDialog(top) #then window is closed
}
################################################################################
# Creation de la fenetre top # #creation of the main window
################################################################################
top<-tktoplevel(borderwidth=10) #tcltk window
tkwm.title(top, .Facto_gettext("PCA")) #title
tkwm.geometry(top, "-100+50") #size
# definition des polices
font2<-tkfont.create(family="times",size=12,weight="bold") #font for subtitles
fontheading<-tkfont.create(family="times",size=18,weight="bold") #font for titles
# recuperation du jeu de donnees actif
donnee<-get(getRcmdr(".activeDataSet")) #getting active dataset
vars<-colnames(donnee) #getting variables names
rows<-rownames(donnee) #getting individuals names
# creation de la liste pour le choix des variables acives
listdesc<-tklistbox(top,selectmode="extended",exportselection="FALSE",yscrollcommand=function(...)tkset(scr,...)) #empty list box for active variables
scr <-tkscrollbar(top,repeatinterval=5,command=function(...)tkyview(listdesc,...)) #scroll bar
listdesc.nom<-NULL
for (i in (1:ncol(donnee))) { #putting variables in the list box
if (is.numeric(donnee[,i])) {
tkinsert(listdesc,"end",vars[i])
listdesc.nom<-c(listdesc.nom, vars[i])
}
}
# creation de tous les boutons d'options dans IlluFrame
IlluFrame<- tkframe(top, borderwidth=2) #new frame in the top window
# mise en page de IlluFrame
Fillu.funct(label=.Facto_gettext("Supplementary factors"), firstLabel=.Facto_gettext("Supplementary factors")) #labels for the "select sup fact" button: firstlabel is the default label, label is the label which appears after the selection of sup fact(after clicking on OK)
Dillu.funct(label=.Facto_gettext("Supplementary quantitative variables"), firstLabel=.Facto_gettext("Supplementary quantitative variables")) #same for sup var
Iillu.funct(label=.Facto_gettext("Supplementary individuals"), firstLabel=.Facto_gettext("Supplementary individuals")) #same for sup ind
PLOT.PCA(label=.Facto_gettext("Graphical options"), firstLabel=.Facto_gettext("Graphical options"))
#same for graphical options
Sortie.funct(label=.Facto_gettext("Outputs"), firstLabel=.Facto_gettext("Outputs")) #same for outputs
tkgrid(FilluFrame, DilluFrame, IilluFrame, columnspan=7) #positionning buttons for supplementary elements
tkgrid(tklabel(IlluFrame, text="")) #blank line
tkgrid(PlotFrame, SortieFrame, columnspan=7) #buttons for graphical and output options and "reinitialize" button
tkgrid.configure(FilluFrame, column=1, columnspan=1) #configuration of each button
tkgrid.configure(PlotFrame, column=2, columnspan=2,sticky="we")
tkgrid.configure(SortieFrame, column=4, columnspan=2,sticky="ew")
tkgrid.configure(DilluFrame, column=3, columnspan=1)
tkgrid.configure(IilluFrame, column=5, columnspan=1)
tkgrid.columnconfigure(IlluFrame,0, minsize=25) #configuration of columns
tkgrid.columnconfigure(IlluFrame,7, minsize=25)
tkgrid.columnconfigure(IlluFrame,2, minsize=40)
tkgrid.columnconfigure(IlluFrame,4, minsize=40)
# creation des options dans OptionFrame #options frame
OptionFrame<-tkframe(top, borderwidth=2, relief="groove") #creation of a new frame
resu.lab<-tklabel(OptionFrame,text=.Facto_gettext("Name of the result object:")) #label for result's name
resu.val<-tclVar("res") #default value for result's name
resu<-tkentry(OptionFrame,width=10,textvariable=resu.val) #entry for result's name
ncp.lab<-tklabel(OptionFrame,text=.Facto_gettext("Number of dimensions:")) #label for the choice of the nb of dimensions
ncp.val<-tclVar("5") #default value
ncp<-tkentry(OptionFrame,width=5,textvariable=ncp.val) #entry
reduit.lab<-tklabel(OptionFrame,text=.Facto_gettext("Scale the variables:")) #label for scaling
reduit.check <- tkcheckbutton(OptionFrame) #checkbutton
reduitValue <- tclVar("1") #default value
tkconfigure(reduit.check,variable=reduitValue) #configuration
Axe.label<-tklabel(OptionFrame,text=.Facto_gettext("Graphical output: select the dimensions")) #label for axes
Axe1<-tclVar("1") #default value for first axes
Axe2<-tclVar("2") #default value for second axes
Axe1.entry <-tkentry(OptionFrame,width="5",textvariable=Axe1) #entry for first axes
Axe2.entry <-tkentry(OptionFrame,width="5",textvariable=Axe2) #entry for second axes
# mise en page de OptionFrame #settings
tkgrid(tklabel(OptionFrame,text=.Facto_gettext("Main options"), fg = "darkred"), columnspan=8, sticky="we") #text
tkgrid(tklabel(OptionFrame,text="")) #blank line
tkgrid(resu.lab, resu)
tkgrid(ncp.lab, ncp)
tkgrid(reduit.lab,reduit.check)
tkgrid(Axe.label,Axe1.entry , Axe2.entry, sticky="w")
tkgrid.configure(ncp.lab, reduit.lab, resu.lab, Axe.label, column=1, columnspan=4, sticky="w") #configuration
tkgrid.configure(ncp, reduit.check, resu, column=6, columnspan=2, sticky="e")
tkgrid.configure(Axe1.entry, column=6, columnspan=1, sticky="w")
tkgrid.configure(Axe2.entry, column=7, columnspan=1, sticky="e")
tkgrid.columnconfigure(OptionFrame,0, minsize=25) #columns' configuration
tkgrid.columnconfigure(OptionFrame,5, minsize=40)
tkgrid.columnconfigure(OptionFrame,8, minsize=25)
#Frame pour HCPC #HCPC frame
HcpcFrame<-tkframe(top, borderwidth=2)
Hcpc.funct(label=.Facto_gettext("Perform Clustering after PCA"), firstLabel=.Facto_gettext("Perform Clustering after PCA"))
tkgrid(Hcpc2Frame, columnspan=7)
tkgrid.configure(Hcpc2Frame,column=4, columnspan=1)
appliquer.but<-tkbutton(top, text=.Facto_gettext("Apply"),width=12,command=OnAppliquer, borderwidth=3, fg="#690f96") #"Apply" button
OKCancelHelp(helpSubject="PCA",reset="Reinitializ.funct") #OK, Cancel and Help button. Help leads to ?PCA
#TOP #settings of the main window
tkgrid(tklabel(top, text=.Facto_gettext("Principal Component Analysis (PCA)"),font=fontheading),columnspan=3) #title
tkgrid(tklabel(top,text="")) #blank line
tkgrid(tklabel(top, text = .Facto_gettext("Select active variables (by default all the variables are active)"),fg = "darkred"), column=1,columnspan=2, sticky = "w") #text
tkgrid(listdesc, scr, sticky = "nw") #list box with available continuous variables and scroll bar
tkgrid.configure(scr, sticky = "ens",column=2)
tkgrid.configure(listdesc, sticky = "ew", column=1, columnspan=2)
tkgrid(tklabel(top,text="")) #blank line
tkgrid(IlluFrame, column=1, columnspan=1) #buttons for sup elements, graphical and output options and reinitialization
tkgrid(tklabel(top,text="")) #blank line
tkgrid(OptionFrame, column=1, columnspan=1) #options frame
tkgrid(tklabel(top,text="")) #blank line
tkgrid(HcpcFrame, column=1, columnspan=1) #HCPC frame
tkgrid(tklabel(top,text="")) #blank line
# tkgrid(appliquer.but, column=1, columnspan=1) #"Apply" button
# tkgrid(tklabel(top,text="")) #blank line
# tkgrid(buttonsFrame, column=1, columnspan=1, sticky="ew" ) #OK, Cancel and Help buttons
# tkgrid(tklabel(top,text="")) #blank line
tkgrid(buttonsFrame, appliquer.but)
tkgrid.configure(buttonsFrame, column=1,sticky="e")
tkgrid.configure(appliquer.but, column=2,sticky="w")
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.