├── .gitignore ├── DESCRIPTION ├── NAMESPACE ├── NEWS ├── R ├── CrossTable.R ├── UTF-8.R ├── bwplotstats.R ├── compmeans.R ├── crosstab.R ├── dataframe2txt.R ├── descr.R ├── file.head.R ├── forODFTable.R ├── freq.R ├── fwf2csv.R ├── labels2R.R └── xtable.R ├── README.md ├── inst └── po │ ├── en@quot │ └── LC_MESSAGES │ │ ├── R-descr.mo │ │ └── descr.mo │ └── pt_BR │ └── LC_MESSAGES │ ├── R-descr.mo │ └── descr.mo ├── man ├── CrossTable.Rd ├── LogRegR2.Rd ├── compmeans.Rd ├── crosstab.Rd ├── data.frame2txt.Rd ├── descr.Rd ├── file.head.Rd ├── forODFTable.Rd ├── freq.Rd ├── fromUTF8.Rd ├── fwf2csv.Rd ├── histkdnc.Rd ├── labels2R.Rd ├── plot.CrossTable.Rd ├── plot.freqtable.Rd ├── toUTF8.Rd └── xtable.CrossTable.Rd ├── po ├── R-descr.pot ├── R-pt_BR.po ├── descr.pot └── pt_BR.po └── src └── descr.c /.gitignore: -------------------------------------------------------------------------------- 1 | src/descr.so 2 | src/fwf2csv.o 3 | po/*.po~ 4 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: descr 2 | Version: 1.1.8 3 | Date: 2023-11-27 4 | Title: Descriptive Statistics 5 | Author: Jakson Aquino. Includes R source code and/or documentation 6 | written by Dirk Enzmann, Marc Schwartz, Nitin Jain, and Stefan 7 | Kraft 8 | Maintainer: Jakson Aquino 9 | Imports: xtable, utils, grDevices, graphics, stats 10 | Description: Weighted frequency and contingency tables of categorical 11 | variables and of the comparison of the mean value of a numerical 12 | variable by the levels of a factor, and methods to produce xtable 13 | objects of the tables and to plot them. There are also functions to 14 | facilitate the character encoding conversion of objects, to quickly 15 | convert fixed width files into csv ones, and to export a data.frame to 16 | a text file with the necessary R and SPSS codes to reread the data. 17 | License: GPL (>= 2) 18 | URL: https://github.com/jalvesaq/descr 19 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | useDynLib(descr, .registration = TRUE) 2 | 3 | export(CrossTable, crosstab, LogRegR2, freq, fromUTF8, toUTF8, descr, 4 | compmeans, histkdnc, fwf2csv, labels2R, file.head, forODFTable, 5 | data.frame2txt) 6 | 7 | importFrom("xtable", "xtable") 8 | importFrom("stats", "weighted.mean", "xtabs", "chisq.test", "fisher.test", 9 | "mcnemar.test", "na.omit", "density", "dnorm", "sd", "pchisq", 10 | "quantile") 11 | importFrom("utils", "write.table") 12 | importFrom("grDevices", "gray.colors", "grey") 13 | importFrom("graphics", "hist.default", "hist", "lines", "curve", 14 | "mosaicplot", "barplot", "boxplot", "bxp") 15 | 16 | S3method(print, CrossTable) 17 | S3method(print, freqtable) 18 | S3method(print, meanscomp) 19 | S3method(print, LogRegR2) 20 | 21 | S3method(plot, freqtable) 22 | S3method(plot, meanscomp) 23 | S3method(plot, CrossTable) 24 | 25 | S3method(dim, CrossTable) 26 | S3method(xtable, CrossTable) 27 | S3method(xtable, freqtable) 28 | S3method(xtable, meanscomp) 29 | -------------------------------------------------------------------------------- /NEWS: -------------------------------------------------------------------------------- 1 | 1.1.8 (2023-11-27) 2 | 3 | - Fix compiler warning. 4 | 5 | 1.1.7 (2023-03-22) 6 | 7 | - Fix foreign function call. 8 | 9 | 1.1.6 (2023-03-08) 10 | 11 | - Fix new R CMD check warnings. 12 | 13 | 1.1.5 (2021-02-15) 14 | 15 | - New option: descr.round.xtabs 16 | 17 | - Minor bug fixes. 18 | 19 | 1.1.4 (2018-01-18) 20 | 21 | - Minor bug fixes. 22 | 23 | 1.1.3 (2016-05-11) 24 | 25 | - Minor bug fixes. 26 | 27 | 1.1.2 (2015-08-02) 28 | 29 | - New arguments for CrossTable and crosstab: 30 | row.labels, percent, total.c and total.r. 31 | 32 | - Turn digits argument of CrossTable into a list. 33 | 34 | - Improve label abbreviation algorithm for very wide cross tables. 35 | 36 | - Fix import notes during R CMD check --as-cran. 37 | 38 | 1.1.1 (2015-05-06) 39 | 40 | - Bug fixes in forODFTable() and xtable.CrossTable(). 41 | 42 | 1.1 (2015-04-13) 43 | 44 | - Change: 45 | 46 | - The plot.CrossTable() function now plots a mosaic graphic with rows and 47 | columns that mirror the output table. The x and y arguments of 48 | crosstab() were renamed indep and dep, respectively, to avoid the 49 | confusion with what should be xlab and ylab. The arguments 50 | user.missing.x and user.missing.y were also renamed. 51 | 52 | - Bug fix: 53 | 54 | - Use format.pval() to print p-value in print.CrossTable(). 55 | 56 | 1.0.4 (2014-11-04) 57 | 58 | - Bug fixes: 59 | 60 | - R/labels2R.R: Accept negative values. 61 | 62 | - R/xtable.R: Add row and column total proportions to xtable (thanks to 63 | Johannes Herrmann for reporting the bug). 64 | 65 | - Changes: 66 | 67 | - New argument for compmeans: missing.include (thanks to Olivier Armand 68 | for reporting the issue that led to this change). 69 | 70 | - New argument for CrossTable: drop.levels. 71 | 72 | - New option: descr.na.replacement. 73 | 74 | 1.0.3 (2014-08-01) 75 | 76 | - Bug fixes: 77 | 78 | - R/labels2R.R: Avoid infinite loop. 79 | 80 | - R/xtable.R: Avoid errors when either sresid or prop.chisq are TRUE. 81 | 82 | - src/descr.c: Read up to 32765 characters from input lines. 83 | 84 | 1.0.2 (2013-11-01) 85 | 86 | - Bug fixes: 87 | 88 | - R/xtable.R: Fix column name "Total" and deal with "$" in label names. 89 | 90 | - Allow to change the values of xlim and ylim in histkdnc(). Thanks to 91 | Thomas W. MacFarland for reporting the bug. 92 | 93 | - Changes: 94 | 95 | - Make CrossTable() to print residuals even if format="SAS". 96 | 97 | - Make CrossTable() to print only what is set to TRUE. 98 | 99 | - CrossTable() doesn't output chisq.test() warnings if chisq = FALSE and 100 | prop.chisq = FALSE. 101 | 102 | - News functions: data.frame2txt() and labels2R(). 103 | 104 | 1.0.1 (2013-01-15) 105 | 106 | - Bug fix: 107 | 108 | - src/fwf2csv.c: Free no longer used allocated memory. 109 | 110 | - Implement weighted boxplot for compmeans (code written by Stefan Kraft 111 | for the simPopulation package). 112 | 113 | Change: 114 | 115 | - Add option to suppress warnings: "descr.warn". 116 | 117 | 118 | 1.0.0 (2012-11-18) 119 | 120 | - Bug fix: 121 | 122 | - src/fwf2csv.c: Don't cause stack smashing if field is wider than 255 123 | characters (thanks to Anthony Damico for reporting the bug). 124 | 125 | 0.9.9 (2012-09-24) 126 | 127 | - Bug fix: 128 | 129 | - Sort boxplots widths in compmeans if sort = TRUE. 130 | 131 | 0.9.8 (2012-08-06) 132 | 133 | - Changes: 134 | 135 | - New argument for CrossTable(): cell.layout. 136 | 137 | - No longer produce weighted box plots. 138 | 139 | 0.9.7 (2011-12-12) 140 | 141 | - Changes: 142 | 143 | - Boxplot made by compmeans now have relative widths and the boxes have 144 | gray color. 145 | 146 | - Adapt the width of cross tables to options("width"). 147 | 148 | - Bug fix: 149 | 150 | - CrossTable, crosstab and compmeans: Correctly calculate widths if the 151 | text is in Chinese (thanks to Wincent Ronggui Huang for reporting the 152 | bug). 153 | 154 | - print.CrossTable() and xtable.CrossTable(): handle the argument dnn, 155 | which was being ignored. 156 | 157 | 0.4.2 (2011-11-24) 158 | 159 | - Changes: 160 | 161 | - Replace method odfTable.CrossTable with function forODFTable to avoid 162 | dependency on odfWeave which currently is not installable on Windows. 163 | 164 | - Bug fix: 165 | 166 | - CrossTable(): Improve documentation about default values of chisq, 167 | resid, sresid, and asresid. Set the value of expected to TRUE if 168 | residuals are requested (thanks for David Carlson for reporting the 169 | bugs). 170 | 171 | 172 | 0.4.1 (2011-09-06) 173 | 174 | - Bug fix: 175 | 176 | - file.head(): Does not fail if file encoding is Latin1 or other single 177 | byte encoding and system encoding is UTF-8 (thanks to 178 | Sergio Martins for reporting the bug). 179 | 180 | 181 | 0.4.0 (2011-06-25) 182 | 183 | - Changes: 184 | 185 | - odfTable method for object of class CrossTable. 186 | 187 | - Improved xtable method for object of class CrossTable. 188 | 189 | 190 | 0.3.4 (2011-04-24) 191 | 192 | - Changes: 193 | 194 | - Objects of classes meanscomp, freqtable and CrossTable now have 195 | plot methods. 196 | 197 | 198 | 0.3.3 (2011-02-08) 199 | 200 | - Changes: 201 | 202 | - compmeans(): When sort=T the boxplots are sorted too. 203 | Uses wtd.boxplot of package NEmisc. 204 | Returns a matrix instead of a list. 205 | 206 | - freq(): Returns a matrix instead of a list. 207 | 208 | - Changed the dependency of xtable from Depends to Imports. 209 | 210 | - fwf2csv: Only prints message about number of lines saved 211 | if the value of "verbose" option is TRUE. 212 | 213 | - New features: 214 | 215 | - Added argument user.missing to freq(), compmeans(), and crosstab(). 216 | 217 | 218 | 0.3.2 (2009-10-11) 219 | 220 | - Bug fixes: 221 | 222 | - Fixed documentation link to read.fwf(). 223 | 224 | - Added domain = "R-descr" to all gettext(). 225 | 226 | - Fixed conversion of fwf into csv when the fwf had \r\n line terminators 227 | and R was running on Linux. Also fixed reading of strings with spaces. 228 | 229 | - Changes: 230 | 231 | - Inverted colors in the mosaic plot produced by crosstab(). 232 | 233 | - Only add cumulative percent to frequency table if the object is "ordered". 234 | 235 | - print.CrossTable(): 236 | - Removed the message "Total Observations in Table", since the number is 237 | printed in the table anyway. 238 | - Removed vertical bars from the output to give room for longer 239 | factor labels. 240 | - getOption("OutDec") now is used to format the numbers. 241 | - Expected frequency now is always printed with one decimal digit. 242 | 243 | - New features: 244 | 245 | - Added function file.head(), which shows the first lines of a file (useful 246 | before read.table()). 247 | 248 | 249 | 0.3.1 (2009-08-11) 250 | 251 | - New features: 252 | 253 | - Included a version of CrossTable, adapted from gmodels package, with 254 | methods for print and xtable. 255 | 256 | - Added xtable methods for classes freqtable and meanscomp. 257 | 258 | 259 | 0.3.0 (2009-06-07) 260 | 261 | - New features: 262 | 263 | - Added plot option to crosstab, compmeans and freq. 264 | 265 | - Renamed function crosstabs to crosstab. 266 | 267 | - LogRegR2 now accepts "probit" models. 268 | 269 | - Bug fixes: 270 | 271 | - Fixed bug in the weighted standard deviation calculus in compmeans. 272 | 273 | -------------------------------------------------------------------------------- /R/CrossTable.R: -------------------------------------------------------------------------------- 1 | # These functions were developed from the function CrossTable of the package 2 | # gmodels. The original function had the following comments: 3 | # 4 | # Revision 2.2 2006/05/02 5 | # Fix a bug when a matrix is passed as the 'x' argument 6 | # Reported by Prof. Albert Sorribas same day 7 | # Fix involved creating default values for RowData and ColData 8 | # when there are no dimnames for the matrix 9 | 10 | # Revision 2.1 2005/06/26 11 | # Added 'dnn' argument to enable specification of dimnames 12 | # as per table() 13 | # Correct bug in SPSS output for 1d table, where proportions 14 | # were being printed and not percentages ('%' output) 15 | 16 | # Revision 2.0 2005/04/27 17 | # Added 'format = "d"' to all table count output 18 | # so that large integers do not print in 19 | # scientific notation 20 | 21 | GetDigitsList <- function(x) 22 | { 23 | if(is.list(x$digits)) 24 | dgts <- list(expected = ifelse(is.null(x$digits$expected), 1, x$digits$expected), 25 | prop = ifelse(is.null(x$digits$prop), 1, x$digits$prop), 26 | percent = ifelse(is.null(x$digits$percent), 1, x$digits$percent), 27 | others = ifelse(is.null(x$digits$others), 1, x$digits$others)) 28 | else 29 | dgts <- list(expected = x$digits[1], prop = x$digits[1], 30 | percent = x$digits[1], others = x$digits[1]) 31 | dgts 32 | } 33 | 34 | CreateNewTab <- function(x, ...) 35 | { 36 | nr <- dim(x$tab)[1] 37 | nc <- dim(x$tab)[2] 38 | nt <- cbind(x$tab, x$rs) 39 | colnames(nt)[ncol(nt)] <- gettext("Total", domain = "R-descr") 40 | nt <- format(nt, scientific = FALSE) 41 | 42 | dgts <- GetDigitsList(x) 43 | 44 | if(x$format == "SPSS"){ 45 | hdd <- 100 46 | dgts$prop <- dgts$percent 47 | } else { 48 | hdd <- 1 49 | x$percent <- FALSE 50 | } 51 | 52 | appendlines <- function(nt, xx, rowlab, prct = FALSE, hasttl = FALSE) 53 | { 54 | if(prct) 55 | for(i in 1:nrow(xx)) 56 | for(j in 1:ncol(xx)) 57 | xx[i, j] <- paste0(xx[i, j], "%") 58 | if(!hasttl) 59 | xx <- cbind(xx, rep("", nr)) 60 | if(!x$row.labels) 61 | rowlab <- " " 62 | rownames(xx) <- rep(rowlab, nrow(xx)) 63 | n <- dim(nt)[1] / nr 64 | nt <- rbind(nt, xx) 65 | idx <- integer() 66 | k <- 1 67 | l <- nr * n + 1 68 | for(i in 1:nr){ 69 | for(j in 1:n){ 70 | idx <- c(idx, k) 71 | k <- k + 1 72 | } 73 | idx <- c(idx, l) 74 | l <- l + 1 75 | } 76 | nt <- nt[idx, ] 77 | nt 78 | } 79 | 80 | if(x$expected){ 81 | xx <- x$CST$expected 82 | xx <- format(round(xx, dgts$expected), scientific = FALSE, trim = TRUE, ...) 83 | nt <- appendlines(nt, xx, gettext("expected", domain = "R-descr")) 84 | } 85 | 86 | if(x$prop.chisq){ 87 | xx <- ((x$CST$expected - x$tab) ^ 2) / x$CST$expected 88 | xx <- format(round(xx, digits = dgts$others), trim = TRUE, ...) 89 | nt <- appendlines(nt, xx, gettext("chisq", domain = "R-descr")) 90 | } 91 | 92 | if(!is.na(x$prop.row[1])){ 93 | xx <- cbind(x$prop.row, x$rs / x$gt) 94 | xx <- format(round(xx * hdd, digits = dgts$prop), trim = TRUE, ...) 95 | if(hdd == 100) 96 | nt <- appendlines(nt, xx, gettext("row %", domain = "R-descr"), 97 | x$percent, TRUE) 98 | else 99 | nt <- appendlines(nt, xx, gettext("row prop.", domain = "R-descr"), 100 | x$percent, TRUE) 101 | } 102 | 103 | if(!is.na(x$prop.col[1])){ 104 | xx <- format(round(x$prop.col * hdd, digits = dgts$prop), trim = TRUE, ...) 105 | if(hdd == 100) 106 | nt <- appendlines(nt, xx, gettext("col %", domain = "R-descr"), 107 | x$percent) 108 | else 109 | nt <- appendlines(nt, xx, gettext("col prop.", domain = "R-descr"), 110 | x$percent) 111 | } 112 | 113 | if(!is.na(x$prop.tbl[1])){ 114 | xx <- format(round(x$prop.tbl * hdd, digits = dgts$prop), trim = TRUE, ...) 115 | if(hdd == 100) 116 | nt <- appendlines(nt, xx, gettext("table %", domain = "R-descr"), 117 | x$percent) 118 | else 119 | nt <- appendlines(nt, xx, gettext("table prop.", domain = "R-descr"), 120 | x$percent) 121 | } 122 | 123 | if(!is.na(x$resid) && x$resid == TRUE){ 124 | xx <- x$tab - x$CST$expected 125 | xx <- format(round(xx, digits = dgts$others), scientific = FALSE, trim = TRUE, ...) 126 | nt <- appendlines(nt, xx, gettext("residual", domain = "R-descr")) 127 | } 128 | 129 | if(!is.na(x$sresid) && x$sresid == TRUE){ 130 | xx <- x$CST$residual 131 | xx <- format(round(xx, digits = dgts$others), trim = TRUE, ...) 132 | nt <- appendlines(nt, xx, gettext("std. res.", domain = "R-descr")) 133 | } 134 | 135 | if(!is.na(x$asr[1])){ 136 | xx <- format(round(x$asr, digits = dgts$others), trim = TRUE, ...) 137 | nt <- appendlines(nt, xx, gettext("adj. std. res.", domain = "R-descr")) 138 | } 139 | 140 | if(x$total.c){ 141 | nt <- rbind(nt, format(c(x$cs, x$gt), scientific = FALSE)) 142 | rownames(nt)[nrow(nt)] <- gettext("Total", domain = "R-descr") 143 | 144 | # Add final row if necessary 145 | if(!is.na(x$prop.col[1])){ 146 | xx <- format(round(hdd * x$cs / x$gt, digits = dgts$prop), trim = TRUE, ...) 147 | if(hdd == 100 && x$percent) 148 | xx <- paste0(xx, "%") 149 | nt <- rbind(nt, c(xx, "")) 150 | } 151 | } 152 | 153 | # Delete last column if necessary 154 | if(!x$total.r) 155 | nt <- nt[, 1:(ncol(nt)-1)] 156 | 157 | tdim <- dim(nt) 158 | tdnn <- list(rownames(nt), colnames(nt)) 159 | names(tdnn) <- c(attr(nt, "RowData"), attr(nt, "ColData")) 160 | attributes(nt) <- NULL 161 | attr(nt, "dim") <- tdim 162 | dimnames(nt) <- tdnn 163 | nt 164 | } 165 | 166 | Abbrev1 <- function(x, lmt) 167 | { 168 | if(nchar(x) <= lmt) 169 | return(x) 170 | xc <- charToRaw(x) 171 | len1 <- length(xc) 172 | 173 | # Two consecutive spaces 174 | i <- 1 175 | while(i < len1){ 176 | if(xc[i] == 0x20 && xc[i+1] == 0x20) 177 | return(rawToChar(xc[-i])) 178 | i <- i + 1 179 | } 180 | 181 | # Trailing space or tab 182 | if(xc[len1] == 0x20 || xc[len1] == 0x09) 183 | return(rawToChar(xc[-len1])) 184 | 185 | # Last lower case ascii vowel (unless it is the first letter in a word) 186 | i <- len1 187 | while(i > 1){ 188 | if(xc[i-1] != 0x20 && (xc[i] == 0x61 || xc[i] == 0x65 || xc[i] == 0x69 || xc[i] == 0x6f || xc[i] == 0x75)){ 189 | xc <- xc[-i] 190 | return(rawToChar(xc)) 191 | } 192 | i <- i - 1 193 | } 194 | 195 | # Last lower case ascii letter (unless it is the first letter in a word) 196 | i <- len1 197 | while(i > 0){ 198 | if(xc[i-1] != 0x20 && xc[i] > 0x60 && xc[i] < 0x7b){ 199 | xc <- xc[-i] 200 | return(rawToChar(xc)) 201 | } 202 | i <- i - 1 203 | } 204 | 205 | # Last letter 206 | x <- unlist(strsplit(x, "")) 207 | len <- length(x) 208 | x <- x[-len] 209 | paste0(x, collapse = "") 210 | } 211 | 212 | CrossTable <- function (x, y, 213 | digits = list(expected = 1, prop = 3, percent = 1, others = 3), 214 | max.width = NA, expected = FALSE, 215 | prop.r = TRUE, prop.c = TRUE, prop.t = TRUE, prop.chisq = TRUE, 216 | chisq = FALSE, fisher = FALSE, mcnemar = FALSE, resid = FALSE, 217 | sresid = FALSE, asresid = FALSE, missing.include = FALSE, 218 | drop.levels = TRUE, format = c("SAS", "SPSS"), dnn = NULL, 219 | cell.layout = TRUE, row.labels = !cell.layout, 220 | percent = (format == "SPSS" && !row.labels), 221 | total.r, total.c, xlab = NULL, ylab = NULL, ...) 222 | { 223 | format = match.arg(format) 224 | 225 | RowData <- deparse(substitute(x)) 226 | if (missing(y)) 227 | ColData <- NA 228 | else 229 | ColData <- deparse(substitute(y)) 230 | 231 | ## Ensure that max.width >= 1 232 | if (!is.na(max.width) && max.width < 1) 233 | stop("max.width must be >= 1") 234 | ## Set 'x' vector flag 235 | vector.x <- FALSE 236 | 237 | if (missing(y)) 238 | { 239 | ## is x a vector? 240 | if (is.null(dim(x))) 241 | { 242 | if (missing.include) 243 | x <- no.drop.levels(x) 244 | if (drop.levels) 245 | x <- factor(x) 246 | tab <- t(as.matrix(table(x))) 247 | vector.x <- TRUE 248 | } 249 | ## is x a matrix? 250 | else if (length(dim(x) == 2)) 251 | { 252 | if(any(x < 0) || any(is.na(x))) 253 | stop("all entries of x must be nonnegative and finite") 254 | 255 | ## Check to see if x has names(dimnames) defined. If yes, use these for 256 | ## 'RowData' and 'ColData' labels, else create blank ones 257 | ## This can be overridden by setting 'dnn' values 258 | if (is.null(names(dimnames(x)))) 259 | { 260 | RowData <- "" 261 | ColData <- "" 262 | } else { 263 | RowData <- names(dimnames(x))[1] 264 | ColData <- names(dimnames(x))[2] 265 | } 266 | 267 | ## Add generic column and rownames if required 268 | ## check each separately, in case user has defined one or the other 269 | if (is.null(rownames(x))) 270 | rownames(x) <- paste("[", 1:nrow(x), ",]", sep = "") 271 | if (is.null(colnames(x))) 272 | colnames(x) <- paste("[,", 1:ncol(x), "]", sep = "") 273 | 274 | tab <- x 275 | } 276 | else 277 | stop("x must be either a vector or a 2 dimensional matrix, if y is not given") 278 | } else { 279 | if(missing.include){ 280 | x <- no.drop.levels(x) 281 | y <- no.drop.levels(y) 282 | } 283 | if(drop.levels){ 284 | x <- factor(x) 285 | y <- factor(y) 286 | } 287 | 288 | if(length(x) != length(y)) 289 | stop("x and y must have the same length") 290 | 291 | ## Generate table 292 | tab <- table(x, y) 293 | } 294 | 295 | ## Check dnn, and use it 296 | if(!is.null(dnn)){ 297 | if(all(dim(tab) >= 2) && length(dnn) != 2) 298 | stop("dnn must have length of 2, one element for each table dimension") 299 | RowData <- dnn[1] 300 | if(length(dnn) > 1) 301 | ColData <- dnn[2] 302 | } 303 | 304 | ## if tab is not at least a 2 x 2, do not do stats 305 | ## even if any set to TRUE. Do not do col/table props 306 | if (any(dim(tab) < 2)) 307 | prop.c <- prop.chisq <- chisq <- expected <- fisher <- mcnemar <- FALSE 308 | 309 | if (vector.x && dim(tab)[2] < 2) 310 | prop.r <- FALSE 311 | if (!vector.x && dim(tab)[1] < 2) 312 | prop.r <- FALSE 313 | 314 | CPR <- CPC <- CPT <- GT <- RS <- TotalN <- CSTc <- CST <- ASR <- FTt <- 315 | FTl <- FTg <- McN <- McNc <- NA 316 | 317 | ## Generate cell proportion of row 318 | if(prop.r) 319 | CPR <- prop.table(tab, 1) 320 | 321 | ## Generate cell proportion of col 322 | if(prop.c) 323 | CPC <- prop.table(tab, 2) 324 | 325 | ## Generate cell proportion of total 326 | if(prop.t) 327 | CPT <- prop.table(tab) 328 | 329 | ## Generate summary counts 330 | GT <- sum(tab) 331 | RS <- rowSums(tab) 332 | CS <- colSums(tab) 333 | 334 | if (length(dim(x) == 2)) 335 | TotalN <- GT 336 | else 337 | TotalN <- length(x) 338 | 339 | ## Perform Chi-Square Tests 340 | if (expected || chisq || prop.chisq || resid || sresid || asresid) { 341 | if(!chisq && !prop.chisq){ 342 | wv <- getOption("warn") 343 | options(warn = -1) 344 | } 345 | CST <- chisq.test(tab, correct = FALSE, ...) 346 | if (all(dim(tab) == 2)) 347 | CSTc <- chisq.test(tab, correct = TRUE, ...) 348 | if(!chisq && !prop.chisq){ 349 | options(warn = wv) 350 | } 351 | } 352 | 353 | if (asresid & !vector.x) 354 | ASR <- (CST$observed-CST$expected)/sqrt(CST$expected*((1-RS/GT) %*% t(1-CS/GT))) 355 | 356 | if (fisher) 357 | { 358 | try(FTt <- fisher.test(tab, alternative = "two.sided")) 359 | if (all(dim(tab) == 2)) 360 | { 361 | FTl <- fisher.test(tab, alternative = "less") 362 | FTg <- fisher.test(tab, alternative = "greater") 363 | } 364 | } 365 | 366 | if (mcnemar) 367 | { 368 | if(dim(tab)[1] == dim(tab)[2]) 369 | McN <- mcnemar.test(tab, correct = FALSE) 370 | if (all(dim(tab) == 2)) 371 | McNc <- mcnemar.test(tab, correct = TRUE) 372 | } 373 | 374 | if(!missing(total.r)){ 375 | if(!is.logical(total.r)) 376 | stop(gettext("total.r must be logical", domain = "R-descr")) 377 | if(missing(total.c)) 378 | total.c <- total.r 379 | } 380 | if(!missing(total.c)){ 381 | if(!is.logical(total.c)) 382 | stop(gettext("total.c must be logical", domain = "R-descr")) 383 | if(missing(total.r)) 384 | total.r <- total.c 385 | } 386 | if(missing(total.r) & missing(total.c)) 387 | total.r <- total.c <- TRUE 388 | 389 | res <- list(tab = tab, prop.row = CPR, prop.col = CPC, prop.tbl = CPT, 390 | gt = GT, rs = RS, cs = CS, total.n = TotalN, chisq = chisq, 391 | CST = CST, chisq.corr = CSTc, fisher.ts = FTt, 392 | fisher.lt = FTl, fisher.gt = FTg, print.mcnemar = mcnemar, 393 | mcnemar = McN, mcnemar.corr = McNc, asr = ASR, 394 | RowData = RowData, ColData = ColData, digits = digits, 395 | max.width = max.width, vector.x = vector.x, 396 | expected = expected, prop.chisq = prop.chisq, resid = resid, 397 | sresid = sresid, asresid = asresid, format = format, 398 | cell.layout = cell.layout, row.labels = row.labels, 399 | percent = percent, total.r = total.r, total.c = total.c) 400 | 401 | # Add "t" element to avoid breaking pander package which manipulates the 402 | # CrossTable object: 403 | res$t <- res$tab 404 | 405 | # Attributes for plotting 406 | attr(res, "xlab") <- xlab 407 | attr(res, "ylab") <- ylab 408 | 409 | class(res) <- "CrossTable" 410 | res 411 | } 412 | 413 | print.CrossTable <- function(x, ...) 414 | { 415 | argl <- list(...) 416 | for(n in names(argl)) 417 | if(n %in% names(x)) 418 | x[[n]] <- argl[[n]] 419 | 420 | nt <- CreateNewTab(x, ...) 421 | tab <- x$tab 422 | CPR <- x$prop.row 423 | CPC <- x$prop.col 424 | CPT <- x$prop.tbl 425 | GT <- x$gt 426 | RS <- x$rs 427 | CS <- x$cs 428 | TotalN <- x$total.n 429 | chisq <- x$chisq 430 | CST <- x$CST 431 | CSTc <- x$chisq.corr 432 | FTt <- x$fisher.ts 433 | FTl <- x$fisher.lt 434 | FTg <- x$fisher.gt 435 | McN <- x$mcnemar 436 | McNc <- x$mcnemar.corr 437 | ASR <- x$asr 438 | RowData <- x$RowData 439 | ColData <- x$ColData 440 | max.width <- x$max.width 441 | vector.x <- x$vector.x 442 | expected <- x$expected 443 | prop.r <- !is.na(CPR[1]) 444 | prop.c <- !is.na(CPC[1]) 445 | prop.t <- !is.na(CPT[1]) 446 | prop.chisq <- x$prop.chisq 447 | fisher <- (class(FTt) == "htest") 448 | resid <- x$resid 449 | sresid <- x$sresid 450 | asresid <- x$asresid 451 | mcnemar <- x$print.mcnemar 452 | format <- x$format 453 | cell.layout <- x$cell.layout 454 | total.r <- x$total.r 455 | total.c <- x$total.c 456 | outDec <- getOption("OutDec") 457 | 458 | dgts <- GetDigitsList(x) 459 | 460 | if(format == "SAS") { 461 | hdd <- 1 462 | } else { 463 | if (format == "SPSS") { 464 | hdd <- 100 465 | dgts$prop <- dgts$percent 466 | } else { 467 | stop("unknown format") 468 | } 469 | } 470 | 471 | if(vector.x) 472 | expected <- prop.chisq <- prop.c <- prop.t <- resid <- sresid <- asresid <- FALSE 473 | 474 | #### Printing the tables 475 | 476 | ## Print Cell Layout 477 | if(cell.layout){ 478 | cat(" ", gettext("Cell Contents", domain = "R-descr"), "\n") 479 | cat("|-------------------------|\n") 480 | if (format=="SAS") { 481 | cat(gettext("| N |", domain = "R-descr"), "\n") 482 | if (expected) 483 | cat(gettext("| Expected N |", domain = "R-descr"), "\n") 484 | if (prop.chisq) 485 | cat(gettext("| Chi-square contribution |", domain = "R-descr"), "\n") 486 | if (prop.r) 487 | cat(gettext("| N / Row Total |", domain = "R-descr"), "\n") 488 | if (prop.c) 489 | cat(gettext("| N / Col Total |", domain = "R-descr"), "\n") 490 | if (prop.t) 491 | cat(gettext("| N / Table Total |", domain = "R-descr"), "\n") 492 | } else if (format == "SPSS") { 493 | cat(gettext("| Count |", domain = "R-descr"), "\n") 494 | if (expected) 495 | cat(gettext("| Expected Values |", domain = "R-descr"), "\n") 496 | if (prop.chisq) 497 | cat(gettext("| Chi-square contribution |", domain = "R-descr"), "\n") 498 | if (prop.r) 499 | cat(gettext("| Row Percent |", domain = "R-descr"), "\n") 500 | if (prop.c) 501 | cat(gettext("| Column Percent |", domain = "R-descr"), "\n") 502 | if (prop.t) 503 | cat(gettext("| Total Percent |", domain = "R-descr"), "\n") 504 | } 505 | if (resid) 506 | cat(gettext("| Residual |", domain = "R-descr"), "\n") 507 | if (sresid) 508 | cat(gettext("| Std Residual |", domain = "R-descr"), "\n") 509 | if (asresid) 510 | cat(gettext("| Adj Std Resid |", domain = "R-descr"), "\n") 511 | cat("|-------------------------|\n") 512 | } 513 | 514 | ## Print 1 X N vector 515 | if (vector.x) { 516 | ## Set consistent column widths based upon dimnames and table values 517 | strt <- formatC(unclass(tab), digits = dgts$prop, format = "f", width = 0, decimal.mark = outDec) 518 | CWidth <- max(dgts$prop + 2, c(nchar(strt, type = "width"), 519 | nchar(dimnames(tab)[[2]], type = "width"))) 520 | if(prop.r){ 521 | if(vector.x) 522 | strt <- formatC(unclass(CPT), digits = dgts$prop, format = "f", width = 0, decimal.mark = outDec) 523 | CWidth <- max(CWidth, nchar(strt, type = "width")) 524 | } 525 | 526 | ## Create row separators 527 | RowSep <- paste(rep("-", CWidth + 2), collapse = "") 528 | 529 | if(is.na(max.width)) 530 | max.width = floor((getOption("width") - 2) / (CWidth + 3)) 531 | if (length(tab) > max.width) { 532 | ## set breakpoints for output based upon max.width 533 | final.row <- length(tab) %% max.width 534 | max <- length(tab) - final.row 535 | ## Define breakpoint indices for each row 536 | start <- seq(1, max, max.width) 537 | end <- start + (max.width - 1) 538 | ## Add final.row if required 539 | if (final.row > 0) { 540 | start <- c(start, end[length(end)] + 1) 541 | end <- c(end, end[length(end)] + final.row) 542 | } 543 | } else { 544 | ## Each value printed horizontally in a single row 545 | start <- 1 546 | end <- length(tab) 547 | } 548 | 549 | cat("\n") 550 | 551 | for (i in 1:length(start)) { 552 | cat("| ") 553 | cat(paste(formatC(dimnames(tab)[[2]][start[i]:end[i]], width = CWidth, format = "s"), collapse = " | ")) 554 | cat(" |\n|") 555 | cat(rep(RowSep, (end[i] - start[i]) + 1), sep = "|") 556 | cat("|\n| ") 557 | cat(formatC(tab[, start[i]:end[i]], width = CWidth, format = "d"), sep = " | ") 558 | if(prop.r){ 559 | cat(" |\n| ") 560 | cat(formatC(CPT[, start[i]:end[i]] * hdd, width = CWidth, 561 | digits = dgts$prop, format = "f", decimal.mark = outDec), sep = " | ") 562 | } 563 | cat(" |\n|") 564 | cat(rep(RowSep, (end[i] - start[i]) + 1), sep = "|") 565 | cat("|\n\n") 566 | 567 | } ## End of for (i in 1:length(start)) 568 | 569 | if(format == "SPSS" && GT < TotalN) 570 | cat("\n", gettext("Number of Missing Observations:", domain = "R-descr"), 571 | " ", TotalN-GT, " (", 100*(TotalN-GT)/TotalN, "%)\n", sep = "") 572 | return(invisible(x)) 573 | } ## End of if (vector.x) 574 | 575 | 576 | nr <- nrow(nt) 577 | nc <- ncol(nt) 578 | rnames <- rownames(nt) 579 | cnames <- colnames(nt) 580 | 581 | # Check column widths and fix them if necessary 582 | availablewidth <- getOption("width") 583 | minColWd <- max(nchar(nt, type = "width")) 584 | 585 | clabwidth <- nchar(cnames, type = "width") 586 | rlabwidth <- max(nchar(rnames, type = "width"), nchar(RowData, type = "width")) + 1 587 | totalwidth <- rlabwidth + (sum(clabwidth + 3)) 588 | 589 | # Abbreviate row and column labels. Withdraw one char of the newlimit 590 | # label until the rows fit in the screen 591 | while(totalwidth > availablewidth){ 592 | newlimit <- max(c(rlabwidth - 1, clabwidth)) - 1 593 | # FIXME: The algorithm should consider the minColWd of each column 594 | if(newlimit < minColWd) 595 | break 596 | 597 | rnames <- sapply(rnames, Abbrev1, newlimit) 598 | cnames <- sapply(cnames, Abbrev1, newlimit) 599 | RowData <- Abbrev1(RowData, newlimit) 600 | 601 | clabwidth <- nchar(cnames, type = "width") 602 | clabwidth[clabwidth < minColWd] <- minColWd 603 | rlabwidth <- max(nchar(rnames, type = "width"), nchar(RowData, type = "width")) + 1 604 | totalwidth <- rlabwidth + (sum(clabwidth + 3)) 605 | } 606 | 607 | minColWd <- apply(nt, 2, function(x) max(nchar(x, type = "width"))) 608 | clabwidth <- apply(cbind(clabwidth, minColWd), 1, max) 609 | dashedline <- rep("-", sum(clabwidth) + 3 * nc + rlabwidth) 610 | ddashedline <- gsub("-", "=", dashedline) 611 | 612 | # Calculate horizontal line locations 613 | if(x$total.c && !is.na(x$prop.col)[1]) 614 | nrnt <- nrow(nt) - 2 615 | else if(x$total.c) 616 | nrnt <- nrow(nt) - 1 617 | else 618 | nrnt <- nrow(nt) 619 | n <- nrnt / nrow(tab) 620 | idxh <- seq(n+1, nrnt+1, n) 621 | # idxh <- idxh[idxh < nrow(nt)] # necessary when total.c = FALSE 622 | 623 | ## Print table cells 624 | cat("\n", ddashedline, "\n", sep = "") 625 | if(ColData != "") 626 | cat(formatC(" ", width = rlabwidth), " ", ColData, "\n", sep = "", collapse = "") 627 | if(RowData == "") 628 | cat(formatC(" ", width = rlabwidth)) 629 | else 630 | cat(formatC(RowData, width = rlabwidth, format = "s", flag = "-")) 631 | for(j in 1:nc) 632 | cat(" ", formatC(cnames[j], width = clabwidth[j])) 633 | cat("\n", dashedline, "\n", sep = "") 634 | for(i in 1:nr){ 635 | if(i %in% idxh) 636 | cat(dashedline, "\n", sep = "") 637 | cat(formatC(rnames[i], width = rlabwidth, format = "s", flag = "-"), sep = "") 638 | if(x$percent && (prop.r || prop.c || prop.t)){ 639 | for(j in 1:nc) 640 | if(grepl("%", nt[i, j])) 641 | cat(" ", formatC(nt[i, j], width = clabwidth[j]), sep = "") 642 | else 643 | cat(" ", formatC(nt[i, j], width = clabwidth[j]), " ", sep = "") 644 | } else { 645 | for(j in 1:nc) 646 | cat(" ", formatC(nt[i, j], width = clabwidth[j])) 647 | } 648 | cat("\n") 649 | } 650 | cat(ddashedline, "\n", sep = "") 651 | 652 | 653 | ## Print Statistics 654 | if (chisq) 655 | { 656 | cat("\n") 657 | cat(gettext("Statistics for All Table Factors", domain = "R-descr"), 658 | "\n\n", sep="") 659 | 660 | cat(CST$method, "\n") 661 | cat("------------------------------------------------------------\n") 662 | fp <- format.pval(CST$p.value, digits = dgts$others) 663 | pv <- paste("p", if(substr(fp, 1L, 1L) == "<") fp else paste("=", fp)) 664 | cat(gettext("Chi^2 =", domain = "R-descr"), CST$statistic, 665 | " ", gettext("d.f. =", domain = "R-descr"), CST$parameter, 666 | " ", pv, "\n\n") 667 | 668 | if (all(dim(tab) == 2)) 669 | { 670 | cat(CSTc$method, "\n") 671 | cat("------------------------------------------------------------\n") 672 | fp <- format.pval(CSTc$p.value, digits = dgts$others) 673 | pv <- paste("p", if(substr(fp, 1L, 1L) == "<") fp else paste("=", fp)) 674 | cat(gettext("Chi^2 =", domain = "R-descr"), CSTc$statistic, 675 | " ", gettext("d.f. =", domain = "R-descr"), CSTc$parameter, 676 | " ", pv, "\n") 677 | } 678 | } 679 | 680 | ## Print McNemar tests 681 | if (is.na(McN[1]) == FALSE) 682 | { 683 | cat(rep("\n", 2)) 684 | cat(McN$method, "\n") 685 | cat("------------------------------------------------------------\n") 686 | fp <- format.pval(McN$p.value, digits = dgts$others) 687 | pv <- paste("p", if(substr(fp, 1L, 1L) == "<") fp else paste("=", fp)) 688 | cat(gettext("Chi^2 =", domain = "R-descr"), McN$statistic, 689 | " ", gettext("d.f. =", domain = "R-descr"), McN$parameter, 690 | " ", pv, "\n\n") 691 | 692 | if (is.na(McNc[1]) == FALSE) 693 | { 694 | cat(McNc$method, "\n") 695 | cat("------------------------------------------------------------\n") 696 | fp <- format.pval(McNc$p.value, digits = dgts$others) 697 | pv <- paste("p", if(substr(fp, 1L, 1L) == "<") fp else paste("=", fp)) 698 | cat(gettext("Chi^2 =", domain = "R-descr"), McNc$statistic, 699 | " ", gettext("d.f. =", domain = "R-descr"), McNc$parameter, 700 | " ", pv, "\n") 701 | } 702 | } 703 | 704 | ## Pint Fisher Tests 705 | if (fisher) 706 | { 707 | cat(rep("\n", 2)) 708 | 709 | cat(gettext("Fisher's Exact Test for Count Data", domain = "R-descr")) 710 | cat("\n------------------------------------------------------------\n") 711 | 712 | if (all(dim(tab) == 2)) 713 | { 714 | cat(gettext("Sample estimate odds ratio:", domain = "R-descr"), FTt$estimate, "\n\n") 715 | 716 | cat(gettext("Alternative hypothesis: true odds ratio is not equal to 1", 717 | domain = "R-descr"), "\n") 718 | fp <- format.pval(FTt$p.value, digits = dgts$others) 719 | pv <- paste("p", if(substr(fp, 1L, 1L) == "<") fp else paste("=", fp)) 720 | cat(pv, "\n") 721 | cat(gettextf("95%s confidence interval:", "%", domain = "R-descr"), FTt$conf.int, "\n\n") 722 | 723 | cat(gettext("Alternative hypothesis: true odds ratio is less than 1", 724 | domain = "R-descr"), "\n") 725 | fp <- format.pval(FTl$p.value, digits = dgts$others) 726 | pv <- paste("p", if(substr(fp, 1L, 1L) == "<") fp else paste("=", fp)) 727 | cat(pv, "\n") 728 | cat(gettext("95%s confidence interval:", "%", domain = "R-descr"), FTl$conf.int, "\n\n") 729 | 730 | cat(gettext("Alternative hypothesis: true odds ratio is greater than 1", 731 | domain = "R-descr"), "\n") 732 | fp <- format.pval(FTg$p.value, digits = dgts$others) 733 | pv <- paste("p", if(substr(fp, 1L, 1L) == "<") fp else paste("=", fp)) 734 | cat(pv, "\n") 735 | cat(gettext("95%s confidence interval:", "%", domain = "R-descr"), FTg$conf.int, "\n\n") 736 | } 737 | else 738 | { 739 | cat(gettext("Alternative hypothesis: two.sided", domain = "R-descr"), "\n") 740 | fp <- format.pval(FTt$p.value, digits = dgts$others) 741 | pv <- paste("p", if(substr(fp, 1L, 1L) == "<") fp else paste("=", fp)) 742 | cat(pv, "\n") 743 | } 744 | } ## End Of If(Fisher) Loop 745 | 746 | # cat(rep("\n", 2)) 747 | 748 | if(format == "SPSS"){ 749 | if (any(dim(tab) >= 2) & any(chisq, mcnemar, fisher)) 750 | { 751 | MinExpF = min(CST$expected) 752 | cat(" ", gettext("Minimum expected frequency:", domain = "R-descr"), MinExpF, "\n") 753 | NMinExpF = length(CST$expected[which(CST$expected<5)]) 754 | if (NMinExpF > 0) 755 | { 756 | NCells = length(CST$expected) 757 | cat(gettext("Cells with Expected Frequency < 5:", domain = "R-descr"), 758 | " ", NMinExpF, " ", gettext("of", domain = "R-descr"), " ", 759 | NCells, " (", 100*NMinExpF/NCells, "%)\n", sep = "") 760 | } 761 | cat("\n") 762 | 763 | } ## End of if (any(dim(tab)...)) 764 | } 765 | return(invisible(x)) 766 | } 767 | 768 | as.data.frame.CrossTable <- function(x, ...) as.data.frame(x$tab, ...) 769 | 770 | 771 | # Needed by tableStyles() of odfWeave package: 772 | dim.CrossTable <- function(x){ 773 | dim(x$tab) + 1 774 | } 775 | 776 | -------------------------------------------------------------------------------- /R/UTF-8.R: -------------------------------------------------------------------------------- 1 | 2 | fromto <- function (x, from, to) 3 | { 4 | if (is.list(x)) { 5 | xattr <- attributes(x) 6 | x <- lapply(x, fromto, from, to) 7 | attributes(x) <- xattr 8 | } else { 9 | if (is.factor(x)) { 10 | levels(x) <- iconv(levels(x), from, to, sub = "byte") 11 | } else { 12 | if (is.character(x)) 13 | x <- iconv(x, from, to, sub = "byte") 14 | } 15 | lb <- attr(x, "label") 16 | if (length(lb) > 0) { 17 | attr(x, "label") <- iconv(attr(x, "label"), from, to, sub = "byte") 18 | } 19 | } 20 | x 21 | } 22 | 23 | # Converts a variable from UTF-8 into other encoding 24 | fromUTF8 <- function (x, to = "WINDOWS-1252") 25 | { 26 | fromto(x, "UTF-8", to) 27 | } 28 | 29 | # Converts a variable from any encoding into UTF-8 30 | toUTF8 <- function (x, from = "WINDOWS-1252") 31 | { 32 | fromto(x, from, "UTF-8") 33 | } 34 | 35 | -------------------------------------------------------------------------------- /R/bwplotstats.R: -------------------------------------------------------------------------------- 1 | 2 | # --------------------------------------- 3 | # Author: Stefan Kraft 4 | # Vienna University of Technology 5 | # --------------------------------------- 6 | 7 | # Code copied from "simPopulation" package version 0.4.0 8 | 9 | quantileWt <- function(x, weights = NULL, 10 | probs = seq(0, 1, 0.25), na.rm = TRUE) { 11 | # initializations 12 | if(!is.numeric(x)) stop("'x' must be a numeric vector") 13 | x <- unname(x) # unlike 'quantile', this never returns a named vector 14 | if(is.null(weights)) { 15 | return(quantile(x, probs, na.rm=na.rm, names=FALSE, type=1)) 16 | } else if(!is.numeric(weights)) stop("'weights' must be a numeric vector") 17 | else if(length(weights) != length(x)) { 18 | stop("'weights' must have the same length as 'x'") 19 | } else if(!all(is.finite(weights))) stop("missing or infinite weights") 20 | if(!is.numeric(probs) || all(is.na(probs)) || 21 | isTRUE(any(probs < 0 | probs > 1))) { 22 | stop("'probs' must be a numeric vector with values in [0,1]") 23 | } 24 | if(length(x) == 0) return(rep.int(NA, length(probs))) 25 | if(!isTRUE(na.rm) && any(is.na(x))) { 26 | stop("missing values and NaN's not allowed if 'na.rm' is not TRUE") 27 | } 28 | # sort values and weights 29 | ord <- order(x, na.last=NA) 30 | x <- x[ord] 31 | weights <- weights[ord] 32 | # some preparations 33 | rw <- cumsum(weights)/sum(weights) 34 | # obtain quantiles 35 | select <- sapply(probs, function(p) min(which(rw >= p))) 36 | q <- x[select] 37 | return(q) 38 | } 39 | 40 | spBwplotStats <- function(x, weights = NULL, coef = 1.5, 41 | zeros = TRUE, do.out = TRUE) { 42 | # initializations 43 | if(!is.numeric(x)) stop("'x' must be a numeric vector") 44 | if(!is.numeric(coef) || length(coef) != 1 || coef < 0) { 45 | stop("'coef' must be a single non-negative number") 46 | } 47 | # get quantiles 48 | if(isTRUE(zeros)) { 49 | zero <- ifelse(is.na(x), FALSE, x == 0) 50 | x <- x[!zero] 51 | if(is.null(weights)) nzero <- sum(zero) 52 | else { 53 | # if 'zeros' is not TRUE, these checks are done in 'quantileWt' 54 | # but here we need them since we use subscripting 55 | if(!is.numeric(weights)) stop("'weights' must be a numeric vector") 56 | else if(length(weights) != length(zero)) { 57 | stop("'weights' must have the same length as 'x'") 58 | } 59 | nzero <- sum(weights[zero]) 60 | weights <- weights[!zero] 61 | } 62 | } else nzero <- NULL 63 | ok <- !is.na(x) 64 | n <- if(is.null(weights)) sum(ok) else sum(weights[ok]) 65 | if(n == 0) stats <- rep.int(NA, 5) 66 | else stats <- quantileWt(x, weights) 67 | iqr <- diff(stats[c(2, 4)]) # inter quartile range 68 | if(coef == 0) do.out <- FALSE 69 | else { 70 | if(is.na(iqr)) out <- is.infinite(x) 71 | else { 72 | lower <- stats[2] - coef * iqr 73 | upper <- stats[4] + coef * iqr 74 | out <- ifelse(ok, x < lower | x > upper, FALSE) 75 | } 76 | if(any(out)) stats[c(1, 5)] <- range(x[!out], na.rm=TRUE) 77 | } 78 | res <- list(stats=stats, n=n, nzero=nzero, 79 | out=if(isTRUE(do.out)) x[out] else numeric()) 80 | class(res) <- "spBwplotStats" 81 | res 82 | } 83 | -------------------------------------------------------------------------------- /R/compmeans.R: -------------------------------------------------------------------------------- 1 | # From Hmisc::wtd.var 2 | wtd.sd <- function(x, weights) 3 | { 4 | xbar <- sum(weights * x)/sum(weights) 5 | sqrt(sum(weights * ((x - xbar)^2))/(sum(weights) - 1)) 6 | } 7 | 8 | 9 | compmeans <- function(x, f, w, sort = FALSE, maxlevels = 60, 10 | user.missing, missing.include = FALSE, 11 | plot = getOption("descr.plot"), 12 | relative.widths = TRUE, col = "lightgray", 13 | warn = getOption("descr.warn"), ...) 14 | { 15 | row.label <- attr(f, "label") 16 | column.label <- attr(x, "label") 17 | row.name <- deparse(substitute(f)) 18 | column.name <- deparse(substitute(x)) 19 | 20 | f.name <- deparse(substitute(f)) 21 | n.name <- deparse(substitute(x)) 22 | lf <- length(f) 23 | lx <- length(x) 24 | if (lf != lx) { 25 | msg <- paste(f.name, gettext("and", domain = "R-descr"), n.name, 26 | gettext("have different lengths", domain = "R-descr")) 27 | stop(msg) 28 | } 29 | 30 | if (is.factor(f) == FALSE) { 31 | f <- factor(f) 32 | nl <- length(levels(f)) 33 | if (nl > maxlevels) { 34 | msg <- paste(f.name, 35 | gettext("was converted into a factor, but the new variable had too many levels", 36 | domain = "R-descr")) 37 | stop(msg) 38 | } 39 | if(warn){ 40 | wmsg <- paste(gettext("Warning:", domain = "R-descr"), " \"", f.name, 41 | "\" ", gettext("was converted into factor!", 42 | domain = "R-descr"), sep = "") 43 | warning(wmsg) 44 | } 45 | } else{ 46 | class(f) <- "factor" 47 | } 48 | if(!missing(user.missing)){ 49 | user.missing <- paste("^", user.missing, "$", sep = "") 50 | flevels <- levels(f) 51 | for(lev in user.missing){ 52 | if(length(grep(lev, flevels))){ 53 | idx <- grep(lev, as.character(f)) 54 | if(length(idx)) 55 | f[idx] <- NA 56 | } 57 | } 58 | f <- factor(f) 59 | } 60 | if(missing.include) 61 | f <- no.drop.levels(f) 62 | 63 | if(is.numeric(x)){ 64 | class(x) <- "numeric" 65 | } 66 | if (missing(w)) { 67 | wt <- rep(1, lf) 68 | } else { 69 | wt <- w 70 | lw <- length(w) 71 | if (lw != lf) { 72 | msg <- paste(f.name, gettext("and", domain = "R-descr"), "weight", 73 | gettext("have different lengths.", domain = "R-descr")) 74 | stop(msg) 75 | } 76 | } 77 | if(is.numeric(wt)){ 78 | class(wt) <- "numeric" 79 | } 80 | 81 | if (is.factor(x) == TRUE) { 82 | x <- as.numeric(x) 83 | if(warn){ 84 | wmsg <- paste(gettext("Warning:", domain = "R-descr"), " \"", n.name, "\" ", 85 | gettext("was converted from factor into numeric!", domain = "R-descr")) 86 | warning(wmsg) 87 | } 88 | } 89 | has.w <- FALSE 90 | k <- grep(FALSE, (is.na(f) | is.na(x) | is.na(wt))) 91 | f <- f[k] 92 | x <- x[k] 93 | wt <- wt[k] 94 | lf2 <- length(f) 95 | if (lf > lf2 && warn) { 96 | cat("\n") 97 | msg <- gettext("rows with missing values dropped", domain = "R-descr") 98 | wmsg <- paste(lf - lf2, msg) 99 | warning(wmsg) 100 | } 101 | 102 | xwsum <- tapply(x * wt, f, sum) 103 | wsum <- tapply(wt, f, sum) 104 | xmean <- xwsum / wsum 105 | wsum <- round(wsum) 106 | wsd <- xmean 107 | 108 | nflevs <- length(levels(f)) 109 | b <- split(data.frame(x, wt), f) 110 | wsd <- sapply(b, function(.df) wtd.sd(.df$x, .df$wt)) 111 | 112 | width <- wsum 113 | l <- length(xmean) 114 | xmean[l+1] <- weighted.mean(x, wt) 115 | wsum[l+1] <- round(sum(wt)) 116 | wsd[l+1] <- wtd.sd(x, wt) 117 | tab <- cbind(xmean, wsum, wsd) 118 | tabrn <- rownames(tab) 119 | tabrn[l+1] <- gettext("Total", domain = "R-descr") 120 | rownames(tab) <- tabrn 121 | colnames(tab) <- c(gettext("Mean", domain = "R-descr"), 122 | gettext("N", domain = "R-descr"), 123 | gettext("Std. Dev.", domain = "R-descr")) 124 | if(sort){ 125 | len <- length(xmean) 126 | len1 <- len - 1 127 | ordl <- order(xmean[1:len1]) # Do not sort the "Total" 128 | tab <- tab[c(ordl, len),] 129 | width <- width[ordl] 130 | f <- factor(as.numeric(f), levels = ordl, labels = levels(f)[ordl]) 131 | } 132 | attr(tab, "row.name") <- row.name 133 | attr(tab, "column.name") <- column.name 134 | attr(tab, "row.label") <- row.label 135 | attr(tab, "column.label") <- column.label 136 | attr(tab, "maxlevels") <- maxlevels 137 | attr(tab, "col") <- col 138 | if(relative.widths) 139 | attr(tab, "width") <- width 140 | else 141 | attr(tab, "width") <- rep(1, length(width)) 142 | 143 | # Add attributes to plot the object: 144 | attr(tab, "x") <- x 145 | attr(tab, "f") <- f 146 | if(!missing(w)) 147 | attr(tab, "wt") <- wt 148 | class(tab) <- c("meanscomp", "matrix") 149 | 150 | if(plot) 151 | plot.meanscomp(tab, ...) 152 | tab 153 | } 154 | 155 | print.meanscomp <- function(x, ...) 156 | { 157 | rlab <- attr(x, "row.label") 158 | clab <- attr(x, "column.label") 159 | 160 | if(is.null(rlab)) 161 | rlab <- attr(x, "row.name") 162 | if(is.null(clab)) 163 | clab <- attr(x, "column.name") 164 | 165 | # 'domain' is necessary because this function is not exported to 166 | # 'descr' namespace. 167 | msg1 <- gettext("Mean value of", domain = "R-descr") 168 | msg2 <- gettext("according to", domain = "R-descr") 169 | lwd <- getOption("width") 170 | msg <- paste(msg1, ' "', clab, '" ', msg2, ' "', rlab, '"', sep = "") 171 | 172 | # Break the label string if it is too large: 173 | if(nchar(msg, type = "width") < lwd){ 174 | cat(msg, "\n", sep = "") 175 | } else { 176 | if((nchar(msg1, type = "width") + nchar(clab, type = "width")) < lwd) { 177 | msg <- paste(msg1, ' "', clab, '" ', sep = "") 178 | if((nchar(msg, type = "width") + nchar(msg2, type = "width")) < lwd) { 179 | cat(msg, msg2, '\n', '"', rlab, '"', '\n', sep = "") 180 | } else { 181 | cat(msg, "\n", sep = "") 182 | if((nchar(msg2, type = "width") + nchar(rlab, type = "width")) < (lwd - 1)){ 183 | cat(msg2, ' "', rlab, '"\n', sep = "") 184 | } else { 185 | cat(msg2, '\n"', rlab, '"\n', sep = "") 186 | } 187 | } 188 | } else { 189 | cat(msg1, '\n"', clab, '"\n', sep = "") 190 | if((nchar(msg2, type = "width") + nchar(rlab, type = "width")) < (lwd - 1)){ 191 | cat(msg2, ' "', rlab, '"\n', sep = "") 192 | } else { 193 | cat(msg2, '\n"', rlab, '"\n', sep = "") 194 | } 195 | } 196 | } 197 | attr(x, "row.name") <- NULL 198 | attr(x, "column.name") <- NULL 199 | attr(x, "row.label") <- NULL 200 | attr(x, "column.label") <- NULL 201 | attr(x, "maxlevels") <- NULL 202 | attr(x, "x") <- NULL 203 | attr(x, "f") <- NULL 204 | attr(x, "wt") <- NULL 205 | attr(x, "col") <- NULL 206 | attr(x, "width") <- NULL 207 | class(x) <- "matrix" 208 | print(x, ...) 209 | return(invisible(NULL)) 210 | } 211 | 212 | plot.meanscomp <- function(x, xlab, ylab, width, col, ...) 213 | { 214 | if(missing(xlab)) 215 | xlab <- attr(x, "row.label") 216 | if(missing(ylab)) 217 | ylab <- attr(x, "column.label") 218 | if(is.null(xlab)) 219 | xlab <- attr(x, "row.name") 220 | if(is.null(ylab)) 221 | ylab <- attr(x, "column.name") 222 | 223 | if(missing(width)) 224 | width <- attr(x, "width") 225 | if(missing(col)) 226 | col <- attr(x, "col") 227 | maxlevels <- attr(x, "maxlevels") 228 | v <- attr(x, "x") 229 | f <- attr(x, "f") 230 | w <- attr(x, "wt") 231 | 232 | if(!is.factor(f)) 233 | stop(gettext("f is not a factor.", domain = "R-descr")) 234 | if(length(levels(f)) > maxlevels) 235 | stop(gettext("Number of levels of \"f\" is higher than maxlevels.", 236 | domain = "R-descr")) 237 | 238 | if(is.null(w)){ 239 | boxplot(v ~ f, ylab = ylab, xlab = xlab, width = width, col = col, ...) 240 | } else { 241 | d <- data.frame(v, f, w) 242 | dd <- split(d, f) 243 | zz <- lapply(dd, function(d) spBwplotStats(d$v, d$w)) 244 | z <- zz[[1]] 245 | z$nzero <- NULL 246 | z <- unclass(z) 247 | z$group <- rep(1, length(z$out)) 248 | z$names <- levels(f) 249 | for(i in 2:length(zz)){ 250 | z$stats <- cbind(z$stats, zz[[i]]$stats) 251 | z$n <- c(z$n, zz[[i]]$n) 252 | z$out <- c(z$out, zz[[i]]$out) 253 | z$group <- c(z$group, rep(i, length(zz[[i]]$out))) 254 | } 255 | bxp(z, ylab = ylab, xlab = xlab, width = width, boxfill = col, ...) 256 | return(invisible(z)) 257 | } 258 | } 259 | -------------------------------------------------------------------------------- /R/crosstab.R: -------------------------------------------------------------------------------- 1 | 2 | crosstab <- function(dep, indep, weight = NULL, 3 | digits = list(expected = 1, prop = 3, percent = 1, others = 3), 4 | max.width = NA, expected = FALSE, prop.r = FALSE, 5 | prop.c = FALSE, prop.t = FALSE, prop.chisq = FALSE, 6 | chisq = FALSE, fisher = FALSE, mcnemar = FALSE, resid = FALSE, 7 | sresid = FALSE, asresid = FALSE, missing.include = FALSE, 8 | drop.levels = TRUE, format = "SPSS", cell.layout = TRUE, 9 | row.labels = !cell.layout, 10 | percent = (format == "SPSS" && !row.labels), 11 | total.r, total.c, 12 | dnn = "label", xlab = NULL, ylab = NULL, main = "", 13 | user.missing.dep, user.missing.indep, 14 | plot = getOption("descr.plot"), ...) 15 | { 16 | if(missing(dep)) 17 | stop("The argument 'dep' (dependent variable) is missing.") 18 | if(missing(indep)) 19 | stop("The 'indep' (independent variable) is missing. Please, consider using either CrossTable() or freq().") 20 | 21 | if(length(dnn) == 1 && dnn == "label"){ 22 | dimn <- c(deparse(substitute(dep)), deparse(substitute(indep))) 23 | if(!is.null(attr(dep, "label"))) 24 | dimn[1] <- attr(dep, "label") 25 | if(!is.null(attr(indep, "label"))) 26 | dimn[2] <- attr(indep, "label") 27 | dnn <- dimn 28 | } 29 | if(is.null(dnn)) 30 | dnn <- c(deparse(substitute(dep)), deparse(substitute(indep))) 31 | 32 | if(!missing(user.missing.indep)){ 33 | user.missing.indep <- paste("^", user.missing.indep, "$", sep = "") 34 | ilevels <- levels(indep) 35 | for(lev in user.missing.indep){ 36 | if(length(grep(lev, ilevels))){ 37 | idx <- grep(lev, as.character(indep)) 38 | if(length(idx)) 39 | indep[idx] <- NA 40 | } 41 | } 42 | indep <- factor(indep) 43 | } 44 | if(!missing(user.missing.dep)){ 45 | user.missing.dep <- paste("^", user.missing.dep, "$", sep = "") 46 | dlevels <- levels(dep) 47 | for(lev in user.missing.dep){ 48 | if(length(grep(lev, dlevels))){ 49 | idx <- grep(lev, as.character(dep)) 50 | if(length(idx)) 51 | dep[idx] <- NA 52 | } 53 | } 54 | dep <- factor(dep) 55 | } 56 | if(missing.include){ 57 | dep <- no.drop.levels(dep) 58 | indep <- no.drop.levels(indep) 59 | } 60 | if(drop.levels){ 61 | dep <- factor(dep) 62 | indep <- factor(indep) 63 | } 64 | if (is.null(weight)){ 65 | tab <- table(dep, indep) 66 | } else { 67 | if(getOption("descr.round.xtabs")) 68 | tab <- round(xtabs(weight ~ dep + indep)) 69 | else 70 | tab <- xtabs(weight ~ dep + indep) 71 | } 72 | names(dimnames(tab)) <- dnn 73 | 74 | if(!missing(total.r)){ 75 | if(!is.logical(total.r)) 76 | stop(gettext("total.r must be logical", domain = "R-descr")) 77 | if(missing(total.c)) 78 | total.c <- total.r 79 | } 80 | if(!missing(total.c)){ 81 | if(!is.logical(total.c)) 82 | stop(gettext("total.c must be logical", domain = "R-descr")) 83 | if(missing(total.r)) 84 | total.r <- total.c 85 | } 86 | if(missing(total.r) & missing(total.c)) 87 | total.r <- total.c <- TRUE 88 | 89 | crosstb <- CrossTable(tab, digits = digits, max.width = max.width, 90 | expected = expected, prop.r = prop.r, 91 | prop.c = prop.c, prop.t = prop.t, 92 | prop.chisq = prop.chisq, chisq = chisq, 93 | fisher = fisher, mcnemar = mcnemar, resid = resid, 94 | sresid = sresid, asresid = asresid, 95 | missing.include = missing.include, 96 | drop.levels = drop.levels, format = format, dnn = dnn, 97 | cell.layout = cell.layout, row.labels = row.labels, 98 | percent = percent, total.r = total.r, 99 | total.c = total.c, xlab = xlab, ylab = ylab) 100 | 101 | if(plot == TRUE) 102 | plot.CrossTable(crosstb, ...) 103 | 104 | crosstb 105 | } 106 | 107 | 108 | plot.CrossTable <- function(x, xlab, ylab, main = "", col, inv.x = FALSE, inv.y = FALSE, ...) 109 | { 110 | tabforplot <- t(x$tab) 111 | if(missing(xlab)){ 112 | lab <- attr(x, "xlab") 113 | if(is.null(lab)) 114 | xlab <- x$ColData 115 | else 116 | xlab <- lab 117 | } 118 | if(missing(ylab)){ 119 | lab <- attr(x, "ylab") 120 | if(is.null(lab)) 121 | ylab <- x$RowData 122 | else 123 | ylab <- lab 124 | } 125 | nxlev <- dim(tabforplot)[1] 126 | nylev <- dim(tabforplot)[2] 127 | if(missing(col)){ 128 | col.min <- 0.9 - 0.25 * (nylev - 1) 129 | if(col.min < 0.3) 130 | col.min <- 0.3 131 | col <- gray.colors(nylev, 0.9, col.min) 132 | } 133 | if(inv.x) 134 | tabforplot <- tabforplot[nxlev:1, ] 135 | if(inv.y) 136 | tabforplot <- tabforplot[, nylev:1] 137 | class(tabforplot) <- "table" 138 | if(length(grep("^color$", names(list(...)))) == 0) 139 | mosaicplot(tabforplot, main = main, xlab = xlab, ylab = ylab, col = col, ...) 140 | else 141 | mosaicplot(tabforplot, main = main, xlab = xlab, ylab = ylab, ...) 142 | } 143 | 144 | -------------------------------------------------------------------------------- /R/dataframe2txt.R: -------------------------------------------------------------------------------- 1 | 2 | data.frame2txt <- function(x, datafile = "x.txt", 3 | r.codefile = "x.R", 4 | sps.codefile = "x.sps", 5 | df.name = "x", 6 | user.missing){ 7 | x.names <- names(x) 8 | 9 | systemfile <- sub("\\....$", "", datafile) 10 | 11 | sink(r.codefile) 12 | cat(df.name, ' <- read.delim("', datafile, '", quote = "", as.is = TRUE)\n\n', 13 | sep = "") 14 | for(column in x.names){ 15 | xx <- x[[column]] 16 | if(is.factor(xx)){ 17 | xx.levels <- gsub('"', '\\\\"', levels(xx)) 18 | n.levels <- length(xx.levels) 19 | cat(df.name, "$", column, " <- factor(", df.name, "$", column, 20 | ", levels = 1:", n.levels, ',\n labels = c("', sep = "") 21 | cat(xx.levels[1], '"', sep = "") 22 | if(n.levels > 1) cat(", ") 23 | i <- 2 24 | len <- 2 25 | while(i < n.levels){ 26 | len <- len + nchar(xx.levels[i]) + 4 27 | if(len > 80){ 28 | cat("\n ") 29 | len <- nchar(xx.levels[i]) + 6 30 | } 31 | cat('"', xx.levels[i], '", ', sep = "") 32 | i <- i + 1 33 | } 34 | if(len > 80) cat("\n ") 35 | if(n.levels > 1) cat('"', xx.levels[n.levels], '"', sep = "") 36 | cat("))\n") 37 | } 38 | } 39 | for(column in x.names){ 40 | xx <- x[[column]] 41 | xx.label <- attr(xx, "label") 42 | if(!is.null(xx.label)){ 43 | cat("attr(", df.name, "$", column, ', "label") <- "', xx.label, 44 | '"\n', sep = "") 45 | } 46 | } 47 | cat("save(", df.name, ", file = \"", systemfile, ".RData\")\n", sep = "") 48 | sink() 49 | 50 | sink(sps.codefile) 51 | cat("GET DATA\n") 52 | cat(" /TYPE=TXT\n") 53 | cat(" /FILE='", datafile, "'\n", sep = "") 54 | cat(" /DELCASE=LINE\n") 55 | cat(" /DELIMITERS=\"\\t\"\n") 56 | cat(" /ARRANGEMENT=DELIMITED\n") 57 | cat(" /FIRSTCASE=2\n") 58 | cat(" /VARIABLES=\n") 59 | for(column in x.names){ 60 | cat(" ", column, " ", sep = "") 61 | xx <- x[[column]] 62 | if(is.character(xx)){ 63 | mnc <- max(nchar(xx), na.rm = TRUE) 64 | if(mnc == 0) 65 | mnc <- 1 66 | cat("A", mnc, "\n", sep = "") 67 | } else { 68 | if(is.logical(xx)) 69 | xx <- as.numeric(xx) 70 | if(is.factor(xx)){ 71 | nlevs <- length(levels(xx)) 72 | if(nlevs < 10) cat("F1.0\n") 73 | else if(nlevs > 9 && nlevs < 100) cat("F2.0\n") 74 | else if(nlevs > 99) cat("F3.0\n") 75 | } else if(is.numeric(xx)){ 76 | if(sum(grepl("(chron|dates|times)", class(xx))) > 0){ 77 | cat("A", max(nchar(as.character(xx)), na.rm = TRUE), "\n", sep = "") 78 | } else { 79 | cat("F", max(nchar(as.character(xx)), na.rm = TRUE), ".0\n", sep = "") 80 | } 81 | } else { 82 | cat("error: undefined type\n") 83 | } 84 | } 85 | } 86 | cat(" .\n") 87 | cat("EXECUTE.\n\n") 88 | 89 | for(column in x.names){ 90 | xx <- x[[column]] 91 | xx.label <- attr(xx, "label") 92 | if(!is.null(xx.label)) 93 | cat("VARIABLE LABELS ", column, ' "', xx.label, '" .\n', sep = "") 94 | } 95 | cat("\n") 96 | 97 | for(column in x.names){ 98 | xx <- x[[column]] 99 | if(is.factor(xx)){ 100 | cat("VALUE LABELS ", column, "\n", sep = "") 101 | xx.levels <- levels(xx) 102 | len <- length(xx.levels) 103 | for(i in 1:len){ 104 | if(i < len){ 105 | cat(" ", i, ' "', xx.levels[i], '"\n', sep = "") 106 | } else { 107 | cat(" ", i, ' "', xx.levels[i], '" .\n', sep = "") 108 | } 109 | } 110 | if(!missing(user.missing)){ 111 | user.missing <- paste("^", user.missing, "$", sep = "") 112 | nmiss <- 0 113 | umiss <- numeric() 114 | i <- 1 115 | for(lmiss in user.missing){ 116 | idx <- grep(lmiss, xx.levels) 117 | if(length(idx) == 1){ 118 | nmiss <- nmiss + 1 119 | umiss[i] <- idx 120 | i <- i + 1 121 | } else { 122 | if(length(idx) > 1){ 123 | msg <- paste(gettext("Repeated labels in ", domain = "R-descr"), 124 | column, ": ", lmiss, sep = "") 125 | stop(msg) 126 | } 127 | } 128 | } 129 | if(nmiss > 0){ 130 | cat("MISSING VALUES", column, "(") 131 | cat(umiss, sep = ", ") 132 | cat(").\n") 133 | } 134 | } 135 | cat("\n") 136 | } 137 | } 138 | cat("SAVE OUTFILE='", systemfile, ".sav'\n /COMPRESSED.\n", sep = "") 139 | sink() 140 | 141 | for(column in x.names) 142 | if(is.factor(x[[column]]) || is.logical(x[[column]])) 143 | x[[column]] <- as.numeric(x[[column]]) 144 | 145 | write.table(x, file = datafile, quote = FALSE, sep = "\t", col.names = TRUE, 146 | row.names = FALSE, na = "") 147 | } 148 | 149 | -------------------------------------------------------------------------------- /R/descr.R: -------------------------------------------------------------------------------- 1 | 2 | .onLoad <- function(libname, pkgname) { 3 | library.dynam("descr", pkgname, libname, local = FALSE); 4 | 5 | if(is.null(getOption("descr.plot"))) 6 | options(descr.plot = TRUE) 7 | if(is.null(getOption("descr.warn"))) 8 | options(descr.warn = TRUE) 9 | if(is.null(getOption("descr.na.replacement"))) 10 | options(descr.na.replacement = "NA") 11 | if(is.null(getOption("descr.round.xtabs"))) 12 | options(descr.round.xtabs = TRUE) 13 | } 14 | 15 | .onUnload <- function(libpath) { 16 | library.dynam.unload("descr", libpath) 17 | } 18 | 19 | 20 | # R does not have variable labels. 21 | descr <- function (x) 22 | { 23 | if (class(x)[1] == "data.frame") { 24 | l <- length(x) 25 | bnames <- names(x) 26 | for (i in 1:l) { 27 | lb <- attr(x[[i]], "label") 28 | if (length(lb) > 0) { 29 | cat("\n", bnames[i], " - ", lb, "\n", sep = "") 30 | } 31 | else { 32 | cat("\n", bnames[i], "\n", sep = "") 33 | } 34 | print(summary(x[[i]])) 35 | } 36 | return(invisible(NULL)) 37 | } 38 | else { 39 | lb <- attr(x, "label") 40 | if (length(lb) > 0) { 41 | cat(deparse(substitute(x)), " - ", lb, "\n", sep = "") 42 | } 43 | print(summary(x)) 44 | return(invisible(NULL)) 45 | } 46 | } 47 | 48 | 49 | # The original versions of the functions freq, hist.kdnc, and LogRegR2 were 50 | # written by Dirk Enzmann who has given me 51 | # permission to include them in this package. The original code can be found at 52 | # http://www2.jura.uni-hamburg.de/instkrim/kriminologie/Mitarbeiter/Enzmann/Software/Enzmann_Software.html 53 | 54 | 55 | # Plot histogram of variable with kernel density estimates and normal curve: 56 | # I had to change the name because the "." was causing R to think that the 57 | # function was a method of hist. 58 | histkdnc <- function (v, breaks = 0, include.lowest = TRUE, right = TRUE, 59 | main = "Histogram with kernel density and normal curve", 60 | xlab = deparse(substitute(v)), col = grey(0.90), 61 | col.cur = c("red", "blue"), lty.cur = c(1, 1), 62 | xlim = NULL, ylim = NULL, ...) 63 | { 64 | v2 <- na.omit(v) 65 | x <- v2 66 | h <- hist.default(v2, plot = FALSE) 67 | if (length(breaks) == 1) 68 | breaks <- h$breaks 69 | dens <- density(v2) 70 | argv <- list(...) 71 | if(is.null(ylim)) 72 | ylim <- range(0, h$density, dnorm(x = v2, mean = mean(v2), sd = sd(v2)), 73 | dens$y) 74 | if(is.null(xlim)) 75 | xlim <- range(v2, dens$x) 76 | hist(v2, freq = FALSE, breaks = breaks, include.lowest = include.lowest, 77 | right = right, xlim = xlim, ylim = ylim, col = col, 78 | xlab = xlab, main = main, ...) 79 | lines(density(v2), col = col.cur[1], lty = lty.cur[1]) 80 | curve(dnorm(x, mean = mean(v2), sd = sd(v2)), col = col.cur[2], 81 | add = TRUE, lty = lty.cur[2]) 82 | } 83 | 84 | 85 | # Print multiple R2 analogs 86 | print.LogRegR2 <- function(x, ...) 87 | { 88 | cat(formatC(gettext("Chi2", domain = "R-descr"), flag = "-", width = 20), x$Chi2, "\n") 89 | cat(formatC(gettext("Df", domain = "R-descr"), flag = "-", width = 20), x$df, "\n") 90 | cat(formatC(gettext("Sig.", domain = "R-descr"), flag = "-", width = 20), x$p, "\n") 91 | cat(formatC(gettext("Cox and Snell Index", domain = "R-descr"), flag = "-", width = 20), x$CoxR2, "\n") 92 | cat(formatC(gettext("Nagelkerke Index", domain = "R-descr"), flag = "-", width = 20), x$NagelkerkeR2, "\n") 93 | cat(formatC(gettext("McFadden's R2", domain = "R-descr"), flag = "-", width = 20), x$RL2, "\n") 94 | return(invisible(NULL)) 95 | } 96 | 97 | # Calculates multiple R2 analogs (pseudo R2) of logistic regression: 98 | LogRegR2 <- function(model) 99 | { 100 | if (!(model$family$family == "binomial" && (model$family$link == "logit" || model$family$link == "probit"))) 101 | stop("No logistic regression model, no pseudo R^2 computed.") 102 | 103 | n <- dim(model$model)[1] 104 | Chi2 <- model$null - model$dev 105 | Df <- model$df.null - model$df.res 106 | p <- 1-pchisq(Chi2,Df) 107 | 108 | Cox <- 1-exp(-Chi2/n) # Cox & Snell Index 109 | Nag <- Cox/(1-exp(-model$null/n)) # Nagelkerke Index 110 | RL2 <- Chi2/model$null # also called McFaddens R2 111 | 112 | x <- list('Chi2'=Chi2,'df'=Df,'p'=p,'RL2'=RL2,'CoxR2'=Cox,'NagelkerkeR2'=Nag) 113 | class(x) <- "LogRegR2" 114 | x 115 | } 116 | 117 | no.drop.levels <- function(x) 118 | { 119 | if(sum(is.na(x)) > 0){ 120 | nl <- length(levels(x)) + 1 121 | lv <- c(levels(x), options("descr.na.replacement")) 122 | io <- is.ordered(x) 123 | x <- as.numeric(x) 124 | x[is.na(x)] <- nl 125 | x <- factor(x, levels = 1:nl, labels = lv, ordered = io) 126 | } 127 | x 128 | } 129 | 130 | -------------------------------------------------------------------------------- /R/file.head.R: -------------------------------------------------------------------------------- 1 | 2 | file.head <- function(file, n = 6, truncate.cols = TRUE){ 3 | lns <- readLines(file, n = n) 4 | lns <- gsub("\t", "\\\\t", lns) 5 | if(truncate.cols){ 6 | try(file.head.lns <- substr(lns, 1, getOption("width") - 1), silent = TRUE) 7 | if(!exists("file.head.lns")){ 8 | Encoding(lns) <- "bytes" 9 | file.head.lns <- substr(lns, 1, getOption("width") - 1) 10 | } 11 | } 12 | cat(file.head.lns, sep = "\n") 13 | } 14 | 15 | -------------------------------------------------------------------------------- /R/forODFTable.R: -------------------------------------------------------------------------------- 1 | 2 | forODFTable <- function(x, digits = 1, ...) 3 | { 4 | if (!isa(x, "CrossTable")) { 5 | msg <- sprintf(gettext("'%s' should be of class 'CrossTable'.", 6 | domain = "R-descr"), deparse(substitute(x))) 7 | stop(msg) 8 | } 9 | 10 | if(x$format == "SPSS") 11 | hdd <- 100 12 | else 13 | hdd <- 1 14 | nr <- dim(x$tab)[1] 15 | nc <- dim(x$tab)[2] 16 | 17 | tab <- format(x$tab, ...) 18 | if(x$expected == TRUE){ 19 | xex <- outer(x$rs, x$cs, "*") 20 | xex <- xex / x$gt 21 | xx <- format(round(xex, digits), trim = TRUE, ...) 22 | tab <- paste(tab, xx, sep = "") 23 | tab <- matrix(tab, nrow = length(x$rs), ncol = length(x$cs)) 24 | } 25 | if(x$prop.chisq){ 26 | xx <- ((x$CST$expected - x$tab) ^ 2) / x$CST$expected 27 | xx <- format(round(xx, digits), trim = TRUE, ...) 28 | tab <- paste(tab, xx, sep = "") 29 | tab <- matrix(tab, nrow = length(x$rs), ncol = length(x$cs)) 30 | } 31 | if(!is.na(x$prop.row[1])){ 32 | xx <- format(round(x$prop.row * hdd, digits), trim = TRUE, ...) 33 | if(hdd == 100) 34 | xx <- matrix(paste(xx, "%", sep = ""), nrow = nr, ncol = nc) 35 | tab <- paste(tab, xx, sep = "") 36 | tab <- matrix(tab, nrow = length(x$rs), ncol = length(x$cs)) 37 | } 38 | if(!is.na(x$prop.col[1])){ 39 | xx <- format(round(x$prop.col * hdd, digits), trim = TRUE, ...) 40 | if(hdd == 100) 41 | xx <- matrix(paste(xx, "%", sep = ""), nrow = nr, ncol = nc) 42 | tab <- paste(tab, xx, sep = "") 43 | tab <- matrix(tab, nrow = length(x$rs), ncol = length(x$cs)) 44 | } 45 | if(!is.na(x$prop.tbl[1])){ 46 | xx <- format(round(x$prop.tbl * hdd, digits), trim = TRUE, ...) 47 | if(hdd == 100) 48 | xx <- matrix(paste(xx, "%", sep = ""), nrow = nr, ncol = nc) 49 | tab <- paste(tab, xx, sep = "") 50 | tab <- matrix(tab, nrow = length(x$rs), ncol = length(x$cs)) 51 | } 52 | if(!is.na(x$resid) && x$resid == TRUE && x$expected == TRUE){ 53 | xx <- x$tab - xex 54 | xx <- format(round(xx, digits), trim = TRUE, ...) 55 | tab <- paste(tab, xx, sep = "") 56 | tab <- matrix(tab, nrow = length(x$rs), ncol = length(x$cs)) 57 | } 58 | if(!is.na(x$sresid) && x$sresid == TRUE && x$expected == TRUE){ 59 | xx <- x$CST$residual 60 | xx <- format(round(xx, digits), trim = TRUE, ...) 61 | tab <- paste(tab, xx, sep = "") 62 | tab <- matrix(tab, nrow = length(x$rs), ncol = length(x$cs)) 63 | } 64 | if(!is.na(x$asr[1])){ 65 | xx <- format(round(x$asr, digits), trim = TRUE, ...) 66 | tab <- paste(tab, xx, sep = "") 67 | tab <- matrix(tab, nrow = length(x$rs), ncol = length(x$cs)) 68 | } 69 | tab <- cbind(tab, x$rs) 70 | tab <- rbind(tab, c(x$cs, x$gt)) 71 | rownames(tab)[dim(tab)[1]] <- gettext("Total", domain = "R-descr") 72 | colnames(tab)[dim(tab)[2]] <- gettext("Total", domain = "R-descr") 73 | 74 | tab 75 | } 76 | 77 | -------------------------------------------------------------------------------- /R/freq.R: -------------------------------------------------------------------------------- 1 | 2 | freq <- function (x, w, user.missing, plot = getOption("descr.plot"), ...) 3 | { 4 | xlab <- attr(x, "label", TRUE) 5 | if(is.null(xlab)) 6 | xlab <- deparse(substitute(x)) 7 | if (is.factor(x) == FALSE) 8 | x <- as.factor(x) 9 | xclass <- class(x) 10 | 11 | if (missing(w)) 12 | w <- rep(1, length(x)) 13 | 14 | nmiss <- sum(is.na(x)) 15 | xlevels <- levels(x) 16 | l <- length(xlevels) 17 | hasna <- FALSE 18 | xv <- x 19 | if (nmiss) { 20 | hasna <- TRUE 21 | l <- l + 1 22 | xlevels[l] <- "NA's" 23 | x <- as.numeric(x) 24 | x[is.na(x)] <- l 25 | x <- factor(x, levels=1:l, labels = xlevels) 26 | } 27 | 28 | xfreq <- tapply(w, x, sum, na.rm = TRUE) 29 | xfreq[is.na(xfreq)] <- 0 30 | xtotal <- sum(xfreq, na.rm = TRUE) 31 | xperc <- 100 * xfreq / xtotal 32 | 33 | ftab <- cbind(xfreq, xperc) 34 | cnames <- c(gettext("Frequency", domain = "R-descr"), 35 | gettext("Percent", domain = "R-descr")) 36 | 37 | xvfreq <- xfreq 38 | if(nmiss){ 39 | xvfreq[xlevels == "NA's"] <- NA 40 | } 41 | if(!missing(user.missing)){ 42 | user.missing <- paste("^", user.missing, "$", sep = "") 43 | for(lev in user.missing){ 44 | idx <- grep(lev, xlevels) 45 | if(length(idx)) 46 | xvfreq[idx] <- NA 47 | } 48 | } 49 | 50 | if(nmiss || !missing(user.missing)){ 51 | xvtotal <- sum(xvfreq, na.rm = TRUE) 52 | xvperc <- 100 * xvfreq / xvtotal 53 | ftab <- cbind(ftab, xvperc) 54 | cnames <- c(cnames, gettext("Valid Percent", domain = "R-descr")) 55 | } 56 | 57 | if(xclass[1] == "ordered"){ 58 | if(nmiss || !missing(user.missing)){ 59 | xxvperc <- xvperc 60 | xxvperc[is.na(xxvperc)] <- 0 61 | xvcumsum <- cumsum(xxvperc) 62 | xvcumsum[is.na(xvperc)] <- NA 63 | } else 64 | xvcumsum <- cumsum(xperc) 65 | ftab <- cbind(ftab, xvcumsum) 66 | cnames <- c(cnames, gettext("Cum Percent", domain = "R-descr")) 67 | } 68 | 69 | total <- apply(ftab, 2, sum, na.rm = TRUE) 70 | if(xclass[1] == "ordered") 71 | total["xvcumsum"] <- NA 72 | ftab <- rbind(ftab, total) 73 | 74 | rnames <- levels(x) 75 | rnames[l + 1] <- gettext("Total", domain = "R-descr") 76 | 77 | colnames(ftab) <- cnames 78 | rownames(ftab) <- rnames 79 | 80 | attr(ftab, "xlab") <- xlab 81 | class(ftab) <- c("freqtable", "matrix") 82 | 83 | # Attributes for plotting 84 | if(nmiss || !missing(user.missing)) 85 | xdata.c <- xvfreq 86 | else 87 | xdata.c <- xfreq 88 | if(length(grep("^NA's$", names(xdata.c))) > 0) 89 | xdata.c["NA's"] <- NA 90 | xdata.c <- xdata.c[!is.na(xdata.c)] 91 | if(nmiss || !missing(user.missing)) 92 | xdata.p <- xvperc 93 | else 94 | xdata.p <- xperc 95 | if(length(grep("^NA's$", names(xdata.p))) > 0) 96 | xdata.p["NA's"] <- NA 97 | xdata.p <- xdata.p[!is.na(xdata.p)] 98 | 99 | attr(ftab, "xdata.c") <- xdata.c 100 | attr(ftab, "xdata.p") <- xdata.p 101 | 102 | if(plot == TRUE) 103 | plot.freqtable(ftab, ...) 104 | 105 | ftab 106 | } 107 | 108 | print.freqtable <- function(x, digits = 4, na.print="", ...){ 109 | xlab <- attr(x, "xlab") 110 | cat(xlab, "\n") 111 | attr(x, "xlab") <- NULL 112 | attr(x, "xdata.c") <- NULL 113 | attr(x, "xdata.p") <- NULL 114 | class(x) <- "matrix" 115 | print(x, digits = digits, na.print = na.print, ...) 116 | return(invisible(NULL)) 117 | } 118 | 119 | plot.freqtable <- function(x, y.axis = "count", ...) 120 | { 121 | if(y.axis == "count"){ 122 | xdata <- attr(x, "xdata.c") 123 | } else if(y.axis == "percent"){ 124 | xdata <- attr(x, "xdata.p") 125 | } else { 126 | msg <- paste(gettext("Invalid y.axis: '", domain = "R-descr"), 127 | y.axis[1], "'", sep = "") 128 | stop(msg) 129 | } 130 | barplot(xdata, ...) 131 | } 132 | 133 | -------------------------------------------------------------------------------- /R/fwf2csv.R: -------------------------------------------------------------------------------- 1 | 2 | fwf2csv <- function(fwffile, csvfile, names, begin, end, verbose = getOption("verbose")) 3 | { 4 | # Check for errors 5 | ncols = length(names) 6 | if(length(begin) != ncols || length(end) != ncols) 7 | stop("The vectors \"names\", \"begin\" and \"end\" must have the same length.") 8 | if(file.exists(fwffile) == FALSE){ 9 | msg <- paste(gettext("File not found:", domain = "R-descr"), fwffile) 10 | stop(msg) 11 | } 12 | 13 | csvfile <- path.expand(csvfile) 14 | fwffile <- path.expand(fwffile) 15 | 16 | .C(realfwf2csv, 17 | as.character(fwffile), 18 | as.character(csvfile), 19 | as.character(names), 20 | as.integer(begin), 21 | as.integer(end), 22 | ncols, 23 | as.logical(verbose)) 24 | 25 | return (invisible(NULL)) 26 | } 27 | -------------------------------------------------------------------------------- /R/labels2R.R: -------------------------------------------------------------------------------- 1 | 2 | labels2R <- function(lfile, rfile, dfname = "b", echo = FALSE) 3 | { 4 | if (missing(lfile)) 5 | stop(gettext("The name of file with labels is required.", 6 | domain = "R-descr")) 7 | if (missing(rfile)) 8 | stop(gettext("The name of file with R code to is required.", 9 | domain = "R-descr")) 10 | if (!is.character(lfile)) 11 | stop("lfile must be of class character.") 12 | if (!is.character(rfile)) 13 | stop("rfile must be of class character.") 14 | if (!is.character(dfname)) 15 | stop("dfname must be of class character.") 16 | infile <- path.expand(lfile[1]) 17 | outfile <- path.expand(rfile[1]) 18 | if (!file.exists(infile)) { 19 | msg <- paste(gettext("File not found:", domain = "R-descr"), 20 | lfile) 21 | stop(msg) 22 | } 23 | if (file.exists(outfile)) { 24 | unlink(outfile) 25 | } 26 | input <- readLines(infile) 27 | 28 | # The last line must be empty 29 | input <- c(input, "") 30 | 31 | nlines <- length(input) 32 | lnum <- 1 33 | while (lnum <= nlines) { 34 | cline <- input[lnum] 35 | if(echo) 36 | cat("[", lnum, "]", cline, "\n", sep = "") 37 | varname <- NULL 38 | varlab <- NULL 39 | lev <- NULL 40 | lab <- NULL 41 | if (cline != "" && grep("^[a-zA-Z]", cline) == 1) { 42 | varname <- sub("^([a-zA-Z0-9_\\.]*).*", "\\1", cline) 43 | if (grep(" ", cline) == 1) 44 | varlab <- sub("(\\w|\\.|_)* (.*)", "\\2", cline) 45 | lnum <- lnum + 1 46 | cline <- input[lnum] 47 | if(echo) 48 | cat("[", lnum, "]", cline, "\n", sep = "") 49 | nlev = 0 50 | while (cline != "" && (grep("^[0-9]* ", cline) == 1 || grep("^-[0-9]* ", cline) == 1) && lnum <= nlines) { 51 | nlev <- nlev + 1 52 | lev[nlev] <- sub("^(-*[0-9]*) .*", "\\1", cline) 53 | lab[nlev] <- sub("^-*[0-9]* (.*)", "\\1", cline) 54 | if (lnum < nlines) { 55 | lnum <- lnum + 1 56 | cline <- input[lnum] 57 | if(echo) 58 | cat("[", lnum, "]", cline, "\n", sep = "") 59 | } 60 | } 61 | if (!is.null(lev)) 62 | cat(dfname, "$", varname, " <- factor(", dfname, 63 | "$", varname, ",\n levels = c(", paste(lev, 64 | collapse = ", "), "),\n labels = c(\"", 65 | paste(lab, collapse = "\", \""), "\"))\n", 66 | sep = "", file = outfile, append = TRUE) 67 | if (!is.null(varlab)) 68 | cat("attr(", dfname, "$", varname, ", \"label\") <- \"", 69 | varlab, "\"\n", sep = "", file = outfile, append = TRUE) 70 | cat("\n", file = outfile, append = TRUE) 71 | } 72 | if (lnum <= nlines) 73 | lnum <- lnum + 1 74 | } 75 | return(invisible(NULL)) 76 | } 77 | 78 | 79 | -------------------------------------------------------------------------------- /R/xtable.R: -------------------------------------------------------------------------------- 1 | 2 | xtable.CrossTable <- function(x, caption = NULL, label = NULL, 3 | align = NULL, digits = NULL, 4 | display = NULL, auto = FALSE, 5 | multirow = FALSE, hline = FALSE, ...) 6 | { 7 | argl <- list(...) 8 | for(n in names(argl)) 9 | if(n %in% names(x)) 10 | x[[n]] <- argl[[n]] 11 | 12 | nr <- nrow(x$tab) 13 | nc <- ncol(x$t) 14 | 15 | nt <- CreateNewTab(x, ...) 16 | # Scape the % symbol if the user probably will not sanitize the text 17 | if(multirow || hline){ 18 | if(x$percent) 19 | for(i in 1:nrow(nt)) 20 | for(j in 1:ncol(nt)) 21 | nt[i, j] <- sub("%", "\\\\%", nt[i, j]) 22 | if(x$row.labels) 23 | rownames(nt) <- sub("%", "\\\\%", rownames(nt)) 24 | } 25 | 26 | # Add rownames as first column 27 | nt <- cbind(rownames(nt), nt) 28 | colnames(nt)[1] <- x$RowData 29 | rownames(nt) <- NULL 30 | 31 | if(x$total.c && !is.na(x$prop.col)[1]) 32 | nrnt <- nrow(nt) - 2 33 | else if(x$total.c) 34 | nrnt <- nrow(nt) - 1 35 | else 36 | nrnt <- nrow(nt) 37 | 38 | n <- nrnt / nr 39 | if(multirow && !x$row.labels){ 40 | idxm <- seq(1, nrnt, n) 41 | nt[idxm, 1] <- paste("\\multirow{", n, "}{*}{", nt[idxm, 1], "}", sep = "") 42 | } 43 | if(hline){ 44 | idxh <- seq(n+1, nrnt+1, n) 45 | idxh <- idxh[idxh < nrow(nt)] # necessary when total.c = FALSE 46 | nt[idxh, 1] <- paste("\\hline\n", nt[idxh, 1], sep = "") 47 | } 48 | 49 | if(multirow){ 50 | idxc <- 1:ncol(x$tab) + 1 51 | colnames(nt)[idxc] <- paste0("\\multicolumn{1}{c}{", colnames(nt)[idxc], "}") 52 | col1txt <- paste0("\\multirow{2}{*}{", gsub("\\$", "\\\\$", x$RowData), "} & \\multicolumn{", ncol(x$tab), "}{c}{", gsub("\\$", "\\\\$", x$ColData), "}") 53 | if(x$total.r) 54 | col1txt <- paste0(col1txt, " & \\multirow{2}{*}{", colnames(nt)[ncol(nt)], "}\\\\\n \\cline{2-", ncol(x$tab)+1,"}", sep = "") 55 | else 56 | col1txt <- paste0(col1txt, " \\\\\n \\cline{2-", ncol(x$tab)+1,"}") 57 | colnames(nt)[1] <- col1txt 58 | if(x$total.r) 59 | colnames(nt)[ncol(nt)] <- " " 60 | } 61 | 62 | if(is.null(align)) 63 | align = paste0("ll", paste(rep("r", ncol(nt) - 1), collapse = "")) 64 | xtable::xtable(nt, caption = caption, label = label, align = align, 65 | digits = digits, display = display, auto = auto, ...) 66 | } 67 | 68 | xtable.freqtable <- function(x, caption = NULL, label = NULL, align = NULL, 69 | digits = 1, display = NULL, ...) 70 | { 71 | if(is.null(align)) 72 | align <- paste0("l", paste0(rep("r", ncol(x)), collapse = "")) 73 | if(is.null(display)) 74 | display <- c("s", "d", rep("f", ncol(x) - 1)) 75 | xtable::xtable(unclass(x), caption=caption, label=label, align=align, 76 | display=display, ...) 77 | } 78 | 79 | xtable.meanscomp <- function(x, caption = NULL, label = NULL, align = NULL, 80 | digits = 1, display = NULL, ...) 81 | { 82 | if(is.null(align)) 83 | align <- "lrrr" 84 | if(is.null(display)) 85 | display <- c("s", "f", "d", "f") 86 | xtable::xtable(unclass(x), caption=caption, label=label, align=align, 87 | display=display, ...) 88 | } 89 | 90 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | descr: Descriptive statistics for R 2 | =================================== 3 | 4 | This is the development version of the R package 'descr'. 5 | 6 | -------------------------------------------------------------------------------- /inst/po/en@quot/LC_MESSAGES/R-descr.mo: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jalvesaq/descr/b627366a2cc70adc805b0cb2ad3d8d85b5cb970a/inst/po/en@quot/LC_MESSAGES/R-descr.mo -------------------------------------------------------------------------------- /inst/po/en@quot/LC_MESSAGES/descr.mo: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jalvesaq/descr/b627366a2cc70adc805b0cb2ad3d8d85b5cb970a/inst/po/en@quot/LC_MESSAGES/descr.mo -------------------------------------------------------------------------------- /inst/po/pt_BR/LC_MESSAGES/R-descr.mo: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jalvesaq/descr/b627366a2cc70adc805b0cb2ad3d8d85b5cb970a/inst/po/pt_BR/LC_MESSAGES/R-descr.mo -------------------------------------------------------------------------------- /inst/po/pt_BR/LC_MESSAGES/descr.mo: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jalvesaq/descr/b627366a2cc70adc805b0cb2ad3d8d85b5cb970a/inst/po/pt_BR/LC_MESSAGES/descr.mo -------------------------------------------------------------------------------- /man/CrossTable.Rd: -------------------------------------------------------------------------------- 1 | \name{CrossTable} 2 | \alias{CrossTable} 3 | \title{Cross tabulation with tests for factor independence} 4 | \description{ 5 | An implementation of a cross-tabulation function with output 6 | similar to S-Plus crosstabs() and SAS Proc Freq (or SPSS format) 7 | with Chi-square, Fisher and McNemar tests of the independence 8 | of all table factors. 9 | } 10 | \usage{ 11 | CrossTable(x, y, 12 | digits = list(expected = 1, prop = 3, percent = 1, others = 3), 13 | max.width = NA, expected = FALSE, 14 | prop.r = TRUE, prop.c = TRUE, prop.t = TRUE, 15 | prop.chisq = TRUE, chisq = FALSE, fisher = FALSE, 16 | mcnemar = FALSE, resid = FALSE, sresid = FALSE, 17 | asresid = FALSE, missing.include = FALSE, 18 | drop.levels = TRUE, format = c("SAS","SPSS"), 19 | dnn = NULL, cell.layout = TRUE, 20 | row.labels = !cell.layout, 21 | percent = (format == "SPSS" && !row.labels), 22 | total.r, total.c, xlab = NULL, ylab = NULL, \dots) 23 | } 24 | \arguments{ 25 | \item{x}{A vector or a matrix. If y is specified, x must be a vector.} 26 | \item{y}{A vector in a matrix or a dataframe.} 27 | \item{digits}{Named list with number of digits after the decimal point for 28 | four categories of statistics: expected values, cell proportions, 29 | percentage and others statistics. It can also be a numeric vector with a 30 | single number if you want the same number of digits in all statistics.} 31 | \item{max.width}{In the case of a 1 x n table, the default will be 32 | to print the output horizontally. If the number of columns exceeds 33 | max.width, the table will be wrapped for each successive increment 34 | of max.width columns. If you want a single column vertical table, 35 | set max.width to 1.} 36 | \item{prop.r}{If \code{TRUE}, row proportions will be included.} 37 | \item{prop.c}{If \code{TRUE}, column proportions will be included.} 38 | \item{prop.t}{If \code{TRUE}, table proportions will be included.} 39 | \item{expected}{If \code{TRUE}, expected cell counts from the 40 | \eqn{\chi^2}{Chi-Square} will be included.} 41 | \item{prop.chisq}{If \code{TRUE}, chi-square contribution of each cell will be 42 | included.} 43 | \item{chisq}{If \code{TRUE}, the results of a chi-square test will be 44 | printed after the table.} 45 | \item{fisher}{If \code{TRUE}, the results of a Fisher Exact test will 46 | be printed after the table} 47 | \item{mcnemar}{If \code{TRUE}, the results of a McNemar test will be printed 48 | after the table.} 49 | \item{resid}{If \code{TRUE}, residual (Pearson) will be included.} 50 | \item{sresid}{If \code{TRUE}, standardized residual will be included.} 51 | \item{asresid}{If \code{TRUE}, adjusted standardized residual will be 52 | included.} 53 | \item{missing.include}{If \code{TRUE}, then NA values, if present, are 54 | included as level \code{"NA"} of both x and y. You can change the new 55 | level label by setting the value of descr.na.replacement option. Example: 56 | \code{options(descr.na.replacement = "Missing")}.} 57 | \item{drop.levels}{If \code{TRUE}, then remove any unused factor levels.} 58 | \item{format}{Either SAS (default) or SPSS, depending on the type of 59 | output desired.} 60 | \item{dnn}{The names to be given to the dimensions in the result (the dimnames 61 | names).} 62 | \item{cell.layout}{If \code{TRUE}, print the cell layout.} 63 | \item{row.labels}{If \code{TRUE}, add labels to rows of calculated 64 | statistics.} 65 | \item{percent}{A logical value indicating whether to add the percentage 66 | symbol \samp{prop.r}, \samp{prop.c} and \samp{prop.t} if \samp{format} is 67 | \samp{"SPSS"}.}. 68 | \item{total.r}{If \code{TRUE}, print row totals.} 69 | \item{total.c}{If \code{TRUE}, print column totals.} 70 | \item{xlab}{A title for the x axis when plotting the CrossTable object (see 71 | \code{\link[graphics]{title}}). If missing, \code{dnn[1]} is used if not 72 | \code{NULL}.} 73 | \item{ylab}{A title for the y axis when plotting the CrossTable object (see 74 | \code{\link[graphics]{title}}). If missing, \code{dnn[2]} is used if not 75 | \code{NULL}.} 76 | \item{\dots}{Optional arguments passed to \code{\link[stats]{chisq.test}}.} 77 | } 78 | \details{ 79 | A summary table will be generated with cell row, column and table 80 | proportions and marginal totals and proportions. Expected cell counts can be 81 | printed if desired. In the case of a 2 x 2 table, both corrected and 82 | uncorrected values will be included for appropriate tests. In the case of 83 | tabulating a single vector, cell counts and table proportions will be 84 | printed. 85 | 86 | Note 1: If 'x' is a vector and 'y' is not specified, no statistical tests 87 | will be performed, even if any are set to \code{TRUE}. 88 | 89 | Note 2: 'x' and 'y' labels will be truncated if the table is not going to 90 | fit to the screen, according to the value of \code{getOption("width")}. 91 | 92 | 93 | If both arguments \samp{total.c} and \samp{total.r} are missing, both will 94 | be \code{TRUE}. If only one of them is missing, the other will have the same 95 | value of the not missing one. 96 | } 97 | \value{ 98 | A list of class \code{CrossTable} containing parameters used by the 99 | \code{print.CrossTable} method and the following components: 100 | 101 | tab: An n by m matrix containing table cell counts. 102 | 103 | prop.row: An n by m matrix containing cell row proportions. 104 | 105 | prop.col: An n by m matrix containing cell column proportions. 106 | 107 | prop.tbl: An n by m matrix containing cell table proportions. 108 | 109 | chisq: Results from the Chi-Square test. A list with class 'htest'. 110 | See \code{\link[stats]{chisq.test}} for details. 111 | 112 | chisq.corr: Results from the corrected Chi-Square test. A list with class 113 | 'htest'. See \code{\link[stats]{chisq.test}} for details. ONLY included in 114 | the case of a 2 x 2 table. 115 | 116 | fisher.ts: Results from the two-sided Fisher Exact test. A list with 117 | class 'htest'. See \code{\link[stats]{fisher.test}} for details. ONLY 118 | included if 'fisher' = TRUE. 119 | 120 | fisher.lt: Results from the Fisher Exact test with HA = "less". A list 121 | with class 'htest'. See \code{\link[stats]{fisher.test}} for details. ONLY 122 | included if 'fisher' = TRUE and in the case of a 2 x 2 table. 123 | 124 | fisher.gt: Results from the Fisher Exact test with HA = "greater". A list 125 | with class 'htest'. See \code{\link[stats]{fisher.test}} for details. ONLY 126 | included if 'fisher' = TRUE and in the case of a 2 x 2 table. 127 | 128 | mcnemar: Results from the McNemar test. A list with class 'htest'. See 129 | \code{\link[stats]{mcnemar.test}} for details. ONLY included if 'mcnemar' = 130 | TRUE. 131 | 132 | mcnemar.corr: Results from the corrected McNemar test. A list with class 133 | 'htest'. See \code{\link[stats]{mcnemar.test}} for details. ONLY included if 134 | 'mcnemar' = TRUE and in the case of a 2 x 2 table. 135 | 136 | resid/sresid/asresid: Pearson Residuals (from chi-square tests). 137 | 138 | } 139 | \author{Jakson Aquino \email{jalvesaq@gmail.com} has splited the function 140 | \code{CrossTable} (from the package \code{gmodels}) in two: 141 | \code{CrossTable} and \code{print.CrossTable}. The \code{gmodels}'s function 142 | was developed by Marc Schwartz (original version posted to r-devel on Jul 143 | 27, 2002. SPSS format modifications added by Nitin Jain based upon code 144 | provided by Dirk Enzmann).} 145 | 146 | \seealso{\code{\link{crosstab}} (a wrapper to \samp{CrossTable} that makes it 147 | easier to do a weighted contingency table), \code{\link{plot.CrossTable}}, 148 | \code{\link{forODFTable}}, \code{\link[base]{table}}, 149 | \code{\link[base]{prop.table}}, \code{\link[stats]{xtabs}}.} 150 | 151 | \examples{ 152 | # Simple cross tabulation of education versus prior induced 153 | # abortions using infertility data 154 | data(warpbreaks, package = "datasets") 155 | ct <- CrossTable(warpbreaks$wool, warpbreaks$tension, 156 | dnn = c("Wool", "Tension")) 157 | data(esoph, package = "datasets") 158 | ct <- CrossTable(esoph$alcgp, esoph$agegp, expected = TRUE, 159 | chisq = FALSE, prop.chisq = FALSE, 160 | dnn = c("Alcohol consumption", "Tobacco consumption")) 161 | plot(ct, inv.y = TRUE) 162 | print(ct) 163 | 164 | # While printing the object, you can replace some (but not all) 165 | # arguments previously passed to CrossTable 166 | print(ct, format = "SPSS", cell.layout = FALSE, row.labels = TRUE) 167 | 168 | # For better examples, including the use of xtable, 169 | # see the documentation of crosstab(). 170 | } 171 | -------------------------------------------------------------------------------- /man/LogRegR2.Rd: -------------------------------------------------------------------------------- 1 | \encoding{UTF-8} 2 | \name{LogRegR2} 3 | \alias{LogRegR2} 4 | \title{Pseudo R2 of logistic regression} 5 | \description{ 6 | The function calculates multiple R2 analogues (pseudo R2) of logistic 7 | regression. 8 | } 9 | \usage{ 10 | LogRegR2(model) 11 | } 12 | \arguments{ 13 | \item{model}{A logistic regression model.} 14 | } 15 | 16 | \details{The function calculates McFaddens R2, Cox & Snell Index, and 17 | Nagelkerke Index of a logistic regression model. 18 | } 19 | 20 | \value{ 21 | A object of class \code{list} with the calculated indexes. 22 | } 23 | 24 | \author{Dirk Enzmann} 25 | 26 | -------------------------------------------------------------------------------- /man/compmeans.Rd: -------------------------------------------------------------------------------- 1 | \name{compmeans} 2 | \alias{compmeans} 3 | \title{Means of a numerical vector according to a factor} 4 | \description{Calculates the means of a numerical vector according to a factor.} 5 | \usage{ 6 | compmeans(x, f, w, sort = FALSE, maxlevels = 60, 7 | user.missing, missing.include = FALSE, 8 | plot = getOption("descr.plot"), 9 | relative.widths = TRUE, col = "lightgray", 10 | warn = getOption("descr.warn"), \dots) 11 | } 12 | \arguments{ 13 | \item{x}{A numeric vector.} 14 | \item{f}{A factor.} 15 | \item{w}{Optional vector with weights.} 16 | \item{sort}{If \code{TRUE}, sorts the lines by the means values.} 17 | \item{maxlevels}{Maximum number of levels that \code{x} converted into factor 18 | should have.} 19 | \item{user.missing}{Character vector, indicating what levels of \code{f} 20 | must be treated as missing values.} 21 | \item{missing.include}{If \code{TRUE}, then NA values, if present in 22 | \code{f}, are included as level \code{"NA"}. You can change the new level 23 | label by setting the value of descr.na.replacement option. Example: 24 | \code{options(descr.na.replacement = "Missing")}.} 25 | \item{plot}{Logical: if \code{TRUE} (default), a boxplot is produced. 26 | You may put 27 | 28 | \code{options(descr.plot = FALSE)} 29 | 30 | in your \file{.Rprofile} to change the default function behavior.} 31 | \item{relative.widths}{If \code{TRUE}, the boxes widths will be proportional 32 | to the number of elements in each level of \code{f}.} 33 | \item{col}{Vector with the boxes colors.} 34 | \item{warn}{Warn if conversion from factor into numeric or from numeric into 35 | factor was performed and if missing values were dropped (default: \code{TRUE}).} 36 | \item{\dots}{Further arguments to be passed to either 37 | \code{\link[graphics]{boxplot}} (if \code{w} is missing) or 38 | \code{\link[graphics]{bxp}} (for \code{w} weighted boxplot).} 39 | } 40 | \value{ 41 | A matrix with class \code{c("matrix", "meanscomp")} with labels attributes 42 | for \code{x} and \code{f}. The returned object can be plotted, generating 43 | a \code{\link[graphics]{boxplot}} of \code{x} grouped by \code{f}. 44 | } 45 | \author{Jakson A. Aquino \email{jalvesaq@gmail.com}, with code for weighted 46 | boxplots written by Stefan Kraft for simPopulation package.} 47 | 48 | \seealso{\code{\link[graphics]{boxplot}}.} 49 | 50 | \examples{ 51 | sex <- factor(c(rep("F", 900), rep("M", 900))) 52 | income <- 100 * (rnorm(1800) + 5) 53 | weight <- rep(1, 1800) 54 | weight[sex == "F" & income > 500] <- 3 55 | attr(income, "label") <- "Income" 56 | attr(sex, "label") <- "Sex" 57 | compmeans(income, sex, col = "lightgray", ylab = "income", xlab = "sex") 58 | comp <- compmeans(income, sex, weight, plot = FALSE) 59 | plot(comp, col = c("pink", "lightblue"), ylab = "income", xlab = "sex") 60 | 61 | library(xtable) 62 | # If the decimal separator in your country is a comma: 63 | # options(OutDec = ",") 64 | print(xtable(comp, caption = "Income according to sex", label = "tab:incsx")) 65 | } 66 | -------------------------------------------------------------------------------- /man/crosstab.Rd: -------------------------------------------------------------------------------- 1 | \name{crosstab} 2 | \alias{crosstab} 3 | \title{Cross tabulation with mosaic plot} 4 | \description{ 5 | This function is a wrapper for \code{\link{CrossTable}}, adding a 6 | mosaic plot and making it easier to do a weighted cross-tabulation. 7 | } 8 | \usage{ 9 | crosstab(dep, indep, weight = NULL, 10 | digits = list(expected = 1, prop = 3, percent = 1, others = 3), 11 | max.width = NA, 12 | expected = FALSE, prop.r = FALSE, prop.c = FALSE, prop.t = FALSE, 13 | prop.chisq = FALSE, chisq = FALSE, fisher = FALSE, mcnemar = FALSE, 14 | resid = FALSE, sresid = FALSE, asresid = FALSE, 15 | missing.include = FALSE, drop.levels = TRUE, format = "SPSS", 16 | cell.layout = TRUE, row.labels = !cell.layout, 17 | percent = (format == "SPSS" && !row.labels), 18 | total.r, total.c, dnn = "label", xlab = NULL, 19 | ylab = NULL, main = "", user.missing.dep, user.missing.indep, 20 | plot = getOption("descr.plot"), \dots) 21 | } 22 | 23 | \arguments{ 24 | \item{dep, indep}{Vectors in a matrix or a dataframe. \code{dep} should be 25 | the dependent variable, and \code{indep} should be the independent one.} 26 | \item{weight}{An optional vector for a weighted cross tabulation.} 27 | \item{digits}{See \code{\link{CrossTable}}.} 28 | \item{max.width}{See \code{\link{CrossTable}}.} 29 | \item{expected}{See \code{\link{CrossTable}}.} 30 | \item{prop.r}{See \code{\link{CrossTable}}.} 31 | \item{prop.c}{See \code{\link{CrossTable}}.} 32 | \item{prop.t}{See \code{\link{CrossTable}}.} 33 | \item{prop.chisq}{See \code{\link{CrossTable}}.} 34 | \item{chisq}{See \code{\link{CrossTable}}.} 35 | \item{fisher}{See \code{\link{CrossTable}}.} 36 | \item{mcnemar}{See \code{\link{CrossTable}}.} 37 | \item{resid}{See \code{\link{CrossTable}}.} 38 | \item{sresid}{See \code{\link{CrossTable}}.} 39 | \item{asresid}{See \code{\link{CrossTable}}.} 40 | \item{missing.include}{See \code{\link{CrossTable}}.} 41 | \item{drop.levels}{See \code{\link{CrossTable}}.} 42 | \item{format}{See \code{\link{CrossTable}}.} 43 | \item{cell.layout}{See \code{\link{CrossTable}}.} 44 | \item{row.labels}{See \code{\link{CrossTable}}.} 45 | \item{percent}{See \code{\link{CrossTable}}.} 46 | \item{total.r}{See \code{\link{CrossTable}}.} 47 | \item{total.c}{See \code{\link{CrossTable}}.} 48 | \item{dnn}{See \code{\link{CrossTable}}. If \code{dnn = "label"}, then the 49 | \samp{"label"} attribute of \samp{dep} and \samp{indep} will be used as 50 | the dimension names.} 51 | \item{xlab}{See \code{\link[graphics]{plot.default}}.} 52 | \item{ylab}{See \code{\link[graphics]{plot.default}}.} 53 | \item{main}{An overall title for the plot (see 54 | \code{\link[graphics]{plot.default}} and \code{\link[graphics]{title}}).} 55 | \item{user.missing.dep}{An optional character vector with the levels of 56 | \code{dep} that should be treated as missing values.} 57 | \item{user.missing.indep}{An optional character vector with the levels of 58 | \code{indep} that should be treated as missing values.} 59 | \item{plot}{Logical: if \code{TRUE} (default), a mosaic plot is produced. 60 | You may put 61 | 62 | \code{options(descr.plot = FALSE)} 63 | 64 | in your \file{.Rprofile} to change the default function behavior.} 65 | \item{\dots}{Further arguments to be passed to 66 | \code{\link[graphics]{mosaicplot}}.} 67 | } 68 | 69 | \details{ 70 | \code{crosstab} invokes the \code{\link{CrossTable}} with all boolean 71 | options set to \code{FALSE} and \code{"SPSS"} as the default \code{format} 72 | option. The returned CrossTable object can be plotted as a 73 | \code{\link[graphics]{mosaicplot}}. Note that the gray scale colors used by 74 | default in the mosaic plot do not have any statistical meaning. The colors 75 | are used only to ease the plot interpretation. 76 | 77 | Differently from \code{\link{CrossTable}}, this function requires both 78 | \code{dep} and \code{indep} arguments. If you want an univariate tabulation, 79 | you should try either \code{\link{CrossTable}} or \code{\link{freq}}. 80 | 81 | By default, if \code{weight} has decimals, the result of \code{xtabs} is 82 | rounded before being passed to \code{\link{CrossTable}}. If you prefer that 83 | the results are not rounded, add to your code: 84 | 85 | \code{options(descr.round.xtabs = FALSE)} 86 | } 87 | 88 | \author{Jakson A. Aquino \email{jalvesaq@gmail.com}} 89 | 90 | \seealso{\code{\link{CrossTable}}, \code{\link{plot.CrossTable}}, 91 | \code{\link{xtable.CrossTable}}.} 92 | 93 | \examples{ 94 | educ <- sample(c(1, 2), 200, replace = TRUE, prob = c(0.3, 0.7)) 95 | educ <- factor(educ, levels = c(1, 2), labels = c("Low", "High")) 96 | opinion <- sample(c(1, 2, 9), 200, replace = TRUE, 97 | prob = c(0.4, 0.55, 0.05)) 98 | opinion <- factor(opinion, levels = c(1, 2, 9), 99 | labels = c("Disagree", "Agree", "Don't know")) 100 | attr(educ, "label") <- "Education level" 101 | attr(opinion, "label") <- "Opinion" 102 | weight <- sample(c(10, 15, 19), 200, replace = TRUE) 103 | 104 | crosstab(opinion, educ, xlab = "Education", ylab = "Opinion") 105 | ct <- crosstab(opinion, educ, weight, 106 | dnn = c("Opinion", "Education"), 107 | user.missing.dep = "Don't know", 108 | expected = TRUE, prop.c = TRUE, prop.r = TRUE, 109 | plot = FALSE) 110 | ct 111 | plot(ct, inv.y = TRUE) 112 | 113 | # Get the table of observed values as an object of class "table" 114 | tab <- ct$tab 115 | class(tab) 116 | tab 117 | 118 | # Get the complete cross table as "matrix" 119 | complete.tab <- descr:::CreateNewTab(ct) 120 | class(complete.tab) 121 | complete.tab 122 | 123 | ## xtable support 124 | library(xtable) 125 | 126 | # Print ugly table 127 | print(xtable(ct)) 128 | 129 | # Print pretty table 130 | # Add to the preamble of your Rnoweb document: 131 | # \usepackage{booktabs} 132 | # \usepackage{multirow} 133 | # \usepackage{dcolumn} 134 | # \newcolumntype{d}{D{.}{.}{-1}} 135 | print(xtable(ct, align = "llddd", multirow = TRUE, hline = TRUE, 136 | row.labels = TRUE, percent = FALSE, 137 | caption = "Opinion according to level of education"), 138 | booktabs = TRUE, include.rownames = FALSE, 139 | sanitize.text.function = function(x) x) 140 | } 141 | -------------------------------------------------------------------------------- /man/data.frame2txt.Rd: -------------------------------------------------------------------------------- 1 | \name{data.frame2txt} 2 | \alias{data.frame2txt} 3 | \title{Export a data.frame and create scripts to input the data again.} 4 | \description{ 5 | Export a data.frame to a tab delimited text and create R and SPSS/PSPP 6 | scripts to input the data again. 7 | } 8 | \usage{ 9 | data.frame2txt(x, datafile = "x.txt", r.codefile = "x.R", 10 | sps.codefile = "x.sps", df.name = "x", 11 | user.missing) 12 | } 13 | \arguments{ 14 | \item{x}{The data.frame to be exported.} 15 | \item{datafile}{The name of the tab delimited file to be created.} 16 | \item{r.codefile}{The name of the R script to read the data file.} 17 | \item{sps.codefile}{The name of the SPSS/PSPP script to read the data file.} 18 | \item{df.name}{The name of the data.frame object to be created by the R 19 | script.} 20 | \item{user.missing}{Labels of levels that must be coded as user missing 21 | in the sps script.} 22 | } 23 | 24 | \value{ 25 | The return value of \code{\link[utils]{write.table}}. 26 | } 27 | 28 | \details{Logical vectors are converted into numeric before being saved.} 29 | 30 | \author{Jakson A. Aquino \email{jalvesaq@gmail.com}} 31 | 32 | \examples{ 33 | \dontrun{ 34 | data(CO2) 35 | data.frame2txt(CO2) 36 | } 37 | } 38 | 39 | -------------------------------------------------------------------------------- /man/descr.Rd: -------------------------------------------------------------------------------- 1 | \name{descr} 2 | \alias{descr} 3 | \title{Summary of an object} 4 | \description{ 5 | Wrapper for the function \code{summary} of \pkg{base} package, including 6 | information about variable label. The function prints the \code{label} 7 | attribute of the object and, then, invokes \code{summary(object)}. If the object 8 | is a data frame, the function prints the \code{label} and invokes 9 | \code{summary} for each variable in the data frame. 10 | } 11 | \usage{ 12 | descr(x) 13 | } 14 | \arguments{ 15 | \item{x}{The object to be described.} 16 | } 17 | 18 | \value{ 19 | Null. 20 | } 21 | 22 | \author{Jakson Aquino \email{jalvesaq@gmail.com}} 23 | 24 | \seealso{\code{\link[base]{summary}}} 25 | 26 | -------------------------------------------------------------------------------- /man/file.head.Rd: -------------------------------------------------------------------------------- 1 | \name{file.head} 2 | \alias{file.head} 3 | \title{Prints first lines of a file.} 4 | \description{ 5 | The function prints the first lines of a file, optionally truncating the lines 6 | according to the screen width. The lines are truncated at 7 | \code{getOption("width") - 2}. 8 | } 9 | \usage{ 10 | file.head(file, n, truncate.cols = TRUE) 11 | } 12 | \arguments{ 13 | \item{file}{Character: The name of the file whose first lines should be 14 | printed.} 15 | \item{n}{The number of lines to show.} 16 | \item{truncate.cols}{Logical: if \code{TRUE} truncate the lines.} 17 | } 18 | \value{ 19 | \code{NULL}. 20 | } 21 | \author{Jakson A. Aquino \email{jalvesaq@gmail.com}} 22 | 23 | -------------------------------------------------------------------------------- /man/forODFTable.Rd: -------------------------------------------------------------------------------- 1 | \name{forODFTable} 2 | \alias{forODFTable} 3 | 4 | \title{Convert an object of class CrossTable into a matrix for odfTable} 5 | \description{The function converts an object of class CrossTable into a matrix 6 | to be printed by \samp{odfTable()} of \pkg{odfWeave} package.} 7 | \usage{ 8 | forODFTable(x, digits = 1, \dots) 9 | } 10 | \arguments{ 11 | \item{x}{A object of class \samp{CrossTable}.} 12 | \item{digits}{See \link[base]{round}.} 13 | \item{\dots}{Optional arguments passed to \link[base]{format}.} 14 | } 15 | \value{ 16 | A matrix. 17 | } 18 | \author{Jakson A. Aquino \email{jalvesaq@gmail.com}.} 19 | 20 | \seealso{\link{CrossTable}} 21 | 22 | \examples{ 23 | \dontrun{ 24 | library(odfWeave) 25 | data(infert, package = "datasets") 26 | x <- crosstab(infert$education, infert$induced, expected = TRUE) 27 | 28 | # Use the function directly: 29 | odfTable(forODFTable(x)) 30 | 31 | # Create a method for odfTable: 32 | odfTable.CrossTable <- function(x) odfTable(forODFTable(x)) 33 | odfTable(x) 34 | methods(odfTable) 35 | } 36 | } 37 | -------------------------------------------------------------------------------- /man/freq.Rd: -------------------------------------------------------------------------------- 1 | \name{freq} 2 | \alias{freq} 3 | \title{Frequency table} 4 | \description{ 5 | Prints a frequency table of the selected object. Optionally, the frequency 6 | might be weighted. 7 | } 8 | \usage{ 9 | freq(x, w, user.missing, plot = getOption("descr.plot"), \dots) 10 | } 11 | \arguments{ 12 | \item{x}{The factor from which the frequency of values is desired.} 13 | \item{w}{An optional vector for a weighted frequency table.} 14 | \item{user.missing}{Character vector, indicating what levels must be 15 | treated as missing values while calculating valid percents. Levels 16 | representing user missing values are not shown in the 17 | \code{\link[graphics]{barplot}}.} 18 | \item{plot}{Logical: if \code{TRUE} (default), a barplot is produced. 19 | You may put 20 | 21 | \code{options(descr.plot = FALSE)} 22 | 23 | in your \file{.Rprofile} to change the default function behavior.} 24 | \item{\dots}{Further arguments to be passed to \code{\link{plot.freqtable}} 25 | if \code{plot = TRUE}.} 26 | } 27 | \details{ 28 | A column with cumulative percents are added to the frequency table if \code{x} 29 | is an \code{ordered factor}. 30 | } 31 | \value{ 32 | A matrix with class \code{c("matrix", "freqtable")} with the attribute 33 | \code{"xlab"} which is a character string corresponding to either the 34 | attribute "label" of \code{x} or, if \code{x} does not have this attribute, 35 | the name of \code{x}. The returned object can be plotted, generating a 36 | \code{\link[graphics]{barplot}}. 37 | } 38 | \author{Jakson A. Aquino \email{jalvesaq@gmail.com}, based on function written by Dirk Enzmann} 39 | 40 | \examples{ 41 | x <- c(rep(1, 100), rep(2, 120), rep(3, 10), rep(NA, 12)) 42 | w <- c(rep(1.1, 122), rep(0.9, 120)) 43 | x <- factor(x, levels = c(1, 2, 3), 44 | labels = c("No", "Yes", "No answer")) 45 | attr(x, "label") <- "Do you agree?" 46 | 47 | freq(x, y.axis = "percent") 48 | f <- freq(x, w, user.missing = "No answer", plot = FALSE) 49 | f 50 | plot(f) 51 | 52 | # If the decimal separator in your country is a comma: 53 | # options(OutDec = ",") 54 | library(xtable) 55 | print(xtable(f)) 56 | } 57 | -------------------------------------------------------------------------------- /man/fromUTF8.Rd: -------------------------------------------------------------------------------- 1 | \name{fromUTF8} 2 | \alias{fromUTF8} 3 | 4 | \title{Conversion from UTF-8 encoding} 5 | \description{Converts the encoding of some attributes of an object from UTF-8 into other 6 | encoding.} 7 | \usage{ 8 | fromUTF8(x, to = "WINDOWS-1252") 9 | } 10 | \arguments{ 11 | \item{x}{A R object, usually a variable of a data frame or a data frame.} 12 | \item{to}{A string indicating the desired encoding. Common values are 13 | \code{"LATIN1"} and \code{"WINDOWS-1252"}. Type \code{iconvlist()} for the 14 | complete list of available encodings.} 15 | } 16 | \details{ 17 | The function converts the attribute \code{label} of \code{x} from UTF-8 into the 18 | specified encoding. If \code{x} is a factor, the levels are converted as well. 19 | If \code{x} is a data.frame, the function makes the conversions in all of its 20 | variables. 21 | } 22 | \value{ 23 | The object with its label and levels converted. 24 | } 25 | \author{Jakson A. Aquino \email{jalvesaq@gmail.com}.} 26 | 27 | \seealso{\link[base]{iconv}} 28 | 29 | -------------------------------------------------------------------------------- /man/fwf2csv.Rd: -------------------------------------------------------------------------------- 1 | \name{fwf2csv} 2 | \alias{fwf2csv} 3 | \title{Fast conversion of a fwf file into a csv one} 4 | \description{ 5 | Convert fixed width formated file into a tab separated one. 6 | } 7 | \usage{ 8 | fwf2csv(fwffile, csvfile, names, begin, end, 9 | verbose = getOption("verbose")) 10 | } 11 | \arguments{ 12 | \item{fwffile}{The fixed width format file.} 13 | \item{csvfile}{The csv file to be created. The fields will be separated by tab 14 | characters and there will be no quotes around strings.} 15 | \item{names}{A character vector with column names.} 16 | \item{begin}{A numeric vector with the begin offset of values in the fixed 17 | width format file.} 18 | \item{end}{A numeric vector with the end offset of values in the fixed width 19 | format file.} 20 | \item{verbose}{Logical: if \code{TRUE} a message about the number of saved 21 | lines is printed.} 22 | } 23 | 24 | \value{ 25 | NULL. 26 | } 27 | 28 | \details{ 29 | 30 | The return value is NULL, but \code{cvsfile} is created if the function is 31 | successful. The file is a text table with fields separated by tabular 32 | characters without quotes around the strings. 33 | 34 | This function is useful if you have a very big fixed width formated file to 35 | read and \link[utils]{read.fwf} would be too slow. The function that does 36 | the real job is very fast because it is written in C, and the use of RAM is 37 | minimum. 38 | 39 | } 40 | 41 | \seealso{For an efficient way of reading a csv file, see the function 42 | \samp{fread()} from \pkg{data.table} package.} 43 | 44 | \examples{ 45 | txt_file <- tempfile() 46 | csv_file <- tempfile() 47 | 48 | # Column: 12345678901234567 49 | writeLines(c("CE 1 11M43 2000", 50 | "CE 1 12F40 1800", 51 | "CE 1 13F 9 0", 52 | "CE 1 13M 6 0", 53 | "CE 2 21F36 1200", 54 | "CE 2 23M 6 0", 55 | "BA 1 11M33 2100", 56 | "BA 1 12F34 2300", 57 | "BA 1 13M10 0", 58 | "BA 1 13F 7 0", 59 | "BA 2 21F26 3600", 60 | "BA 2 22M27 3200", 61 | "BA 2 23F 2 0"), 62 | con = txt_file) 63 | 64 | tab <- rbind(c("state", 1, 2), 65 | c("municp", 3, 5), 66 | c("house", 6, 8), 67 | c("cond", 9, 9), 68 | c("sex", 10, 10), 69 | c("age", 11, 12), 70 | c("income", 13, 17)) 71 | 72 | fwf2csv(txt_file, csv_file, 73 | names = tab[, 1], 74 | begin = as.numeric(tab[, 2]), 75 | end = as.numeric(tab[, 3])) 76 | d <- read.table(csv_file, header = TRUE, 77 | sep = "\t", quote = "") 78 | d$cond <- factor(d$cond, levels = c(1, 2, 3), 79 | labels = c("Reference", "Spouse", "Child")) 80 | d$sex <- factor(d$sex) 81 | d 82 | } 83 | 84 | \author{Jakson A. Aquino \email{jalvesaq@gmail.com}} 85 | 86 | -------------------------------------------------------------------------------- /man/histkdnc.Rd: -------------------------------------------------------------------------------- 1 | \name{histkdnc} 2 | \alias{histkdnc} 3 | \title{Histogram with kernel density and normal curve} 4 | \description{ 5 | Plots a histogram with kernel density and normal curve. 6 | } 7 | \usage{ 8 | histkdnc(v, breaks = 0, include.lowest = TRUE, right = TRUE, 9 | main = "Histogram with kernel density and normal curve", 10 | xlab = deparse(substitute(v)), col = grey(0.90), 11 | col.cur = c("red", "blue"), lty.cur = c(1, 1), 12 | xlim = NULL, ylim = NULL, ...) 13 | } 14 | \arguments{ 15 | \item{v}{The object from which the histogram is desired.} 16 | \item{breaks}{See \link[graphics]{hist}.} 17 | \item{include.lowest}{See \link[graphics]{hist}.} 18 | \item{right}{See \link[graphics]{hist}.} 19 | \item{main}{See \link[graphics]{hist}.} 20 | \item{xlab}{See \link[graphics]{hist}.} 21 | \item{col}{See \link[graphics]{hist}.} 22 | \item{col.cur}{Vector of size two with the colors of, respectively, kernel 23 | density and normal curve.} 24 | \item{lty.cur}{Vector of size two with line type of, respectively, kernel 25 | density and normal curve.} 26 | \item{xlim}{See \link[graphics]{plot.default} and \link[graphics]{hist}.} 27 | \item{ylim}{See \link[graphics]{plot.default} and \link[graphics]{hist}.} 28 | \item{\dots}{Further arguments to be passed to \link[graphics]{hist}.} 29 | } 30 | 31 | 32 | \details{ 33 | The function plots a histogram of the object \code{x} with its kernel density 34 | and a normal curve with the same mean and standard deviation of \code{x}. 35 | } 36 | \value{ 37 | NULL. 38 | } 39 | \author{Dirk Enzmann (modified by Jakson Aquino\email{jalvesaq@gmail.com}).} 40 | 41 | -------------------------------------------------------------------------------- /man/labels2R.Rd: -------------------------------------------------------------------------------- 1 | \name{labels2R} 2 | \alias{labels2R} 3 | \title{Conversion of specially written text file into R code} 4 | \description{ 5 | Convert a specially written text file with information on variable labels 6 | and value labels into R code that converts integer vectors into factor 7 | variables. 8 | } 9 | \usage{ 10 | labels2R(lfile, rfile, dfname = "b", echo = FALSE) 11 | } 12 | \arguments{ 13 | \item{lfile}{The path to the text file to be converted.} 14 | \item{rfile}{The path to the file to be created.} 15 | \item{dfname}{Name of data.frame where the variables are.} 16 | \item{echo}{If \code{TRUE}, then lines of lfile are printed in the R Console 17 | while the file is parsed. This may be useful debugging.} 18 | } 19 | 20 | \value{ 21 | NULL. 22 | } 23 | 24 | \details{ 25 | The return value is NULL, but \code{rfile} is created if the function is 26 | successful. The file is an R code that converts numeric vectors into 27 | factors. The text file must have a format as in the example below: 28 | 29 | \preformatted{ 30 | v1 Sex 31 | 1 Female 32 | 2 Male 33 | 34 | v2 Household income 35 | 36 | v3 Taking all things together, would you say you are... 37 | 1 Very happy 38 | 2 Rather happy 39 | 3 Not very happy 40 | 4 Not at all happy 41 | } 42 | 43 | The above code would be converted into: 44 | 45 | \preformatted{ 46 | b$v1 <- factor(b$v1, levels=c(1, 2), labels=c("Female", "Male")) 47 | attr(b$v1, "label") <- "Sex" 48 | attr(b$v2, "label") <- "Household income" 49 | b$v3 <- factor(b$v3, levels=c(1, 2, 3, 4), 50 | labels=c("Very happy", "Rather happy", 51 | "Not very happy", "Not at all happy")) 52 | attr(b$v3, "label") <- "Taking all things together, would you say you are..." 53 | } 54 | 55 | } 56 | 57 | \author{Jakson A. Aquino \email{jalvesaq@gmail.com}} 58 | 59 | -------------------------------------------------------------------------------- /man/plot.CrossTable.Rd: -------------------------------------------------------------------------------- 1 | \name{plot.CrossTable} 2 | \alias{plot.CrossTable} 3 | \title{Mosaic plot from object of class CrossTable} 4 | \description{ 5 | This function receives a \code{\link{CrossTable}} object as its main 6 | argument and produces a mosaicplot. 7 | } 8 | \usage{ 9 | \method{plot}{CrossTable}(x, xlab, ylab, main = "", col, 10 | inv.x = FALSE, inv.y = FALSE, \dots) 11 | } 12 | 13 | \arguments{ 14 | \item{x}{A object of class CrossTable.} 15 | \item{xlab}{See \code{\link[graphics]{plot.default}}.} 16 | \item{ylab}{See \code{\link[graphics]{plot.default}}.} 17 | \item{main}{See \code{\link[graphics]{plot.default}} and \code{\link[graphics]{title}}.} 18 | \item{col}{A specification for the default plotting color. (See section 19 | \sQuote{Color Specification} of \code{\link[graphics]{par}}). If the 20 | argument is missing, a gray scale is used to make the plot easier to 21 | interpret.} 22 | \item{inv.x}{A logical value indicating whether the order of the levels of 23 | the \code{x} variable should be inverted.} 24 | \item{inv.y}{A logical value indicating whether the order of the levels of 25 | the \code{y} variable should be inverted.} 26 | \item{\dots}{Further arguments to be passed to 27 | \code{\link[graphics]{mosaicplot}}.} 28 | } 29 | 30 | \author{Jakson A. Aquino \email{jalvesaq@gmail.com}} 31 | 32 | \seealso{\code{\link{CrossTable}}, \code{\link{crosstab}}.} 33 | 34 | -------------------------------------------------------------------------------- /man/plot.freqtable.Rd: -------------------------------------------------------------------------------- 1 | \name{plot.freqtable} 2 | \alias{plot.freqtable} 3 | \title{Bar plot from object of class freqtable} 4 | \description{ 5 | This function receives a \code{freqtable} object as its main 6 | argument and produces a barplot. 7 | } 8 | \usage{ 9 | \method{plot}{freqtable}(x, y.axis = "count", \dots) 10 | } 11 | 12 | \arguments{ 13 | \item{x}{A object of class \code{freqtable}.} 14 | \item{y.axis}{Character string, indicating what variable to use in the y 15 | axis, "count" or "percent", when plotting the frequency table.} 16 | \item{\dots}{Further arguments to be passed to \code{\link[graphics]{barplot}}.} 17 | } 18 | 19 | \author{Jakson A. Aquino \email{jalvesaq@gmail.com}} 20 | 21 | -------------------------------------------------------------------------------- /man/toUTF8.Rd: -------------------------------------------------------------------------------- 1 | \name{toUTF8} 2 | \alias{toUTF8} 3 | 4 | \title{Conversion to UTF-8 encoding} 5 | \description{Converts the encoding of some attributes of an object to UTF-8} 6 | \usage{ 7 | toUTF8(x, from = "WINDOWS-1252") 8 | } 9 | \arguments{ 10 | \item{x}{A R object, usually a variable of a data frame or a data frame.} 11 | \item{from}{A string indicating the original encoding. Common values are 12 | \code{"LATIN1"} and \code{"WINDOWS-1252"}. Type \code{iconvlist()} for the 13 | complete list of available encodings.} 14 | } 15 | \details{ 16 | The function converts the attribute \code{label} of \code{x} from the 17 | specified encoding into UTF-8. If \code{x} is a factor, the levels are 18 | converted as well. If \code{x} is a data.frame, the function makes the 19 | conversions in all of its variables. 20 | } 21 | \value{ 22 | The object with its label and levels converted. 23 | } 24 | \author{Jakson A. Aquino \email{jalvesaq@gmail.com}.} 25 | 26 | \seealso{\link[base]{iconv}} 27 | 28 | -------------------------------------------------------------------------------- /man/xtable.CrossTable.Rd: -------------------------------------------------------------------------------- 1 | \name{xtable.CrossTable} 2 | \alias{xtable.CrossTable} 3 | \title{CrossTable method for xtable} 4 | \description{ 5 | The method creates an object of class xtable. 6 | } 7 | \usage{ 8 | \method{xtable}{CrossTable}(x, caption = NULL, label = NULL, 9 | align = NULL, digits = NULL, display = NULL, 10 | auto = FALSE, multirow = FALSE, hline = FALSE, \dots) 11 | } 12 | 13 | \arguments{ 14 | \item{x}{A object of class CrossTable.} 15 | \item{caption}{See \code{\link[xtable]{xtable}}.} 16 | \item{label}{See \code{\link[xtable]{xtable}}.} 17 | \item{align}{See \code{\link[xtable]{xtable}}.} 18 | \item{display}{See \code{\link[xtable]{xtable}}.} 19 | \item{digits}{See \code{\link[xtable]{xtable}}.} 20 | \item{auto}{See \code{\link[xtable]{xtable}}.} 21 | \item{multirow}{A logical value indicating whether the command 22 | \verb{\multirow} should be added to the table. See the Details section 23 | below.} 24 | \item{hline}{A logical value indicating whether the command 25 | \verb{\hline} should be added to the table. See the Details section 26 | below.} 27 | \item{\dots}{Further arguments to be passed to \code{\link[base]{format}} or 28 | to replace arguments previously passed to \code{\link{CrossTable}}.} 29 | } 30 | 31 | \details{ 32 | If either \code{multirow} or \code{hline} is \code{TRUE}, the 33 | \code{sanitize.text.function} argument of \code{\link[xtable]{print.xtable}} 34 | must be defined. You will also have to add \verb{\usepackage\{multirow\}} to 35 | your Rnoweb document. See the \code{Example} section of 36 | \code{\link{crosstab}}. 37 | } 38 | \author{Jakson A. Aquino \email{jalvesaq@gmail.com}} 39 | 40 | \seealso{\code{\link{CrossTable}}, \code{\link{crosstab}}, 41 | \code{\link[xtable]{print.xtable}}.} 42 | 43 | -------------------------------------------------------------------------------- /po/R-descr.pot: -------------------------------------------------------------------------------- 1 | msgid "" 2 | msgstr "" 3 | "Project-Id-Version: descr 1.1.4\n" 4 | "POT-Creation-Date: 2017-10-15 10:11\n" 5 | "PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n" 6 | "Last-Translator: FULL NAME \n" 7 | "Language-Team: LANGUAGE \n" 8 | "MIME-Version: 1.0\n" 9 | "Content-Type: text/plain; charset=CHARSET\n" 10 | "Content-Transfer-Encoding: 8bit\n" 11 | 12 | 13 | msgid "Total" 14 | msgstr "" 15 | 16 | msgid "expected" 17 | msgstr "" 18 | 19 | msgid "chisq" 20 | msgstr "" 21 | 22 | msgid "row %" 23 | msgstr "" 24 | 25 | msgid "row prop." 26 | msgstr "" 27 | 28 | msgid "col %" 29 | msgstr "" 30 | 31 | msgid "col prop." 32 | msgstr "" 33 | 34 | msgid "table %" 35 | msgstr "" 36 | 37 | msgid "table prop." 38 | msgstr "" 39 | 40 | msgid "residual" 41 | msgstr "" 42 | 43 | msgid "std. res." 44 | msgstr "" 45 | 46 | msgid "adj. std. res." 47 | msgstr "" 48 | 49 | msgid "max.width must be >= 1" 50 | msgstr "" 51 | 52 | msgid "all entries of x must be nonnegative and finite" 53 | msgstr "" 54 | 55 | msgid "x must be either a vector or a 2 dimensional matrix, if y is not given" 56 | msgstr "" 57 | 58 | msgid "x and y must have the same length" 59 | msgstr "" 60 | 61 | msgid "dnn must have length of 2, one element for each table dimension" 62 | msgstr "" 63 | 64 | msgid "total.r must be logical" 65 | msgstr "" 66 | 67 | msgid "total.c must be logical" 68 | msgstr "" 69 | 70 | msgid "unknown format" 71 | msgstr "" 72 | 73 | msgid "Cell Contents" 74 | msgstr "" 75 | 76 | msgid "| N |" 77 | msgstr "" 78 | 79 | msgid "| Expected N |" 80 | msgstr "" 81 | 82 | msgid "| Chi-square contribution |" 83 | msgstr "" 84 | 85 | msgid "| N / Row Total |" 86 | msgstr "" 87 | 88 | msgid "| N / Col Total |" 89 | msgstr "" 90 | 91 | msgid "| N / Table Total |" 92 | msgstr "" 93 | 94 | msgid "| Count |" 95 | msgstr "" 96 | 97 | msgid "| Expected Values |" 98 | msgstr "" 99 | 100 | msgid "| Row Percent |" 101 | msgstr "" 102 | 103 | msgid "| Column Percent |" 104 | msgstr "" 105 | 106 | msgid "| Total Percent |" 107 | msgstr "" 108 | 109 | msgid "| Residual |" 110 | msgstr "" 111 | 112 | msgid "| Std Residual |" 113 | msgstr "" 114 | 115 | msgid "| Adj Std Resid |" 116 | msgstr "" 117 | 118 | msgid "Number of Missing Observations:" 119 | msgstr "" 120 | 121 | msgid "Statistics for All Table Factors" 122 | msgstr "" 123 | 124 | msgid "Chi^2 =" 125 | msgstr "" 126 | 127 | msgid "d.f. =" 128 | msgstr "" 129 | 130 | msgid "Fisher's Exact Test for Count Data" 131 | msgstr "" 132 | 133 | msgid "Sample estimate odds ratio:" 134 | msgstr "" 135 | 136 | msgid "Alternative hypothesis: true odds ratio is not equal to 1" 137 | msgstr "" 138 | 139 | msgid "95%s confidence interval:" 140 | msgstr "" 141 | 142 | msgid "Alternative hypothesis: true odds ratio is less than 1" 143 | msgstr "" 144 | 145 | msgid "%" 146 | msgstr "" 147 | 148 | msgid "Alternative hypothesis: true odds ratio is greater than 1" 149 | msgstr "" 150 | 151 | msgid "Alternative hypothesis: two.sided" 152 | msgstr "" 153 | 154 | msgid "Minimum expected frequency:" 155 | msgstr "" 156 | 157 | msgid "Cells with Expected Frequency < 5:" 158 | msgstr "" 159 | 160 | msgid "of" 161 | msgstr "" 162 | 163 | msgid "'x' must be a numeric vector" 164 | msgstr "" 165 | 166 | msgid "'weights' must be a numeric vector" 167 | msgstr "" 168 | 169 | msgid "'weights' must have the same length as 'x'" 170 | msgstr "" 171 | 172 | msgid "missing or infinite weights" 173 | msgstr "" 174 | 175 | msgid "'probs' must be a numeric vector with values in [0,1]" 176 | msgstr "" 177 | 178 | msgid "missing values and NaN's not allowed if 'na.rm' is not TRUE" 179 | msgstr "" 180 | 181 | msgid "'coef' must be a single non-negative number" 182 | msgstr "" 183 | 184 | msgid "and" 185 | msgstr "" 186 | 187 | msgid "have different lengths" 188 | msgstr "" 189 | 190 | msgid "was converted into a factor, but the new variable had too many levels" 191 | msgstr "" 192 | 193 | msgid "Warning:" 194 | msgstr "" 195 | 196 | msgid "was converted into factor!" 197 | msgstr "" 198 | 199 | msgid "have different lengths." 200 | msgstr "" 201 | 202 | msgid "was converted from factor into numeric!" 203 | msgstr "" 204 | 205 | msgid "rows with missing values dropped" 206 | msgstr "" 207 | 208 | msgid "Mean" 209 | msgstr "" 210 | 211 | msgid "N" 212 | msgstr "" 213 | 214 | msgid "Std. Dev." 215 | msgstr "" 216 | 217 | msgid "Mean value of" 218 | msgstr "" 219 | 220 | msgid "according to" 221 | msgstr "" 222 | 223 | msgid "f is not a factor." 224 | msgstr "" 225 | 226 | msgid "Number of levels of \"f\" is higher than maxlevels." 227 | msgstr "" 228 | 229 | msgid "The argument 'dep' (dependent variable) is missing." 230 | msgstr "" 231 | 232 | msgid "The 'indep' (independent variable) is missing. Please, consider using either CrossTable() or freq()." 233 | msgstr "" 234 | 235 | msgid "Repeated labels in" 236 | msgstr "" 237 | 238 | msgid "Chi2" 239 | msgstr "" 240 | 241 | msgid "Df" 242 | msgstr "" 243 | 244 | msgid "Sig." 245 | msgstr "" 246 | 247 | msgid "Cox and Snell Index" 248 | msgstr "" 249 | 250 | msgid "Nagelkerke Index" 251 | msgstr "" 252 | 253 | msgid "McFadden's R2" 254 | msgstr "" 255 | 256 | msgid "No logistic regression model, no pseudo R^2 computed." 257 | msgstr "" 258 | 259 | msgid "'%s' should be of class 'CrossTable'." 260 | msgstr "" 261 | 262 | msgid "Frequency" 263 | msgstr "" 264 | 265 | msgid "Percent" 266 | msgstr "" 267 | 268 | msgid "Valid Percent" 269 | msgstr "" 270 | 271 | msgid "Cum Percent" 272 | msgstr "" 273 | 274 | msgid "Invalid y.axis: '" 275 | msgstr "" 276 | 277 | msgid "The vectors \"names\", \"begin\" and \"end\" must have the same length." 278 | msgstr "" 279 | 280 | msgid "File not found:" 281 | msgstr "" 282 | 283 | msgid "The name of file with labels is required." 284 | msgstr "" 285 | 286 | msgid "The name of file with R code to is required." 287 | msgstr "" 288 | 289 | msgid "lfile must be of class character." 290 | msgstr "" 291 | 292 | msgid "rfile must be of class character." 293 | msgstr "" 294 | 295 | msgid "dfname must be of class character." 296 | msgstr "" 297 | -------------------------------------------------------------------------------- /po/R-pt_BR.po: -------------------------------------------------------------------------------- 1 | # descr - Descriptive Statistics 2 | # Copyright (C) 2007-2015 3 | # This file is distributed under the same license as the descr package. 4 | # Jakson Aquino , 2015. 5 | # 6 | msgid "" 7 | msgstr "" 8 | "Project-Id-Version: descr 1.1.4\n" 9 | "Report-Msgid-Bugs-To: \n" 10 | "POT-Creation-Date: 2017-10-15 10:11\n" 11 | "PO-Revision-Date: 2017-10-15 12:11-0300\n" 12 | "Last-Translator: Jakson Aquino \n" 13 | "Language-Team: pt \n" 14 | "Language: pt_BR\n" 15 | "MIME-Version: 1.0\n" 16 | "Content-Type: text/plain; charset=UTF-8\n" 17 | "Content-Transfer-Encoding: 8bit\n" 18 | 19 | msgid "Total" 20 | msgstr "Total" 21 | 22 | msgid "expected" 23 | msgstr "esperado" 24 | 25 | msgid "chisq" 26 | msgstr "qui-quadr." 27 | 28 | msgid "row %" 29 | msgstr "% linha" 30 | 31 | msgid "row prop." 32 | msgstr "prop. linha" 33 | 34 | msgid "col %" 35 | msgstr "% coluna" 36 | 37 | msgid "col prop." 38 | msgstr "prop. col." 39 | 40 | msgid "table %" 41 | msgstr "% tabela" 42 | 43 | msgid "table prop." 44 | msgstr "prop. tabela" 45 | 46 | msgid "residual" 47 | msgstr "resíduo" 48 | 49 | msgid "std. res." 50 | msgstr "res. pd." 51 | 52 | msgid "adj. std. res." 53 | msgstr "res. pd. ajst." 54 | 55 | msgid "max.width must be >= 1" 56 | msgstr "max.width deve ser >= 1" 57 | 58 | msgid "all entries of x must be nonnegative and finite" 59 | msgstr "todos os valores de x devem ser não negativos e finitos" 60 | 61 | msgid "x must be either a vector or a 2 dimensional matrix, if y is not given" 62 | msgstr "x deve ser um vetor ou uma matriz bidimensional, se y não for dado" 63 | 64 | msgid "x and y must have the same length" 65 | msgstr "x e y devem ter o mesmo comprimento" 66 | 67 | msgid "dnn must have length of 2, one element for each table dimension" 68 | msgstr "dnn deve ter comprimento 2, um elemento para dimensão da tabela" 69 | 70 | msgid "total.r must be logical" 71 | msgstr "total.r deve ser de tipo 'logical'" 72 | 73 | msgid "total.c must be logical" 74 | msgstr "total.c deve ser de tipo 'logical'" 75 | 76 | msgid "unknown format" 77 | msgstr "formato desconhecido" 78 | 79 | msgid "Cell Contents" 80 | msgstr "Conteúdo das células" 81 | 82 | msgid "| N |" 83 | msgstr "| N |" 84 | 85 | msgid "| Expected N |" 86 | msgstr "| N esperado |" 87 | 88 | msgid "| Chi-square contribution |" 89 | msgstr "| Contribuição para Qui² |" 90 | 91 | msgid "| N / Row Total |" 92 | msgstr "| N / Total da linha |" 93 | 94 | msgid "| N / Col Total |" 95 | msgstr "| N / Total da coluna |" 96 | 97 | msgid "| N / Table Total |" 98 | msgstr "| N / Total da tabela |" 99 | 100 | msgid "| Count |" 101 | msgstr "| Contagem |" 102 | 103 | msgid "| Expected Values |" 104 | msgstr "| Valores esperados |" 105 | 106 | msgid "| Row Percent |" 107 | msgstr "| Percentual por linha |" 108 | 109 | msgid "| Column Percent |" 110 | msgstr "| Percentual por coluna |" 111 | 112 | msgid "| Total Percent |" 113 | msgstr "| Percentual total |" 114 | 115 | msgid "| Residual |" 116 | msgstr "| Resíduo |" 117 | 118 | msgid "| Std Residual |" 119 | msgstr "| Resíduo padrão |" 120 | 121 | msgid "| Adj Std Resid |" 122 | msgstr "| Resíduo padrão ajustado |" 123 | 124 | msgid "Number of Missing Observations:" 125 | msgstr "Número de observações omissas:" 126 | 127 | msgid "Statistics for All Table Factors" 128 | msgstr "Estatísticas para todos os fatores da tabela" 129 | 130 | msgid "Chi^2 =" 131 | msgstr "Qui² =" 132 | 133 | msgid "d.f. =" 134 | msgstr "g.l. =" 135 | 136 | msgid "Fisher's Exact Test for Count Data" 137 | msgstr "Teste exato de Fisher" 138 | 139 | msgid "Sample estimate odds ratio:" 140 | msgstr "Estimativa da razão de chances da amostra:" 141 | 142 | msgid "Alternative hypothesis: true odds ratio is not equal to 1" 143 | msgstr "Hipótese alternativa: a verdadeira razão de chances não é igual a 1" 144 | 145 | msgid "95%s confidence interval:" 146 | msgstr "intervalo de confiança a 95%s:" 147 | 148 | msgid "Alternative hypothesis: true odds ratio is less than 1" 149 | msgstr "Hipótese alternativa: a verdadeira razão de chances é menor do que 1" 150 | 151 | msgid "%" 152 | msgstr "%" 153 | 154 | msgid "Alternative hypothesis: true odds ratio is greater than 1" 155 | msgstr "Hipótese alternativa: a verdadeira razão de chances é maior do que 1" 156 | 157 | msgid "Alternative hypothesis: two.sided" 158 | msgstr "Hipótese alternativa: duas.caudas" 159 | 160 | msgid "Minimum expected frequency:" 161 | msgstr "Frequência esperada mínima:" 162 | 163 | msgid "Cells with Expected Frequency < 5:" 164 | msgstr "Células com frequências esperada < 5:" 165 | 166 | msgid "of" 167 | msgstr "de" 168 | 169 | msgid "'x' must be a numeric vector" 170 | msgstr "'x' deve ser um vetor numérico" 171 | 172 | msgid "'weights' must be a numeric vector" 173 | msgstr "'weights' deve ser um vetor numérico" 174 | 175 | msgid "'weights' must have the same length as 'x'" 176 | msgstr "'weights' deve ter o mesmo comprimento de 'x'" 177 | 178 | msgid "missing or infinite weights" 179 | msgstr "pesos omissos ou infinitos" 180 | 181 | msgid "'probs' must be a numeric vector with values in [0,1]" 182 | msgstr "'probs' deve ser um vetor numérico com valores no intervalo [0,1]" 183 | 184 | msgid "missing values and NaN's not allowed if 'na.rm' is not TRUE" 185 | msgstr "valores omissos e NaNs não são permitidos se 'na.rm' não é TRUE" 186 | 187 | msgid "'coef' must be a single non-negative number" 188 | msgstr "'coef' deve ser um único número não negativo" 189 | 190 | msgid "and" 191 | msgstr "e" 192 | 193 | msgid "have different lengths" 194 | msgstr "têm comprimentos diferentes" 195 | 196 | msgid "was converted into a factor, but the new variable had too many levels" 197 | msgstr "" 198 | "foi convertido em fator, mas a nova variável tinha muitas categorias (levels)" 199 | 200 | msgid "Warning:" 201 | msgstr "Aviso:" 202 | 203 | msgid "was converted into factor!" 204 | msgstr "foi convertido em fator!" 205 | 206 | msgid "have different lengths." 207 | msgstr "têm comprimentos diferentes." 208 | 209 | msgid "was converted from factor into numeric!" 210 | msgstr "foi convertido de fator para numérico!" 211 | 212 | msgid "rows with missing values dropped" 213 | msgstr "linhas com valores faltantes excluídas" 214 | 215 | msgid "Mean" 216 | msgstr "Média" 217 | 218 | msgid "N" 219 | msgstr "N" 220 | 221 | msgid "Std. Dev." 222 | msgstr "Desv. Pd." 223 | 224 | msgid "Mean value of" 225 | msgstr "Valor médio de" 226 | 227 | msgid "according to" 228 | msgstr "segundo" 229 | 230 | msgid "f is not a factor." 231 | msgstr "f não é factor." 232 | 233 | msgid "Number of levels of \"f\" is higher than maxlevels." 234 | msgstr "Número de levels de \"f\" é maior do que maxlevels." 235 | 236 | msgid "The argument 'dep' (dependent variable) is missing." 237 | msgstr "O argumento 'dep' (variável dependente) deve ser fornecido." 238 | 239 | msgid "" 240 | "The 'indep' (independent variable) is missing. Please, consider using either " 241 | "CrossTable() or freq()." 242 | msgstr "" 243 | "O argumento 'indep' (variável independente) não foi fornecido. Considere " 244 | "usar CrossTable() ou freq()." 245 | 246 | msgid "Repeated labels in" 247 | msgstr "Rótulos repetidos em" 248 | 249 | msgid "Chi2" 250 | msgstr "Qui²" 251 | 252 | msgid "Df" 253 | msgstr "Gl" 254 | 255 | msgid "Sig." 256 | msgstr "Sig." 257 | 258 | msgid "Cox and Snell Index" 259 | msgstr "Índice de Cox e Snell" 260 | 261 | msgid "Nagelkerke Index" 262 | msgstr "Índice de Nagelkerke" 263 | 264 | msgid "McFadden's R2" 265 | msgstr "R² de McFadden" 266 | 267 | msgid "No logistic regression model, no pseudo R^2 computed." 268 | msgstr "Nenhum modelo de regressão logística; nenhum pseudo R² calculado." 269 | 270 | msgid "'%s' should be of class 'CrossTable'." 271 | msgstr "O atributo 'class' do objeto '%s' deveria ser 'CrossTable'." 272 | 273 | msgid "Frequency" 274 | msgstr "Frequência" 275 | 276 | msgid "Percent" 277 | msgstr "Percentual" 278 | 279 | msgid "Valid Percent" 280 | msgstr "Perc. Válido" 281 | 282 | msgid "Cum Percent" 283 | msgstr "Perc. Acum." 284 | 285 | msgid "Invalid y.axis: '" 286 | msgstr "y.axis inválido: '" 287 | 288 | msgid "The vectors \"names\", \"begin\" and \"end\" must have the same length." 289 | msgstr "" 290 | "Os vetores \"names\", \"begin\" e \"end\" devem ter o mesmo comprimento." 291 | 292 | msgid "File not found:" 293 | msgstr "Arquivo não encontrado:" 294 | 295 | msgid "The name of file with labels is required." 296 | msgstr "O nome do arquivo com rótulos é necessário." 297 | 298 | msgid "The name of file with R code to is required." 299 | msgstr "To nome do arquivo com código do R é necessário." 300 | 301 | msgid "lfile must be of class character." 302 | msgstr "A class de lfile deve ser character. " 303 | 304 | msgid "rfile must be of class character." 305 | msgstr "A class de rfile deve ser character." 306 | 307 | msgid "dfname must be of class character." 308 | msgstr "A class de dfname deve ser character." 309 | -------------------------------------------------------------------------------- /po/descr.pot: -------------------------------------------------------------------------------- 1 | # SOME DESCRIPTIVE TITLE. 2 | # Copyright (C) YEAR THE PACKAGE'S COPYRIGHT HOLDER 3 | # This file is distributed under the same license as the descr package. 4 | # FIRST AUTHOR , YEAR. 5 | # 6 | #, fuzzy 7 | msgid "" 8 | msgstr "" 9 | "Project-Id-Version: descr 1.1.4\n" 10 | "Report-Msgid-Bugs-To: \n" 11 | "POT-Creation-Date: 2017-10-15 12:10-0300\n" 12 | "PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n" 13 | "Last-Translator: FULL NAME \n" 14 | "Language-Team: LANGUAGE \n" 15 | "Language: \n" 16 | "MIME-Version: 1.0\n" 17 | "Content-Type: text/plain; charset=CHARSET\n" 18 | "Content-Transfer-Encoding: 8bit\n" 19 | 20 | #: descr.c:54 descr.c:61 21 | #, c-format 22 | msgid "Error: could not allocate memory (%d bytes)\n" 23 | msgstr "" 24 | 25 | #: descr.c:67 26 | #, c-format 27 | msgid "Error: could not read file \"%s\".\n" 28 | msgstr "" 29 | 30 | #: descr.c:72 31 | #, c-format 32 | msgid "Error: could not write file \"%s\".\n" 33 | msgstr "" 34 | 35 | #: descr.c:101 36 | #, c-format 37 | msgid "Error: line %d has only %d characters.\n" 38 | msgstr "" 39 | 40 | #: descr.c:145 41 | #, c-format 42 | msgid "%d lines written in \"%s\".\n" 43 | msgstr "" 44 | 45 | #: descr.c:147 46 | #, c-format 47 | msgid "One line from \"%s\" skipped because shorter than 3 characters.\n" 48 | msgstr "" 49 | 50 | #: descr.c:150 51 | #, c-format 52 | msgid "%d lines from \"%s\" skipped because shorter than 3 characters.\n" 53 | msgstr "" 54 | -------------------------------------------------------------------------------- /po/pt_BR.po: -------------------------------------------------------------------------------- 1 | # descr - Descriptive Statistics 2 | # Copyright (C) 2007-2009 3 | # This file is distributed under the same license as the descr package. 4 | # Jakson Aquino , 2011. 5 | # 6 | msgid "" 7 | msgstr "" 8 | "Project-Id-Version: descr 1.1.4\n" 9 | "Report-Msgid-Bugs-To: \n" 10 | "POT-Creation-Date: 2017-10-15 12:10-0300\n" 11 | "PO-Revision-Date: 2017-10-15 12:12-0300\n" 12 | "Last-Translator: Jakson Aquino \n" 13 | "Language-Team: pt \n" 14 | "Language: pt_BR\n" 15 | "MIME-Version: 1.0\n" 16 | "Content-Type: text/plain; charset=UTF-8\n" 17 | "Content-Transfer-Encoding: 8bit\n" 18 | 19 | #: descr.c:54 descr.c:61 20 | #, c-format 21 | msgid "Error: could not allocate memory (%d bytes)\n" 22 | msgstr "Erro: não foi possível alocar memória (%d bytes)\n" 23 | 24 | #: descr.c:67 25 | #, c-format 26 | msgid "Error: could not read file \"%s\".\n" 27 | msgstr "Erro: não foi possível ler o arquivo \"%s\".\n" 28 | 29 | #: descr.c:72 30 | #, c-format 31 | msgid "Error: could not write file \"%s\".\n" 32 | msgstr "Erro: não foi possível gravar o arquivo \"%s\".\n" 33 | 34 | #: descr.c:101 35 | #, c-format 36 | msgid "Error: line %d has only %d characters.\n" 37 | msgstr "Erro: linha %d tinha somente %d caracteres.\n" 38 | 39 | #: descr.c:145 40 | #, c-format 41 | msgid "%d lines written in \"%s\".\n" 42 | msgstr "%d linhas gravadas em \"%s\".\n" 43 | 44 | #: descr.c:147 45 | #, c-format 46 | msgid "One line from \"%s\" skipped because shorter than 3 characters.\n" 47 | msgstr "Uma linha de \"%s\" não lida porque menor do que 3 caracteres.\n" 48 | 49 | #: descr.c:150 50 | #, c-format 51 | msgid "%d lines from \"%s\" skipped because shorter than 3 characters.\n" 52 | msgstr "%d linhas de \"%s\" não lidas porque menores do que 3 caracteres.\n" 53 | -------------------------------------------------------------------------------- /src/descr.c: -------------------------------------------------------------------------------- 1 | /* This file is part of descr R package 2 | ** 3 | ** It is distributed under the GNU General Public License. 4 | ** See the file ../LICENSE for details. 5 | ** 6 | ** (c) 2009-2023 Jakson Aquino: jalvesaq@gmail.com 7 | ** 8 | ***************************************************************/ 9 | 10 | #include 11 | 12 | #ifdef ENABLE_NLS 13 | #include 14 | #define _(String) dgettext ("descr", String) 15 | #else 16 | #define _(String) (String) 17 | #endif 18 | 19 | #include 20 | #include 21 | #include 22 | 23 | #include 24 | #include 25 | #include 26 | 27 | #ifdef _WIN64 28 | #define FMTSIZEOF "llu" 29 | #else 30 | #define FMTSIZEOF "lu" 31 | #endif 32 | 33 | void realfwf2csv(char **fwffile, char **csvfile, char **names, int *begin, 34 | int *end, int *ncols, int *verbose){ 35 | 36 | int i, j, k, maxvlen = 0, len, l = 0, min, max = 0, maxget, nskipped = 0; 37 | char *b; 38 | char *value; 39 | char *v; 40 | FILE *fwf, *csv; 41 | int n = ncols[0]; 42 | 43 | /* Convert from R vector to C array */ 44 | for(i = 0; i < n; i++){ 45 | if((end[i] - begin[i]) > maxvlen) 46 | maxvlen = end[i] - begin[i]; 47 | if(end[i] > max) 48 | max = end[i]; 49 | begin[i] -= 1; 50 | } 51 | max += 3; 52 | min = max - 3; 53 | maxget = max * 2; 54 | 55 | /* The last column to be read may be far to the last column in the file */ 56 | if(maxget < 32765) 57 | maxget = 32765; 58 | 59 | value = (char*)malloc((maxvlen + 3) * sizeof(char)); 60 | if(value == NULL){ 61 | REprintf(_("Error: could not allocate memory (%" FMTSIZEOF " bytes)\n"), 62 | maxvlen + 3 * sizeof(char)); 63 | return; 64 | } 65 | 66 | b = (char*)malloc((maxget + 3) * sizeof(char)); 67 | if(b == NULL){ 68 | REprintf(_("Error: could not allocate memory (%" FMTSIZEOF "bytes)\n"), 69 | maxget + 3 * sizeof(char)); 70 | return; 71 | } 72 | fwf = fopen(fwffile[0], "r"); 73 | if(fwf == NULL){ 74 | REprintf(_("Error: could not read file \"%s\".\n"), fwffile[0]); 75 | return; 76 | } 77 | csv = fopen(csvfile[0], "w"); 78 | if(csv == NULL){ 79 | REprintf(_("Error: could not write file \"%s\".\n"), csvfile[0]); 80 | return; 81 | } 82 | 83 | /* Put the header in the csv file */ 84 | for(i = 0; i < n; i++){ 85 | if(i < (n - 1)) 86 | fprintf(csv, "%s\t", names[i]); 87 | else 88 | fprintf(csv, "%s\n", names[i]); 89 | } 90 | 91 | /* Put the rows in the csv file */ 92 | while(fgets(b, maxget - 3, fwf)){ 93 | l++; 94 | 95 | /* delete the new line character */ 96 | i = strlen(b) - 1; 97 | while(i > 0 && (b[i] == '\n' || b[i] == '\r')){ 98 | b[i] = 0; 99 | i--; 100 | } 101 | 102 | len = strlen(b); 103 | if(len < 3){ 104 | nskipped += 1; 105 | continue; 106 | } 107 | if(len < min){ 108 | REprintf(_("Error: line %d has only %d characters.\n"), l, len); 109 | fclose(csv); 110 | fclose(fwf); 111 | return; 112 | } 113 | for(i = 0; i < n; i++){ 114 | j = begin[i]; 115 | k = 0; 116 | while(j < end[i]){ 117 | value[k] = b[j]; 118 | k++; 119 | j++; 120 | } 121 | value[k] = 0; 122 | 123 | /* delete empty spaces at the end of the field */ 124 | k--; 125 | while(value[k] == ' ' && k > 0){ 126 | value[k] = 0; 127 | k--; 128 | } 129 | 130 | /* skip empty spaces at the beginning of the field */ 131 | v = value; 132 | while(*v == ' ') 133 | v++; 134 | 135 | /* put the value into the csv file */ 136 | fprintf(csv, "%s", v); 137 | 138 | /* put either a field separator or the end of line */ 139 | if(i == (n - 1)) 140 | putc('\n', csv); 141 | else 142 | putc('\t', csv); 143 | } 144 | } 145 | 146 | /* Finish */ 147 | fclose(fwf); 148 | fclose(csv); 149 | free(value); 150 | free(b); 151 | if(verbose[0] == 1) 152 | REprintf(_("%d lines written in \"%s\".\n"), l, csvfile[0]); 153 | if(nskipped == 1) 154 | REprintf(_("One line from \"%s\" skipped because shorter than 3 characters.\n"), fwffile[0]); 155 | else 156 | if(nskipped > 0) 157 | REprintf(_("%d lines from \"%s\" skipped because shorter than 3 characters.\n"), 158 | nskipped, fwffile[0]); 159 | } 160 | 161 | static R_NativePrimitiveArgType realfwf2csv_type[] = { 162 | STRSXP, STRSXP, STRSXP, INTSXP, INTSXP, INTSXP, LGLSXP 163 | }; 164 | 165 | static const R_CMethodDef CEntries[] = { 166 | {"realfwf2csv", (DL_FUNC) &realfwf2csv, 7, realfwf2csv_type}, 167 | {NULL, NULL, 0, NULL} 168 | }; 169 | 170 | void attribute_visible R_init_descr(DllInfo *info) 171 | { 172 | R_registerRoutines(info, CEntries, NULL, NULL, NULL); 173 | R_useDynamicSymbols(info, FALSE); 174 | R_forceSymbols(info, TRUE); 175 | } 176 | --------------------------------------------------------------------------------