R/resumenNumericoVContinua.R

Defines functions resumenNumericoVContinua

Documented in resumenNumericoVContinua

resumenNumericoVContinua <- function(){
  Library("abind")
  Library("e1071")
  
  dialogName <- "resumenNumericoVContinua"
  defaults <- list(initial.x=NULL,initial.sg2=gettext("<no variable selected>",domain="R-RcmdrPlugin.TeachStat"),
                   initial.tablafrecuencia="0", initial.valorcortes="",
                   initial.cortes.n="", initial.cortes.v="", initial.cortes.al="", initial.cortes.from="", initial.cortes.to="", initial.cortes.by="",
                   initial.mean="1",
                   initial.sd="1", initial.se.mean="0", initial.IQR="1", initial.cv="0",
                   initial.quantiles.variable="1",
                   initial.quantiles="0, .25, .5, .75, 1",
                   initial.skewness="0", initial.kurtosis="0", initial.type="2",
                   initial.tab=0)
  
  dialog.values <- getDialog(dialogName, defaults)
  initial.group <- dialog.values$initial.group
  initializeDialog(title=gettext("Numerical summaries - Continuous variables",domain="R-RcmdrPlugin.TeachStat"), use.tabs=TRUE, tabs=c("dataTab", "statisticsTab"))
  
  varFrame<-tkframe(dataTab)
  
  xBox <- variableListBox(varFrame, Numeric(), selectmode="multiple", title=gettext("Variables (pick one or more)",domain="R-RcmdrPlugin.TeachStat"),
                          initialSelection=varPosn(dialog.values$initial.x, "numeric"))
  
  if (length(Factors())!=0){
    mostrar<-"readonly"
  }else {
    mostrar<-"disabled"
  }
  
  selectGroupComboBox <- variableComboBox(varFrame, variableList=Factors(), state=mostrar,
                                          initialSelection=dialog.values$initial.sg2, title=gettext("Group (pick one)",domain="R-RcmdrPlugin.TeachStat"))
  
  
  stkFrame<-tkframe(dataTab)
  
  tablafrecuenciaVar<-tclVar(dialog.values$initial.tablafrecuencia)
  tablafrecuenciaCheckBox<-ttkcheckbutton(stkFrame, variable=tablafrecuenciaVar,text=gettext("Frequency table",domain="R-RcmdrPlugin.TeachStat"),
                                          command = function(){ if(tclvalue(tablafrecuenciaVar)=="1"){
                                            tk2state.set(ncortesRadioButton, state = "normal")
                                            tk2state.set(vcortesRadioButton, state = "normal")
                                            tk2state.set(alcortesRadioButton, state = "normal")
                                            tk2state.set(seqcortesRadioButton, state = "normal")
                                            tk2state.set(tocortesLabel, state = "normal")
                                            tk2state.set(bycortesLabel, state = "normal")
                                          } else{
                                            tk2state.set(ncortesRadioButton, state = "disabled")
                                            tk2state.set(ncortesEntry, state = "disabled")
                                            tk2state.set(vcortesRadioButton, state = "disabled")
                                            tk2state.set(vcortesEntry, state = "disabled")
                                            tk2state.set(alcortesRadioButton, state = "disabled")
                                            tk2state.set(alcortesEntry, state = "disabled")
                                            tk2state.set(seqcortesRadioButton, state = "disabled")
                                            tk2state.set(fromcortesEntry, state = "disabled")
                                            tk2state.set(tocortesEntry, state = "disabled")
                                            tk2state.set(tocortesLabel, state = "disabled")
                                            tk2state.set(bycortesEntry, state = "disabled")
                                            tk2state.set(bycortesLabel, state = "disabled")
                                            tclvalue(valorcortesVar)<-""
                                            tclvalue(nvalorcortesVar)<-""
                                            tclvalue(vvalorcortesVar)<-""
                                            tclvalue(alvalorcortesVar)<-""
                                            tclvalue(fromvalorcortesVar)<-""
                                            tclvalue(tovalorcortesVar)<-""
                                            tclvalue(byvalorcortesVar)<-""
                                          }
                                          })
  
  optcortesFrame<-tkframe(stkFrame)
  
  valorcortesVar<-tclVar(dialog.values$initial.valorcortes)
  
  if(dialog.values$initial.tablafrecuencia=="0"){
    mostrar_opcortes<-"disabled"
  }
  else{mostrar_opcortes<-"normal"}
  
  # number of breaks
  ncortesFrame<-tkframe(optcortesFrame)
  ncortesRadioButton <- ttkradiobutton(ncortesFrame, variable=valorcortesVar, text=gettext("Breaks number:",domain="R-RcmdrPlugin.TeachStat"), 
                                       value="ncortes",state=mostrar_opcortes,
                                       command=function(){ if(tclvalue(valorcortesVar)=="ncortes"){
                                         tk2state.set(ncortesEntry, state = "normal")
                                         tk2state.set(vcortesEntry, state = "disabled")
                                         tk2state.set(alcortesEntry, state = "disabled")
                                         tk2state.set(fromcortesEntry, state = "disabled")
                                         tk2state.set(tocortesEntry, state = "disabled")
                                         #tk2state.set(tocortesLabel, state = "disabled")
                                         tk2state.set(bycortesEntry, state = "disabled")
                                         #tk2state.set(bycortesLabel, state = "disabled")
                                         tclvalue(vvalorcortesVar)<-""
                                         tclvalue(alvalorcortesVar)<-""
                                         tclvalue(fromvalorcortesVar)<-""
                                         tclvalue(tovalorcortesVar)<-""
                                         tclvalue(byvalorcortesVar)<-""
                                       } else
                                       { tk2state.set(ncortesEntry, state = "disabled")
                                       }
                                       })
  
  
  if(dialog.values$initial.valorcortes=="ncortes"){
    mostrar<-"normal"
  }
  else{mostrar<-"disabled"}
  
  nvalorcortesVar <- tclVar(dialog.values$initial.cortes.n)
  ncortesEntry <- ttkentry(ncortesFrame, width="12", textvariable=nvalorcortesVar, state=mostrar)
  
  # Vector of breaks
  vcortesFrame<-tkframe(optcortesFrame)
  vcortesRadioButton <- ttkradiobutton(vcortesFrame, variable=valorcortesVar, text=gettext("Breaks vector:",domain="R-RcmdrPlugin.TeachStat"), 
                                       value="vcortes",state=mostrar_opcortes,
                                       command=function(){ if(tclvalue(valorcortesVar)=="vcortes"){
                                         tk2state.set(vcortesEntry, state = "normal")
                                         tk2state.set(ncortesEntry, state = "disabled")
                                         tk2state.set(alcortesEntry, state = "disabled")
                                         tk2state.set(fromcortesEntry, state = "disabled")
                                         tk2state.set(tocortesEntry, state = "disabled")
                                         #tk2state.set(tocortesLabel, state = "disabled")
                                         tk2state.set(bycortesEntry, state = "disabled")
                                         #tk2state.set(bycortesLabel, state = "disabled")
                                         tclvalue(nvalorcortesVar)<-""
                                         tclvalue(alvalorcortesVar)<-""
                                         tclvalue(fromvalorcortesVar)<-""
                                         tclvalue(tovalorcortesVar)<-""
                                         tclvalue(byvalorcortesVar)<-""
                                       } else
                                       { tk2state.set(vcortesEntry, state = "disabled")
                                       }
                                       })
  
  
  if(dialog.values$initial.valorcortes=="vcortes"){
    mostrar<-"normal"
  }
  else{mostrar<-"disabled"}
  
  vvalorcortesVar <- tclVar(dialog.values$initial.cortes.v)
  vcortesEntry <- ttkentry(vcortesFrame, width="12", textvariable=vvalorcortesVar, state=mostrar)
  
  # algorithm of breaks
  alcortesFrame<-tkframe(optcortesFrame)
  alcortesRadioButton <- ttkradiobutton(alcortesFrame, variable=valorcortesVar, text=gettext("Breaks algorithm:",domain="R-RcmdrPlugin.TeachStat"), 
                                        value="alcortes",state=mostrar_opcortes,
                                        command=function(){ if(tclvalue(valorcortesVar)=="alcortes"){
                                          tk2state.set(vcortesEntry, state = "disabled")
                                          tk2state.set(ncortesEntry, state = "disabled")
                                          tk2state.set(alcortesEntry, state = "normal")
                                          tk2state.set(fromcortesEntry, state = "disabled")
                                          tk2state.set(tocortesEntry, state = "disabled")
                                          #tk2state.set(tocortesLabel, state = "disabled")
                                          tk2state.set(bycortesEntry, state = "disabled")
                                          #tk2state.set(bycortesLabel, state = "disabled")
                                          tclvalue(nvalorcortesVar)<-""
                                          tclvalue(vvalorcortesVar)<-""
                                          tclvalue(fromvalorcortesVar)<-""
                                          tclvalue(tovalorcortesVar)<-""
                                          tclvalue(byvalorcortesVar)<-""
                                        } else
                                        { tk2state.set(alcortesEntry, state = "disabled")
                                        }
                                        })
  
  
  if(dialog.values$initial.valorcortes=="alcortes"){
    mostrar<-"normal"
  }
  else{mostrar<-"disabled"}
  
  alvalorcortesVar <- tclVar(dialog.values$initial.cortes.al)
  alcortesEntry <- ttkentry(alcortesFrame, width="12", textvariable=alvalorcortesVar, state=mostrar)
  
  # use of seq() for breaks
  seqcortesFrame<-tkframe(optcortesFrame)
  seqcortesRadioButton <- ttkradiobutton(seqcortesFrame, variable=valorcortesVar, text=gettext("From:",domain="R-RcmdrPlugin.TeachStat"), 
                                         value="seqcortes",state=mostrar_opcortes,
                                         command=function(){ if(tclvalue(valorcortesVar)=="seqcortes"){
                                           tk2state.set(vcortesEntry, state = "disabled")
                                           tk2state.set(ncortesEntry, state = "disabled")
                                           tk2state.set(alcortesEntry, state = "disabled")
                                           tk2state.set(fromcortesEntry, state = "normal")
                                           tk2state.set(tocortesEntry, state = "normal")
                                           #tk2state.set(tocortesLabel, state = "normal")
                                           tk2state.set(bycortesEntry, state = "normal")
                                           #tk2state.set(bycortesLabel, state = "normal")
                                           tclvalue(nvalorcortesVar)<-""
                                           tclvalue(vvalorcortesVar)<-""
                                           tclvalue(alvalorcortesVar)<-""
                                         } else
                                         { tk2state.set(fromcortesEntry, state = "disabled")
                                           tk2state.set(tocortesEntry, state = "disabled")
                                           #tk2state.set(tocortesLabel, state = "disabled")
                                           tk2state.set(bycortesEntry, state = "disabled")
                                           #tk2state.set(bycortesLabel, state = "disabled")
                                           tclvalue(valorcortesVar)<-""}
                                         })
  
  
  if(dialog.values$initial.valorcortes=="seqcortes"){
    mostrar<-"normal"
  }
  else{mostrar<-"disabled"}
  
  fromvalorcortesVar <- tclVar(dialog.values$initial.cortes.from)
  fromcortesEntry <- ttkentry(seqcortesFrame, width="12", textvariable=fromvalorcortesVar, state=mostrar)
  tovalorcortesVar <- tclVar(dialog.values$initial.cortes.to)
  tocortesLabel<-labelRcmdr(seqcortesFrame,text=gettext("to:",domain="R-RcmdrPlugin.TeachStat"),state=mostrar_opcortes)
  tocortesEntry <- ttkentry(seqcortesFrame, width="12", textvariable=tovalorcortesVar, state=mostrar)
  byvalorcortesVar <- tclVar(dialog.values$initial.cortes.by)
  bycortesEntry <- ttkentry(seqcortesFrame, width="12", textvariable=byvalorcortesVar, state=mostrar)
  bycortesLabel<-labelRcmdr(seqcortesFrame,text=gettext("by:",domain="R-RcmdrPlugin.TeachStat"),state=mostrar_opcortes)
  
  
  checkBoxes(window = statisticsTab, frame="checkBoxFrame", boxes=c("mean", "sd", "se.mean", "IQR", "cv"),
             initialValues=c(dialog.values$initial.mean, dialog.values$initial.sd, dialog.values$initial.se.mean, 
                             dialog.values$initial.IQR, dialog.values$initial.cv),
             labels=gettext(c("Mean", "Standard Deviation", "Standard Error of Mean", "Interquartile Range", 
                              "Coefficient of Variation"),domain="R-RcmdrPlugin.TeachStat"))
  skFrame <- tkframe(statisticsTab)
  checkBoxes(window = skFrame, frame="skCheckBoxFrame", boxes=c("skewness", "kurtosis"),
             initialValues=c(dialog.values$initial.skewness, dialog.values$initial.kurtosis),
             labels=gettext(c("Skewness", "Kurtosis"),domain="R-RcmdrPlugin.TeachStat"))
  radioButtons(window = skFrame, name="typeButtons", buttons=c("b1", "b2", "b3"), values=c("1", "2", "3"),
               initialValue=dialog.values$initial.type,
               labels=gettext(c("Type 1", "Type 2", "Type 3"),domain="R-RcmdrPlugin.TeachStat"))
  quantilesVariable <- tclVar(dialog.values$initial.quantiles.variable)
  quantilesFrame <- tkframe(statisticsTab)
  quantilesCheckBox <- tkcheckbutton(quantilesFrame, variable=quantilesVariable,
                                     text=gettext("Quantiles:",domain="R-RcmdrPlugin.TeachStat"))
  quantiles <- tclVar(dialog.values$initial.quantiles)
  quantilesEntry <- ttkentry(quantilesFrame, width="20", textvariable=quantiles)
  
  onOK <- function(){
    tab <- if (as.character(tkselect(notebook)) == dataTab$ID) 0 else 1
    x <- getSelection(xBox)
    sg2var <- getSelection(selectGroupComboBox)
    
    tfrec<-tclvalue(tablafrecuenciaVar)
    
    ### Cortes
    valorcortes<-tclvalue(valorcortesVar)
    nvalorcortes<-tclvalue(nvalorcortesVar)
    vvalorcortes<-tclvalue(vvalorcortesVar)
    alvalorcortes<-tclvalue(alvalorcortesVar)
    fromvalorcortes<-tclvalue(fromvalorcortesVar)
    tovalorcortes<-tclvalue(tovalorcortesVar)
    byvalorcortes<-tclvalue(byvalorcortesVar)
    
    quants <- tclvalue(quantiles)
    meanVar <- tclvalue(meanVariable)
    sdVar <- tclvalue(sdVariable)
    se.meanVar <- tclvalue(se.meanVariable)
    IQRVar <- tclvalue(IQRVariable)
    cvVar <- tclvalue(cvVariable)
    quantsVar <- tclvalue(quantilesVariable)
    skewnessVar <- tclvalue(skewnessVariable)
    kurtosisVar <- tclvalue(kurtosisVariable)
    typeVar <- tclvalue(typeButtonsVariable)
    putDialog(dialogName, list(
      initial.x=x,initial.sg2=sg2var,
      initial.tablafrecuencia=tfrec,initial.valorcortes=valorcortes,
      initial.cortes.n=nvalorcortes, initial.cortes.v=vvalorcortes, initial.cortes.al=alvalorcortes, initial.cortes.from=fromvalorcortes,
      initial.cortes.to=tovalorcortes, initial.cortes.by=byvalorcortes,
      initial.mean=meanVar, initial.sd=sdVar,
      initial.se.mean=se.meanVar, initial.IQR=IQRVar, initial.cv=cvVar,
      initial.quantiles.variable=quantsVar, initial.quantiles=quants,
      initial.skewness=skewnessVar, initial.kurtosis=kurtosisVar, initial.type=typeVar,
      initial.tab=tab
    ))
    
    closeDialog()
    
    dialogNameF <- get(dialogName,mode="function")
    
    if (length(x) == 0){
      errorCondition(recall=dialogNameF, message=gettext("No variable selected",domain="R-RcmdrPlugin.TeachStat"))
      return()
    }
    
    nvalorcortes <- as.numeric(nvalorcortes)
    vvalorcortes <- paste(gsub(",+", ",", gsub(" ", ",", vvalorcortes)), sep="")
    vvalorcortes<-as.numeric( strsplit(vvalorcortes,split=",")[[1]])
    fromvalorcortes <- as.numeric(fromvalorcortes)
    tovalorcortes <- as.numeric(tovalorcortes)
    byvalorcortes <- as.numeric(byvalorcortes)
    
    if(tfrec==1){
      if(valorcortes=="ncortes"){
        if(length(nvalorcortes)==0){
          errorCondition(recall=dialogNameF, message=gettext("Breaks number must be provided",domain="R-RcmdrPlugin.TeachStat"))
          return()
        }
        
        if(NA %in% nvalorcortes | length(nvalorcortes)>1 | (nvalorcortes%%1)!=0 | (nvalorcortes<=1)){
          errorCondition(recall=dialogNameF, message=gettext("Breaks number must be an integer > 1",domain="R-RcmdrPlugin.TeachStat"))
          return()
        } 
        
        # if (((nvalorcortes%%1)!=0)|(nvalorcortes<=1)){
        #   errorCondition(recall=dialogNameF, message=gettext("Breaks must be an integer > 1",domain="R-RcmdrPlugin.TeachStat"))
        #   return()
        # }
      } else if(valorcortes=="vcortes"){
        if(length(vvalorcortes)==0){
          errorCondition(recall=dialogNameF, message=gettext("Breaks vector must be provided",domain="R-RcmdrPlugin.TeachStat"))
          return()
        }
        
        if(NA %in% vvalorcortes | length(vvalorcortes)<=1){
          errorCondition(recall=dialogNameF, message=gettext("Breaks vector must be a numeric vector of length > 1",domain="R-RcmdrPlugin.TeachStat"))
          return()
        }
        
      } else if(valorcortes=="alcortes"){
        if(length(alvalorcortes)>1 | !(tolower(alvalorcortes)%in%c("sturges","fd", "freedman-diaconis", "scott"))){
          errorCondition(recall=dialogNameF, message=gettext("Breaks algorithm must be a name of a known 'breaks' algorithm",domain="R-RcmdrPlugin.TeachStat"))
          return()
        }
      } else if(valorcortes=="seqcortes"){
        if(length(fromvalorcortes)==0 & length(tovalorcortes)==0 & length(tovalorcortes)==0){
          errorCondition(recall=dialogNameF, message=gettext("'From', 'to' and 'by' must be provided",domain="R-RcmdrPlugin.TeachStat"))
          return()
        }
        
        if(NA %in% fromvalorcortes | length(fromvalorcortes)>1 | 
           NA %in% tovalorcortes | length(tovalorcortes)>1 | 
           NA %in% byvalorcortes | length(byvalorcortes)>1){
          errorCondition(recall=dialogNameF, message=gettext("'From', 'to' and 'by' must be numeric values",domain="R-RcmdrPlugin.TeachStat"))
          return()
        } 
        
      } else{
        errorCondition(recall=dialogNameF, message=gettext("A 'breaks' option must be selected",domain="R-RcmdrPlugin.TeachStat"))
        return()
      }
    }
    
    quants <- paste(gsub(",+", ",", gsub(" ", ",", quants)), sep="")
    
    quants <- as.numeric( strsplit(quants,split=",")[[1]])
    
    if(((NA %in% quants)||(length( quants[(quants<0)|(quants>1)])!=0) || length(quants)<1) &&(quantsVar==1)){
      errorCondition(recall=dialogNameF, message=gettext("Quantiles must be a numeric vector in [0,1]",
                                                         domain="R-RcmdrPlugin.TeachStat"))
      return()
    }
    
    if((length(quants)==0 )&&(quantsVar==1)){
      errorCondition(recall=dialogNameF, message=gettext("Quantiles must be a numeric vector in [0,1]",
                                                         domain="R-RcmdrPlugin.TeachStat"))
      return()
    }
    
    quants<-paste("c(",paste(quants, collapse=",", sep=""),")",sep="")
    
    .activeDataSet <- ActiveDataSet()
    vars <- if (length(x) == 1) paste('"', x, '"', sep="")
    else paste(",c(", paste('"', x, '"', collapse=", ", sep=""), ")", sep="")
    vars <- paste(.activeDataSet, "[", vars, "]", sep="")
    stats <- paste("c(",
                   paste(c('"mean"', '"sd"', '"se(mean)"', '"IQR"', '"quantiles"', '"cv"', '"skewness"', '"kurtosis"')
                         [c(meanVar, sdVar, se.meanVar, IQRVar, quantsVar, cvVar, skewnessVar, kurtosisVar) == 1],
                         collapse=", "), ")", sep="")
    if (stats == "c()"){
      errorCondition(recall=dialogNameF, message=gettext("No statistics selected",domain="R-RcmdrPlugin.TeachStat"))
      return()
    }
    type.text <- if (skewnessVar == 1 || kurtosisVar == 1) paste(', type="', typeVar, '"', sep="") else ""
    
    print_tabla_Frecuencia<-as.logical(as.numeric(tfrec))
    if(0 == tfrec) vcortes <-"NULL"
    else{
      vcortes <- if(valorcortes=="ncortes"){
        paste(nvalorcortes , sep="")
      } else if(valorcortes=="vcortes"){
        paste("c(", paste(vvalorcortes, collapse=",", sep=""), ")", sep="")
      } else if(valorcortes=="alcortes"){
        paste('"',alvalorcortes,'"', sep="")
      } else{
        paste("seq(from = ", fromvalorcortes,", to = ",tovalorcortes,", by = ",byvalorcortes, ")", sep="")
      }
    }
    
    command <- if (length(Factors())!=0 && sg2var!=gettext("<no variable selected>",domain="R-RcmdrPlugin.TeachStat")) {
      grps <- paste(.activeDataSet, "$", sg2var, sep="")
      paste("calcularResumenVariablesContinuas(data=", vars, ", groups=", grps, ", statistics=", stats,
            ", quantiles=", quants, type.text,", tablaFrecuencia=",print_tabla_Frecuencia,", cortes=",vcortes, ")", sep="")
    }
    else  paste("calcularResumenVariablesContinuas(data=", vars, ", statistics=", stats,
                ", quantiles=", quants, type.text,", tablaFrecuencia=",print_tabla_Frecuencia,", cortes=",vcortes, ")", sep="")
    doItAndPrint(command)
    tkfocus(CommanderWindow())
  }
  OKCancelHelp(helpSubject="calcularResumenVariablesContinuas", reset=dialogName, apply =dialogName)
  tkgrid(getFrame(xBox),labelRcmdr(varFrame, text="     "),getFrame(selectGroupComboBox),sticky="nw")
  tkgrid(varFrame, sticky="nw")
  tkgrid(labelRcmdr(stkFrame,text="  "),sticky="nw")
  tkgrid(ncortesRadioButton,labelRcmdr(ncortesFrame,text=" "),ncortesEntry,sticky="nw")
  tkgrid(ncortesFrame,sticky="nw")
  tkgrid(vcortesRadioButton,labelRcmdr(vcortesFrame,text=" "),vcortesEntry,sticky="nw")
  tkgrid(vcortesFrame,sticky="nw")
  tkgrid(alcortesRadioButton,labelRcmdr(alcortesFrame,text=" "),alcortesEntry,sticky="nw")
  tkgrid(alcortesFrame,sticky="nw")
  tkgrid(seqcortesRadioButton,labelRcmdr(seqcortesFrame,text=" "),fromcortesEntry,labelRcmdr(seqcortesFrame,text=" "),
         tocortesLabel,labelRcmdr(seqcortesFrame,text=" "),tocortesEntry,
         labelRcmdr(seqcortesFrame,text=" "),bycortesLabel,labelRcmdr(seqcortesFrame,text=" "),bycortesEntry,sticky="nw")
  tkgrid(seqcortesFrame,sticky="nw")
  tkgrid(tablafrecuenciaCheckBox,labelRcmdr(stkFrame,text=" "),optcortesFrame,sticky="nw")
  tkgrid(stkFrame, sticky="nw")
  
  
  tkgrid(checkBoxFrame, sticky="nw")
  tkgrid(skCheckBoxFrame, typeButtonsFrame, sticky="nw")
  tkgrid(skFrame, sticky="w")
  tkgrid(quantilesCheckBox, quantilesEntry, sticky="w")
  tkgrid(quantilesFrame)
  dialogSuffix(use.tabs=TRUE, grid.buttons=TRUE, tabs=c("dataTab", "statisticsTab"),
               tab.names=c("Data", "Statistics"))
}

Try the RcmdrPlugin.TeachStat package in your browser

Any scripts or data that you put into this service are public.

RcmdrPlugin.TeachStat documentation built on Nov. 14, 2023, 5:08 p.m.