version 0.1

cran · Jul 28, 2011 · 1111e5e · 1111e5e
commit 1111e5e
Show file tree

Hide file tree

Showing 60 changed files with 2,629 additions and 0 deletions.
diff --git a/.project b/.project
@@ -0,0 +1,18 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<projectDescription>
+	<name>RcmdrPlugin.TeachingDemos</name>
+	<comment></comment>
+	<projects>
+	</projects>
+	<buildSpec>
+		<buildCommand>
+			<name>de.walware.statet.r.builders.RSupport</name>
+			<arguments>
+			</arguments>
+		</buildCommand>
+	</buildSpec>
+	<natures>
+		<nature>de.walware.statet.base.StatetNature</nature>
+		<nature>de.walware.statet.r.RNature</nature>
+	</natures>
+</projectDescription>
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -0,0 +1,17 @@
+Package: RcmdrPlugin.pointG
+Type: Package
+Title: Rcmdr Graphical POINT of view for questionnaire data Plug-In
+Version: 0.1
+Date: 2011-07-28
+Author: Stephane Champely <champely@univ-lyon1.fr>
+Maintainer: Stephane Champely <champely@univ-lyon1.fr>
+Depends: Rcmdr (>= 1.4-0), tcltk, MASS, lattice, qgraph, VIM, maps,
+        YaleToolkit, ade4, effects, RColorBrewer,Hmisc, car
+Suggests: rgl
+Description: This package provides an Rcmdr "plug-in" to analyze questionnaire data.
+License: GPL (>= 2)
+Models:
+Encoding: latin1
+Repository: CRAN
+Date/Publication: 2011-12-03 15:14:06
+Packaged: 2011-12-03 11:06:32 UTC; champely
diff --git a/MD5 b/MD5
@@ -0,0 +1,58 @@
+d2f8e62af3f36cb9e3ff0a21d190599d *DESCRIPTION
+9fca2e4580487ff608bdec873e1a4a90 *NAMESPACE.txt
+c629de84a492232e855e2d1c03e68f7a *R/RcmdrPlugin.pointG.R
+1074a0aad9b5e00192c8844e42e1d496 *R/Summarydf0.R
+14de18f8d03ec4f6889e63b720995162 *R/Summaryfactor0.R
+f436c39558149b867315a96b2e7439aa *R/Summarynumeric0.R
+13fc0aca1de77d83990f742314638a01 *R/Summaryordered0.R
+0bf0fe4bcd97e73c13a9918237996e4f *R/Summaryvariable0.R
+76cdba3148b06631f941a8289b845a06 *R/aaggr0.R
+a03d21836bc0c525cf6cfef598d44bfb *R/bbigraphe0.R
+19e1c7c2d30787f8412b947211610a46 *R/bbisummarize0.R
+d1775252402c058f828cb4f2aaba98ac *R/bbivariate0.R
+48cd23cb6acc86a1dc2e351b0090ca27 *R/bbref0.R
+318dcbc7316d4e0bfe46276ebba7aaf8 *R/bigraphe0.R
+00bec6451913e02823686cab27dcfd3f *R/bisummarize0.R
+d48250163c597276921d2577e32f60f5 *R/bivariate0.R
+343099f3041aca1e952496a2557dc917 *R/bref.df0.R
+aba2a707969373d03ae7b7621bf9b43e *R/bref.variable0.R
+3a958e3f2e887430df615d794a919def *R/cadrage0.R
+a82965e46b78a2088aa751744fbfbed0 *R/cchalandise.DEP0.R
+fbb7aea2899a7da5ae49cb68a357a184 *R/ccroise0.R
+9d3ed6961fb659a287c5143de4f0420c *R/chalandise.DEP0.R
+0bbc2b587bee105d3a7dcd7e15d7ba5e *R/histbackback0.R
+4c9697b7f810d2512a42fa90ad229f04 *R/is.binary.R
+e88d64bdc7073cde585d31b148220da9 *R/llinear0.R
+f68d610a37cf2eeff94d75193b8646f6 *R/mmultivariate0.R
+6b37ff520e3e98e172c4df56600bff00 *R/multivariate0.R
+173204a469f54a924f38f8692434c876 *R/nettoyage0.R
+9111a345b15ae2d20bb6aec6576b5968 *R/pem.R
+2f4954b9957d9a718968134a9a282ab1 *R/plotCat2.R
+323e30cbf6e6d1743be1517f4835a0a9 *R/plotLikert0.R
+e8a0f13f794384a7e9ba0a8b72b01491 *R/plotNum.R
+57d5f966e480f58e4297794c177a596d *R/plotTabCont0.R
+12469f6d05fb1d735c73ebe8863e2b59 *R/pplotLikert0.R
+6ad0bc5c22c0ea05feb3b7632ab1a19c *R/ppyramide0.R
+55caac1536eab769a5facbc987016127 *R/pyramide0.R
+525a8144cb55c40119fc0b50457a1797 *R/sSummarydf0.R
+a8feb37ef6389c691d7f657279d51d1e *R/twoWayTable0.R
+0c91a689235899b0a3526ac39cf09fb5 *R/univariate0.R
+ea324ffa73be7c111518e3d4dd89f595 *R/uunivariate0.R
+8fc67f7e2554c8135576d3d41713651e *RcmdrPlugin.pointG-Ex.R
+21c714d381c58958c047d0943b892ea9 *data/VIH.rda
+5e90e8fef1ecefbf05916e87055089f1 *data/XY.DEP.rda
+425a640f428876ac1a26540498a29510 *inst/CHANGES
+48125ebd6cd6a1f0bdb8612f89c1f373 *inst/doc/ModeEmploi_pointG_0.1.pdf
+c904602fe5b32bf2bf74e85d8daadedd *inst/etc/menus.txt
+7385f07ba433d84580a6c3a071513553 *man/RcmdrPlugin.pointG-internal.Rd
+ebb01d04014ed334c687544f99f1e4d4 *man/RcmdrPlugin.pointG-package.Rd
+cafb7b8b36073fec20518a84b38271cc *man/VIH.Rd
+e57e130b1df0d7ebace2e479c3ebeaed *man/XY.DEP.Rd
+dad7edcfc19e0c4194a1e2909916a70d *man/bisummarize0.Rd
+ac9bd4a1ed4f224ee139f91c4b3defcb *man/bivariate0.Rd
+e098c0d947c0d8fc5c78183c30a9b7ed *man/is.binary.Rd
+795bee8f99275872e658f519c0cd6aa6 *man/multivariate0.Rd
+a2814a5cf7c81d0278cd6529f2f1a69f *man/plotCat2.Rd
+e586a45e9975e301c4d00cc975a4ca1e *man/plotLikert0.Rd
+a6f107f671b880ae9bb277f47b88fc36 *man/plotNum.Rd
+95e13627db6dfefb9dd98e31d35a9f3b *man/univariate0.Rd
diff --git a/NAMESPACE.txt b/NAMESPACE.txt
@@ -0,0 +1,5 @@
+useDynLib(Rcmdr)
+
+exportPattern(".")
+
+import(Rcmdr,tcltk,MASS, lattice, qgraph, VIM, maps, YaleToolkit, ade4, effects, RColorBrewer,Hmisc, car,rgl)
diff --git a/R/RcmdrPlugin.pointG.R b/R/RcmdrPlugin.pointG.R
@@ -0,0 +1,43 @@
+# Some Rcmdr dialogs for the Rcmdr package
+
+# last modified: 30 May 2007 by J. Fox
+
+# Note: the following function (with contributions from Richard Heiberger) 
+# can be included in any Rcmdr plug-in package to cause the package to load
+# the Rcmdr if it is not already loaded
+
+.First.lib <- function(libname, pkgname){
+    if (!interactive()) return()
+    Rcmdr <- options()$Rcmdr
+    plugins <- Rcmdr$plugins
+    if ((!pkgname %in% plugins) && !getRcmdr("autoRestart")) {
+        Rcmdr$plugins <- c(plugins, pkgname)
+        options(Rcmdr=Rcmdr)
+        closeCommander(ask=FALSE, ask.save=TRUE)
+        Commander()
+        }
+    }
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/R/Summarydf0.R b/R/Summarydf0.R
@@ -0,0 +1,56 @@
+Summarydf0<-function (object, maxsum = 7, digits = max(3, getOption("digits") - 
+    3), ...) 
+{
+    ncw <- function(x) {
+        z <- nchar(x, type = "w")
+        if (any(na <- is.na(z))) {
+            z[na] <- nchar(encodeString(z[na]), "b")
+        }
+        z
+    }
+    z <- lapply(as.list(object), Summaryvariable0, maxsum = maxsum,digits=digits,...)
+    nv <- length(object)
+    nm <- names(object)
+    lw <- numeric(nv)
+    nr <- max(unlist(lapply(z, NROW)))
+    for (i in 1L:nv) {
+        sms <- z[[i]]
+        if (is.matrix(sms)) {
+            cn <- paste(nm[i], gsub("^ +", "", colnames(sms), 
+                useBytes = TRUE), sep = ".")
+            tmp <- format(sms)
+            if (nrow(sms) < nr) 
+                tmp <- rbind(tmp, matrix("", nr - nrow(sms), 
+                  ncol(sms)))
+            sms <- apply(tmp, 1L, function(x) paste(x, collapse = "  "))
+            wid <- sapply(tmp[1L, ], nchar, type = "w")
+            blanks <- paste(character(max(wid)), collapse = " ")
+            wcn <- ncw(cn)
+            pad0 <- floor((wid - wcn)/2)
+            pad1 <- wid - wcn - pad0
+            cn <- paste(substring(blanks, 1L, pad0), cn, substring(blanks, 
+                1L, pad1), sep = "")
+            nm[i] <- paste(cn, collapse = "  ")
+            z[[i]] <- sms
+        }
+        else {
+            lbs <- format(names(sms))
+            sms <- paste(lbs, ":", format(sms, digits = digits), 
+                "  ", sep = "")
+            lw[i] <- ncw(lbs[1L])
+            length(sms) <- nr
+            z[[i]] <- sms
+        }
+    }
+    z <- unlist(z, use.names = TRUE)
+    dim(z) <- c(nr, nv)
+    if (any(is.na(lw))) 
+        warning("probably wrong encoding in names(.) of column ", 
+            paste(which(is.na(lw)), collapse = ", "))
+    blanks <- paste(character(max(lw, na.rm = TRUE) + 2L), collapse = " ")
+    pad <- floor(lw - ncw(nm)/2)
+    nm <- paste(substring(blanks, 1, pad), nm, sep = "")
+    dimnames(z) <- list(rep.int("", nr), nm)
+    attr(z, "class") <- c("table")
+    z
+}
diff --git a/R/Summaryfactor0.R b/R/Summaryfactor0.R
@@ -0,0 +1,7 @@
+Summaryfactor0<-function(x,maxsum=7){
+k<-length(levels(x))
+Table<-summary(na.omit(x),maxsum=maxsum)
+if(k>maxsum){Table[1:(maxsum-1)]<-rev(sort(Table[1:(maxsum-1)]))}
+else{Table<-rev(sort(Table))}
+Table
+}
diff --git a/R/Summarynumeric0.R b/R/Summarynumeric0.R
@@ -0,0 +1,12 @@
+Summarynumeric0<-function(x,digits=max(3, getOption("digits")-3)){
+T1<-summary(na.omit(x))
+SD<-signif(sd(na.omit(x)),digits)
+T2<-c(T1,SD)
+names(T2)[1]<-"Min."
+names(T2)[2]<-"Q1"
+names(T2)[3]<-"Q2"
+names(T2)[4]<-"M"
+names(T2)[5]<-"Q3"
+names(T2)[6]<-"Max."
+names(T2)[7]<-"S"
+T2}
diff --git a/R/Summaryordered0.R b/R/Summaryordered0.R
@@ -0,0 +1,4 @@
+Summaryordered0<-function(x,maxsum=7){
+Table<-summary(na.omit(x),maxsum=maxsum)
+Table
+}
diff --git a/R/Summaryvariable0.R b/R/Summaryvariable0.R
@@ -0,0 +1,16 @@
+Summaryvariable0<-function(x,maxsum=7,digits=max(3, getOption("digits") - 
+    3)){
+if(is.numeric(x)){ttt<-Summarynumeric0(x,digits=digits)}
+else{
+
+if(is.ordered(x)){ttt<-Summaryordered0(x,maxsum=maxsum)}
+
+else{if(is.factor(x)){ttt<-Summaryfactor0(x,maxsum=maxsum)}
+
+else{ttt<-NA}
+}
+}
+nnaa<-round(sum(is.na(x)))
+names(nnaa)<-"?"
+c(ttt,nnaa)
+}
diff --git a/R/aaggr0.R b/R/aaggr0.R
@@ -0,0 +1,58 @@
+aaggr0<-function () 
+{
+    newName <- activeDataSet()
+    initializeDialog(title = gettextRcmdr("Analyse graphique des valeurs manquantes"))
+    allVariablesFrame <- tkframe(top)
+    allVariables <- tclVar("1")
+    allVariablesCheckBox <- tkcheckbutton(allVariablesFrame, 
+        variable = allVariables)
+    variablesBox <- variableListBox(top, Variables(), selectmode = "multiple", 
+        initialSelection = NULL, title = gettextRcmdr("Variables (select one or more)"))
+    subsetVariable <- tclVar(gettextRcmdr("<all cases>"))
+    onOK <- function() {
+        if (!is.valid.name(newName)) {
+            errorCondition(recall = uunivariate, message = paste("\"", 
+                newName, "\" ", gettextRcmdr("is not a valid name."), 
+                sep = ""))
+            return()
+        }
+        selectVars <- if (tclvalue(allVariables) == "1") 
+            ""
+        else {
+            x <- getSelection(variablesBox)
+            if (0 == length(x)) {
+                errorCondition(recall = uunivariate, message = gettextRcmdr("No variables were selected."))
+                return()
+            }
+            paste(", select=c(", paste(x, collapse = ","), ")", 
+                sep = "")
+        }
+        closeDialog()
+        cases <- tclvalue(subsetVariable)
+        selectCases <- if (cases == gettextRcmdr("<all cases>")) 
+            ""
+        else paste(", subset=", cases, sep = "")
+        if (selectVars == "" && selectCases == "") {
+            aggr(get(newName),plot=TRUE,col=rev(brewer.pal(3,name="PuRd"))[c(1,2)])
+
+            return()
+        }
+        newn <- "D1"
+        command <- paste(newn, " <- subset(", ActiveDataSet(), 
+            selectCases, selectVars, ")", sep = "")
+        logger(command)
+        result <- justDoIt(command)
+        aggr(get(newn),plot=TRUE,col=rev(brewer.pal(3,name="PuRd"))[c(1,2)],ylabs=c("% de valeurs manquantes","Combinaisons"),cex.ax=0.5)
+        if (class(result)[1] != "try-error") 
+            tkfocus(CommanderWindow())
+    }
+    OKCancelHelp(helpSubject = "aggr")
+    tkgrid(labelRcmdr(allVariablesFrame, text = gettextRcmdr("Include all variables")), 
+        allVariablesCheckBox, sticky = "w")
+    tkgrid(allVariablesFrame, sticky = "w")
+    tkgrid(labelRcmdr(top, text = gettextRcmdr("   OR"), fg = "red"), 
+        sticky = "w")
+    tkgrid(getFrame(variablesBox), sticky = "nw")
+    tkgrid(buttonsFrame, sticky = "w")
+    dialogSuffix(rows = 6, columns = 1)
+}
diff --git a/R/bbigraphe0.R b/R/bbigraphe0.R
@@ -0,0 +1,58 @@
+
+bbigraphe0<-function () 
+{
+    newName <- activeDataSet()
+    initializeDialog(title = gettextRcmdr("Analyse graphique des relations"))
+    allVariablesFrame <- tkframe(top)
+    allVariables <- tclVar("1")
+    allVariablesCheckBox <- tkcheckbutton(allVariablesFrame, 
+        variable = allVariables)
+    variablesBox <- variableListBox(top, Variables(), selectmode = "multiple", 
+        initialSelection = NULL, title = gettextRcmdr("Variables (select one or more)"))
+    subsetVariable <- tclVar(gettextRcmdr("<all cases>"))
+    onOK <- function() {
+        if (!is.valid.name(newName)) {
+            errorCondition(recall = bbigraphe0, message = paste("\"", 
+                newName, "\" ", gettextRcmdr("is not a valid name."), 
+                sep = ""))
+            return()
+        }
+        selectVars <- if (tclvalue(allVariables) == "1") 
+            ""
+        else {
+            x <- getSelection(variablesBox)
+            if (0 == length(x)) {
+                errorCondition(recall = bbigraphe0, message = gettextRcmdr("No variables were selected."))
+                return()
+            }
+            paste(", select=c(", paste(x, collapse = ","), ")", 
+                sep = "")
+        }
+        closeDialog()
+        cases <- tclvalue(subsetVariable)
+        selectCases <- if (cases == gettextRcmdr("<all cases>")) 
+            ""
+        else paste(", subset=", cases, sep = "")
+        if (selectVars == "" && selectCases == "") {
+            bigraphe0(newName)
+            return()
+        }
+        newn <- "D1"
+        command <- paste(newn, " <- subset(", ActiveDataSet(), 
+            selectCases, selectVars, ")", sep = "")
+        logger(command)
+        result <- justDoIt(command)
+        bigraphe0(newn)
+        if (class(result)[1] != "try-error") 
+            tkfocus(CommanderWindow())
+    }
+    OKCancelHelp(helpSubject = "gpairs")
+    tkgrid(labelRcmdr(allVariablesFrame, text = gettextRcmdr("Include all variables")), 
+        allVariablesCheckBox, sticky = "w")
+    tkgrid(allVariablesFrame, sticky = "w")
+    tkgrid(labelRcmdr(top, text = gettextRcmdr("   OR"), fg = "red"), 
+        sticky = "w")
+    tkgrid(getFrame(variablesBox), sticky = "nw")
+    tkgrid(buttonsFrame, sticky = "w")
+    dialogSuffix(rows = 6, columns = 1)
+}