diff -Nru r-cran-epicalc-2.13.2.1/DESCRIPTION r-cran-epicalc-2.14.1.6/DESCRIPTION --- r-cran-epicalc-2.13.2.1/DESCRIPTION 2011-10-04 19:34:10.000000000 +0000 +++ r-cran-epicalc-2.14.1.6/DESCRIPTION 2012-02-18 07:11:49.000000000 +0000 @@ -1,6 +1,6 @@ Package: epicalc -Version: 2.13.2.1 -Date: 2011-10-04 +Version: 2.14.1.6 +Date: 2012-02-17 Title: Epidemiological calculator Author: Virasakdi Chongsuvivatwong Maintainer: Virasakdi Chongsuvivatwong @@ -9,6 +9,6 @@ Description: Functions making R easy for epidemiological calculation. License: GPL (>= 2) URL: http://CRAN.R-project.org/ -Packaged: 2011-10-04 10:17:50 UTC; Virasakdi +Packaged: 2012-02-17 04:09:43 UTC; Virasakdi Repository: CRAN -Date/Publication: 2011-10-04 19:34:10 +Date/Publication: 2012-02-18 07:11:49 diff -Nru r-cran-epicalc-2.13.2.1/MD5 r-cran-epicalc-2.14.1.6/MD5 --- r-cran-epicalc-2.13.2.1/MD5 2011-10-04 19:34:10.000000000 +0000 +++ r-cran-epicalc-2.14.1.6/MD5 2012-02-18 07:11:49.000000000 +0000 @@ -1,22 +1,23 @@ -e6d9820f144327dc42b4689b2b3ed1fb *DESCRIPTION -f9bcb763932585fa06d6bf7b282db389 *R/epicalc.R +a5836ebfec0edd8278a5503da8a32c6d *DESCRIPTION +a7029ab4e2d345ccd376d76e711f28f6 *NAMESPACE +1dd74d4a038d01c5d5548870ae067df5 *R/epicalc.R 1721d9a396b168fe50a85b52adbc228f *data/ANCdata.rdata -adf1de16ad1852dd7be771d2b0ecbaf8 *data/ANCtable.txt.gz +c1ddefc687a4e0421362affcbb17debb *data/ANCtable.txt.gz af5abbf83afc371f6a64009cd3eb9106 *data/Attitudes.rdata b74941b9c0e39aab9ce46a65cc0e6017 *data/BP.rdata -df4d726f4fe4847349adac33cd9bb1c5 *data/Bang.txt.gz +10ac1bc5995389c482bbe6278d6b8490 *data/Bang.txt.gz db376e7583b47344e08781fc3aa7c6a9 *data/Compaq.rdata ce97b37315be80409eef2acf20fa0a5d *data/DHF99.rda 7c2b03dfe8f264eb68069cfa94c3a64f *data/Decay.rdata 9d741cd6bb48601c76283de22888a935 *data/Ectopic.rdata 976c174d476db6c9393a3d1e55524e7e *data/Familydata.rda 60ae2fa6584ba23c3a20d8fbdf26440a *data/HW93.rdata -6a80448c81f273b135cd98e441d98586 *data/Hakimi.txt.gz +07c33360f778472b379ee3f918eaf808 *data/Hakimi.txt.gz ee77f961ef2713e723d024de4437aa76 *data/IudAdmit.rdata ee5a0c2d399978a5ec13a52402ed3751 *data/IudDiscontinue.rdata ce582503413b73e86268bc542c1e6382 *data/IudFollowup.rdata 874058f386c420c865b2f01588e95054 *data/Marryage.rdata -73f7e11c969d7b9b73ca43bd8afc3542 *data/Montana.txt.gz +5b42f9375cc9fce94930ee00e8400fb0 *data/Montana.txt.gz 5a358d6a350000c3b3bc863abd5cd667 *data/Oswego.rdata 1ee4d5c3c0a59df7c61af372d3cbaf4e *data/Outbreak.rdata 3f68a8c96a0782405b696b09b469c550 *data/Planning.rda @@ -57,7 +58,7 @@ cd7145b2f22fb45cf227d115978ef233 *man/Vc1to1.rd da8fad92605356060b08dbfc1efc30b1 *man/Xerop.rd 0cd43ae08083059da23a80808234a14d *man/addMissingRecords.rd -6b544f656e753c40834688f84dbba3b6 *man/adjust.rd +9608d02cf938c8ab2b3d966d04caaf7b *man/adjust.rd 55225f7928e5b48a75824136c1915d86 *man/aggregate.numeric.rd cbab361898d3e545deb9a628ab5d4999 *man/aggregate.plot.rd 0378be67ad6f3bd68a6aed21e6e9e263 *man/alpha.rd @@ -73,12 +74,12 @@ cafa7528254d902379359519c4d53078 *man/expand.rd 5455292c07818c8798d78f6994abdc1a *man/fillin.rd b2f1048a1c52efd9e6da84f8718a1302 *man/followup.plot.rd -2e855440140da6e82097d3fcd81c8760 *man/kap.rd +6a44510e3acf7e1effb05557aa9376f3 *man/kap.rd 8308d4fe9cd83761871d0bdc0532d081 *man/keepData.rd 4d7123503fc2f25df3144273ab320abf *man/label.var.rd 42554d536bb9191bdd0226a3a701f5dc *man/lagVar.rd 943699995ac214ef9e569c76cf5d9906 *man/lookup.rd -40a54e9fb13a5a1745553e03c4fc1794 *man/lrtest.rd +b2696f2723cae99754efb3e46bbc4008 *man/lrtest.rd 8b86026730db77d2cec2dbdf91a28fc9 *man/lsNoFunction.rd e0211f82cdf428fad19571eab5372823 *man/markVisits.rd 71a87c0ad4f493ceaaf09e924ead0ec6 *man/matchTab.rd @@ -90,6 +91,9 @@ ee5830516339c15bb4e5474af30dbd15 *man/print.alpha.rd abd1607ad3940db6d707a8406134f47c *man/print.cci.rd 51b6904a353f64bf6e561cecc63291d7 *man/print.des.rd +701e8676c916b8c3dc6f25ae385ffd50 *man/print.kap.ByCategory.rd +c47276e99743ddcdf53dfac55f9cb936 *man/print.kap.table.rd +8d35042898cc2cc841e830a532a4d338 *man/print.lrtest.rd ed303bd6bd17cd5733a1a3acc7e02323 *man/print.n.for.2means.rd ef96f4b8b4e60f2d86b4eb86e5ece360 *man/print.n.for.2p.rd c5d638ac77b51ac22656055731953e13 *man/print.n.for.cluster.2means.rd @@ -112,7 +116,7 @@ d1112f183e41c0869a4b8799dc5a0e7b *man/sortBy.rd 4afa2f6c82060cd8043d590dd6782a93 *man/summ.rd 57aeae04190080742ef5d49e812b3e2c *man/tab1.rd -e574ff76b836729f299575bd9ac2914b *man/tableStack.rd +d350d29c584a5fdc63661ffbd4c6262e *man/tableStack.rd 5f077ee0762704bed014948e0a8b723e *man/tabpct.rd c40f827949feb0b87802c2ffbbba41e7 *man/titleString.rd 5bff92fc08dfa3e03d1219c201b035f7 *man/unclassDataframe.rd diff -Nru r-cran-epicalc-2.13.2.1/NAMESPACE r-cran-epicalc-2.14.1.6/NAMESPACE --- r-cran-epicalc-2.13.2.1/NAMESPACE 1970-01-01 00:00:00.000000000 +0000 +++ r-cran-epicalc-2.14.1.6/NAMESPACE 2012-02-17 04:09:43.000000000 +0000 @@ -0,0 +1,13 @@ +# Default NAMESPACE created by R +# Remove the previous line if you edit this file + +# Export all names +exportPattern(".") + +# Import all packages listed as Imports or Depends +import( + foreign, + survival, + MASS, + nnet +) diff -Nru r-cran-epicalc-2.13.2.1/R/epicalc.R r-cran-epicalc-2.14.1.6/R/epicalc.R --- r-cran-epicalc-2.13.2.1/R/epicalc.R 2011-10-04 10:17:49.000000000 +0000 +++ r-cran-epicalc-2.14.1.6/R/epicalc.R 2012-02-17 04:09:42.000000000 +0000 @@ -243,7 +243,7 @@ for (search.position in 1:length(search())) { if (exists(as.character(substitute(x)), where = search.position)) { if (any(names(get(search()[search.position])) == - as.character(substitute(x))) | any(ls(all = TRUE, + as.character(substitute(x))) | any(ls(all.names = TRUE, pos = 1) == as.character(substitute(x)))) candidate.position <- c(candidate.position, search.position) @@ -454,13 +454,14 @@ #### cci <- -function (caseexp, controlex, casenonex, controlnonex, cctable = NULL, - graph = TRUE, design = "cohort", main, xlab,ylab, xaxis, yaxis, - alpha=.05, fisher.or=FALSE, exact.ci.or=TRUE, decimal=2) +function (caseexp, controlex, casenonex, controlnonex, cctable = NULL, + graph = TRUE, design = "cohort", main, xlab, ylab, xaxis, + yaxis, alpha = 0.05, fisher.or = FALSE, exact.ci.or = TRUE, + decimal = 2) { if (is.null(cctable)) { - frame <- cbind(Outcome <- c(1, 0, 1, 0), Exposure <- c(1, - 1, 0, 0), Freq <- c(caseexp, controlex, casenonex, + frame <- cbind(Outcome <- c(1, 0, 1, 0), Exposure <- c(1, + 1, 0, 0), Freq <- c(caseexp, controlex, casenonex, controlnonex)) Exposure <- factor(Exposure) expgrouplab <- c("Non-exposed", "Exposed") @@ -474,62 +475,76 @@ table1 <- as.table(get("cctable")) } fisher <- fisher.test(table1) - caseexp <- table1[2,2]; controlex <- table1[1,2] - casenonex <- table1[2,1]; controlnonex <- table1[1,1] - se.ln.or <- sqrt(1/caseexp+1/controlex+1/casenonex+1/controlnonex) - if(!fisher.or){ - or <- caseexp/controlex/casenonex*controlnonex - p.value <- chisq.test(table1, correct=FALSE)$p.value - }else{ - or <- fisher$estimate - p.value <- fisher$p.value + caseexp <- table1[2, 2] + controlex <- table1[1, 2] + casenonex <- table1[2, 1] + controlnonex <- table1[1, 1] + se.ln.or <- sqrt(1/caseexp + 1/controlex + 1/casenonex + + 1/controlnonex) + if (!fisher.or) { + or <- caseexp/controlex/casenonex * controlnonex + p.value <- chisq.test(table1, correct = FALSE)$p.value } - if(exact.ci.or){ - ci.or <- as.numeric(fisher$conf.int) - }else{ - ci.or <- or * exp(c(-1,1)*qnorm(1 - alpha/2)*se.ln.or) + else { + or <- fisher$estimate + p.value <- fisher$p.value + } + if (exact.ci.or) { + ci.or <- as.numeric(fisher$conf.int) + } + else { + ci.or <- or * exp(c(-1, 1) * qnorm(1 - alpha/2) * se.ln.or) } if (graph == TRUE) { caseexp <- table1[2, 2] controlex <- table1[1, 2] casenonex <- table1[2, 1] controlnonex <- table1[1, 1] - if (design == "prospective" || design == "cohort" || +if (!any(c(caseexp, controlex, casenonex, controlnonex) < + 5)) { + if (design == "prospective" || design == "cohort" || design == "cross-sectional") { - graph.prospective(caseexp, controlex, casenonex, + graph.prospective(caseexp, controlex, casenonex, controlnonex) - if (missing(main)) + if (missing(main)) main <- "Odds ratio from prospective/X-sectional study" - if (missing(xlab)) + if (missing(xlab)) xlab <- "" - if (missing(ylab)) - ylab <- paste("Odds of being", ifelse(missing(yaxis), + if (missing(ylab)) + ylab <- paste("Odds of being", ifelse(missing(yaxis), "a case", yaxis[2])) - if (missing(xaxis)) + if (missing(xaxis)) xaxis <- c("non-exposed", "exposed") axis(1, at = c(0, 1), labels = xaxis) } else { - graph.casecontrol(caseexp, controlex, casenonex, + graph.casecontrol(caseexp, controlex, casenonex, controlnonex) - if (missing(main)) + if (missing(main)) main <- "Odds ratio from case control study" - if (missing(ylab)) + if (missing(ylab)) ylab <- "Outcome category" - if (missing(xlab)) + if (missing(xlab)) xlab <- "" - if (missing(yaxis)) + if (missing(yaxis)) yaxis <- c("Control", "Case") - axis(2, at = c(0, 1), labels = yaxis, las=2) - mtext(paste("Odds of ", ifelse(xlab=="","being exposed", paste("exposure being", xaxis[2]))), side = 1, line = ifelse(xlab=="",2.5,1.8)) + axis(2, at = c(0, 1), labels = yaxis, las = 2) + mtext(paste("Odds of ", ifelse(xlab == "", "being exposed", + paste("exposure being", xaxis[2]))), side = 1, + line = ifelse(xlab == "", 2.5, 1.8)) } - title(main = main, xlab = xlab, ylab = ylab) } - if(!fisher.or){ - results <- list(method="",or = or, se.ln.or=se.ln.or, alpha=alpha, exact.ci.or=exact.ci.or, ci.or=ci.or, table=table1, decimal=decimal) - }else{ - results <- list(method="Fisher's ", or = or, alpha=alpha, exact.ci.or=exact.ci.or, ci.or=ci.or, table=table1, decimal=decimal) +} + if (!fisher.or) { + results <- list(or.method = "Asymptotic", or = or, se.ln.or = se.ln.or, + alpha = alpha, exact.ci.or = exact.ci.or, ci.or = ci.or, + table = table1, decimal = decimal) + } + else { + results <- list(or.method = "Fisher's", or = or, alpha = alpha, + exact.ci.or = exact.ci.or, ci.or = ci.or, table = table1, + decimal = decimal) } class(results) <- c("cci", "cc") return(results) @@ -2191,7 +2206,7 @@ if((length(var.names)==1 & names(model$coefficients)[1] != "(Intercept)")){ lr.p.value <- "-" }else{ - lr.p.value <- suppressWarnings(lrtest(model1, model, print=FALSE)$p.value) + lr.p.value <- suppressWarnings(lrtest(model1, model)$p.value) lr.p.value <- ifelse(lr.p.value < .001, "< 0.001",round(lr.p.value,decimal+1)) } } @@ -2216,7 +2231,7 @@ formula.coxph.i <- as.formula(paste(b[2], "~", paste(var.names[-i], collapse="+"))) model.coxph.i <- coxph(formula.coxph.i, data=data) } - lr.p.value <- suppressWarnings(lrtest(model.full.coxph, model.coxph.i, print=FALSE)$p.value) + lr.p.value <- suppressWarnings(lrtest(model.full.coxph, model.coxph.i)$p.value) } lr.p.value <- ifelse(lr.p.value < .001, "< 0.001",round(lr.p.value,decimal+1)) } @@ -2367,12 +2382,12 @@ #### Likelihood ratio test -lrtest <- function (model1, model2, print = TRUE) +lrtest <- function (model1, model2) { if (any(class(model1) != class(model2))) { stop("Two models have different classes") } - if (any(class(model1) == "coxph") & any(class(model2) == + if (any(class(model1) == "coxph") & any(class(model2) == "coxph")) { if (model1$n != model2$n) { stop("Two models has different sample sizes") @@ -2389,16 +2404,8 @@ if (lrt * diff.df < 0) { stop("Likelihood gets worse with more variables. Test not executed") } - if (print) { - cat("Likelihood ratio test for Cox regression & conditional logistic regression", - "\n") - cat("Chi-squared", diff.df, "d.f. = ", lrt, ",", - "P value = ", round(pchisq(lrt, diff.df, lower.tail = FALSE), - 4), "\n") - cat("\n") - } } - if (any(class(model1) == "multinom") & any(class(model2) == + if (any(class(model1) == "multinom") & any(class(model2) == "multinom")) { if (any(dim(model1$residuals) != dim(model2$residuals))) { stop("Two models have different outcomes or different sample sizes") @@ -2415,14 +2422,6 @@ if (lrt * diff.df < 0) { stop("Likelihood gets worse with more variables. Test not executed") } - if (print) { - cat("Likelihood ratio test for multinomial logistic regression", - "\n") - cat("Chi-squared", diff.df, "d.f. = ", lrt, ",", - "P value = ", round(pchisq(lrt, diff.df, lower.tail = FALSE), - 4), "\n") - cat("\n") - } } if (any(class(model1) == "polr") & any(class(model2) == "polr")) { if (model1$n != model2$n) { @@ -2440,18 +2439,11 @@ if (lrt * diff.df < 0) { stop("Likelihood gets worse with more variables. Test not executed") } - if (print) { - cat("Likelihood ratio test for ordinal regression", - "\n") - cat("Chi-squared", diff.df, "d.f. = ", lrt, ",", - "P value = ", round(pchisq(lrt, diff.df, lower.tail = FALSE), - 4), "\n") - cat("\n") - } } - if (suppressWarnings((all(class(model1) == c("glm", "lm")) & all(class(model2) == - c("glm", "lm"))) | (any(class(model1)=="negbin") & any(class(model2)=="negbin")))) { - if (sum(model1$df.null) != sum(model2$df.null)) + if (suppressWarnings((all(class(model1) == c("glm", "lm")) & + all(class(model2) == c("glm", "lm"))) | (any(class(model1) == + "negbin") & any(class(model2) == "negbin")))) { + if (sum(model1$df.null) != sum(model2$df.null)) stop("Number of observation not equal!!") df1 <- attributes(logLik(model1))$df df2 <- attributes(logLik(model2))$df @@ -2464,17 +2456,45 @@ if (lrt * diff.df < 0) { stop("Likelihood gets worse with more variables. Test not executed") } - if (print) { - cat("Likelihood ratio test for MLE method", "\n") - cat("Chi-squared", diff.df, "d.f. = ", lrt, ",", - "P value = ", round(pchisq(lrt, diff.df, lower.tail = FALSE), - 4), "\n") - cat("\n") - } } - output <- list(model1 = model1$call, model2 = model2$call, - Chisquared = lrt, df = diff.df, p.value = pchisq(lrt, + output <- list(model1 = model1$call, model2 = model2$call, model.class =class(model1), + Chisquared = lrt, df = diff.df, p.value = pchisq(lrt, diff.df, lower.tail = FALSE)) +class(output) <- "lrtest" +output +} + +# print.lrtest +print.lrtest <- function(x, ...) { +if(any(x$model.class == "coxph")){ + cat("Likelihood ratio test for Cox regression & conditional logistic regression", + "\n") + cat("Chi-squared", x$df, "d.f. = ", x$Chisquared, ",", + "P value = ", x$p.value, "\n") + cat("\n") + } +if(any(x$model.class == "multinom")){ + cat("Likelihood ratio test for multinomial logistic regression", + "\n") + cat("Chi-squared", x$df, "d.f. = ", x$Chisquared, ",", + "P value = ", x$p.value, "\n") + cat("\n") +} +if(any(x$model.class == "polr")){ + cat("Likelihood ratio test for ordinal regression", + "\n") + cat("Chi-squared", x$df, "d.f. = ", x$Chisquared, ",", + "P value = ", x$p.value, "\n") + cat("\n") +} +if (suppressWarnings((all(x$model.class == c("glm", "lm"))) | (any(x$model.class == + "negbin")))){ + + cat("Likelihood ratio test for MLE method", "\n") + cat("Chi-squared", x$df, "d.f. = ", x$Chisquared, ",", + "P value = ", x$p.value, "\n") + cat("\n") +} } ### List objects excluding function @@ -2566,10 +2586,6 @@ string5 <- paste(string3, "\n", titleString()$by, string4) } - if (any(class(x) == "date")) { - x <- as.Date(paste(date.mdy(x)$year, "-", date.mdy(x)$month, - "-", date.mdy(x)$day, sep = "")) - } if (any(class(x) == "Date")) { range.date <- difftime(summary(x)[6], summary(x)[1]) numdate <- as.numeric(range.date) @@ -2817,11 +2833,6 @@ else { a <- rep("", 6) dim(a) <- c(1, 6) - if (any(class(x1) == "date")) { - x1 <- as.Date(paste(date.mdy(x1)$year, "-", - date.mdy(x1)$month, "-", date.mdy(x1)$day, - sep = "")) - } if (any(class(x1) == "Date")) { a[1, ] <- c(length(x1), format(c(summary(x1)[4], summary(x1)[3], NA, summary(x1)[1], summary(x1)[6]), @@ -2833,6 +2844,13 @@ NA, round(sd(na.omit(x1)), 2)), min(na.omit(x1)), max(na.omit(x1))), 3) } + + else if (any(class(x) == "difftime")) { + a[1, ] <- round(c(length(na.omit(x1)), mean(na.omit(as.numeric(x1))), + quantile(na.omit(as.numeric(x1)), 0.5), ifelse(is.na(mean(na.omit(as.numeric(x1)))), + NA, round(sd(na.omit(as.numeric(x1))), 2)), min(na.omit(as.numeric(x1))), + max(na.omit(as.numeric(x1)))), 3) + } else { a[1, ] <- round(c(length(na.omit(x1)), summary(x1)[4], summary(x1)[3], ifelse(is.na(mean(na.omit(x1))), @@ -2854,10 +2872,6 @@ else { a <- rep("", 6) dim(a) <- c(1, 6) - if (any(class(x) == "date")) { - x <- as.Date(paste(date.mdy(x)$year, "-", date.mdy(x)$month, - "-", date.mdy(x)$day, sep = "")) - } if (any(class(x) == "Date")) { a[1, ] <- c(length(na.omit(x)), format(c(summary(x)[4], summary(x)[3], NA, summary(x)[1], summary(x)[6]), @@ -2898,11 +2912,6 @@ a[i, 3:7] <- "" } else { - if (any(class(x[[i]]) == "date")) { - x[[i]] <- as.Date(paste(date.mdy(x[[i]])$year, - "-", date.mdy(x[[i]])$month, "-", date.mdy(x[[i]])$day, - sep = "")) - } if (any(class(x[[i]]) == "Date")) { a[i, c(3, 4, 6, 7)] <- format(c(summary(x[[i]])[4], summary(x[[i]])[3], summary(x[[i]])[1], summary(x[[i]])[6]), @@ -3165,37 +3174,48 @@ ### Kappa statistics -kap <- function(x, ...){ +kap <- function(x,...){ UseMethod("kap") } kap.default <- function(x, ...){ if (is.table(x)){ - kap.table(x, ...) + kap.table(x, decimal=3,...) } } ### Kappa statistics from a table cross-tab ratings of 2 raters -kap.table <- function (x, wttable = c(NULL, "w", "w2"), print.wttable = FALSE, ...) +kap.table <- +function (x, decimal =3, wttable = c(NULL, "w", "w2"), print.wttable = FALSE, ...) { -kaptable <- x - if (ncol(kaptable) != nrow(kaptable)) + kaptable <- x + if (ncol(kaptable) != nrow(kaptable)) stop("Column & row not equal length") - if(is.null(wttable) | (is.character(wttable)& length(wttable)==2)){ + if (is.null(wttable) | (is.character(wttable) & length(wttable) == + 2)) { wttable <- kaptable wttable[] <- 0 for (i in 1:nrow(kaptable)) wttable[i, i] <- 1 - }else{ - if(!is.matrix(wttable)){ - if (wttable=="w"| wttable=="w2"){ - wttable1 <- kaptable - wttable1[] <- 0 - for (i in 1:nrow(kaptable)) { - for (j in 1:ncol(kaptable)){ - if(wttable=="w") {wttable1[i, j] <- 1 - abs(i-j)/(ncol(kaptable)-1)} - if(wttable=="w2") {wttable1[i, j] <- 1 - (abs(i-j)/(ncol(kaptable)-1))^2} + } + else { + if (!is.matrix(wttable)) { + if (wttable == "w" | wttable == "w2") { + wttable1 <- kaptable + wttable1[] <- 0 + for (i in 1:nrow(kaptable)) { + for (j in 1:ncol(kaptable)) { + if (wttable == "w") { + wttable1[i, j] <- 1 - abs(i - j)/(ncol(kaptable) - + 1) + } + if (wttable == "w2") { + wttable1[i, j] <- 1 - (abs(i - j)/(ncol(kaptable) - + 1))^2 + } + } + } + wttable <- wttable1 } } - wttable <- wttable1 - }}} + } po <- 0 pe <- 0 exptable <- kaptable @@ -3204,149 +3224,236 @@ wbarj <- rep(0, nrow(kaptable)) for (i in 1:nrow(kaptable)) { for (j in 1:ncol(kaptable)) { - wbari[i] <- wbari[i] + wttable[i, j] * sum(kaptable[, + wbari[i] <- wbari[i] + wttable[i, j] * sum(kaptable[, j])/sum(kaptable) } } for (j in 1:ncol(kaptable)) { for (i in 1:nrow(kaptable)) { - wbarj[j] <- wbarj[j] + wttable[i, j] * sum(kaptable[i, + wbarj[j] <- wbarj[j] + wttable[i, j] * sum(kaptable[i, ])/sum(kaptable) } } for (i in 1:nrow(kaptable)) { for (j in 1:ncol(kaptable)) { po <- po + wttable[i, j] * kaptable[i, j]/sum(kaptable) - exptable[i, j] <- sum(kaptable[i, ]) * sum(kaptable[, + exptable[i, j] <- sum(kaptable[i, ]) * sum(kaptable[, j])/sum(kaptable)/sum(kaptable) pe <- pe + wttable[i, j] * exptable[i, j] - bigbracket <- bigbracket + exptable[i, j] * (wttable[i, + bigbracket <- bigbracket + exptable[i, j] * (wttable[i, j] - (wbari[i] + wbarj[j]))^2 } } kap <- (po - pe)/(1 - pe) - if(print.wttable) print(wttable) if (length(colnames(kaptable)) == 0) { - rownames(kaptable) <- paste("Group", as.character(1:nrow(kaptable)), + rownames(kaptable) <- paste("Group", as.character(1:nrow(kaptable)), sep = "") colnames(kaptable) <- rownames(kaptable) - attr(attr(kaptable, "dimnames"), "names") <- c("Rater A", + attr(attr(kaptable, "dimnames"), "names") <- c("Rater A", "Rater B") - cat("\n") - print(kaptable) - } - else { - print(kaptable) } - cat("\n") - cat("Observed agreement =", round(po * 100, 2), "%", "\n") - cat("Expected agreement =", round(pe * 100, 2), "%", "\n") - cat("Kappa =", round(kap, 3), "\n") - sekap <- 1/(1 - pe)/sqrt(sum(kaptable)) * sqrt(bigbracket - + sekap <- 1/(1 - pe)/sqrt(sum(kaptable)) * sqrt(bigbracket - pe^2) z <- kap/sekap p.value <- pnorm(z, lower.tail = FALSE) - if (p.value < 0.001) { - P.value <- "< 0.001" - } - else { - P.value <- as.character(round(p.value, 3)) - } - cat("Standard error =", round(sekap, digits = 3), ", Z =", - round(z, digits = 3), ", P value =", P.value, "\n", "\n") - returns <- list(po = po, pe = pe, kappa = kap, std.error = sekap, + results <- list(table = kaptable, wttable = wttable, + print.wttable = print.wttable, decimal = decimal, + po = po, pe = pe, kappa = kap, std.error = sekap, z = z, p.value = p.value) + class(results) <- "kap.table" + results +} + +### Print kap.table +print.kap.table <- +function(x, ...) +{ +cat("\n","Table for calculation of kappa"); cat("\n") +print(x$table) +if(x$print.wttable & nrow(x$table)>2){ +cat("\n") +cat("Weighting scheme", "\n") +print(x$wttable) } + cat("\n") + cat("Observed agreement =", round(x$po * 100, x$decimal-1), "%", "\n") + cat("Expected agreement =", round(x$pe * 100, x$decimal-1), "%", "\n") + cat("Kappa =", round(x$kap, x$decimal), "\n") + cat("Standard error =", round(x$std.error, x$decimal), ", Z =", + round(x$z, x$decimal), ", P value =", ifelse(x$p.value <0.001, "< 0.001",round(x$p.value, x$decimal)), "\n", "\n") +} + ## Kappa statistics with two raters -kap.2.raters <- function(x, rater2, ...){ -rater1 <- x -kaptable <- table(rater1, rater2) -if(any(rownames(kaptable)!= colnames(kaptable))) {stop("Table to use for kappa calculation must be symmetrical")} -kap.table(kaptable, ...) +kap.2.raters <- +function (x, rater2, decimal =3, ...) +{ + rater1 <- x + kaptable <- table(rater1, rater2) + if (any(rownames(kaptable) != colnames(kaptable))) { + stop("Table to use for kappa calculation must be symmetrical") + } + kap.table(kaptable, decimal=decimal) } + ## Kappa statistics with more than two raters -kap.m.raters <- function(x, raters, ...){ -id <- x -category.levels <- NULL -for(i in 1:ncol(raters)){ - category.levels <- c(category.levels, names(table(raters[,i]))) -} -category.levels <- unique(category.levels) -category.counts <- rep(0, times=length(id)*length(category.levels)) -dim(category.counts) <- c(length(id), length(category.levels)) -for(j in 1:length(category.levels)){ -if(is.factor(raters[,1])){ - for(i in 1:length(id)){ - category.counts[i,j] <- sum(raters[i,][!is.na(raters[i,])]==category.levels[j]) +kap.m.raters <- +function (x, decimal =3, ...) +{ + category.levels <- NULL + for (i in 1:ncol(x)) { + category.levels <- c(category.levels, names(table(x[, + i]))) + } + category.levels <- unique(category.levels) + category.counts <- rep(0, times = nrow(x) * length(category.levels)) + dim(category.counts) <- c(nrow(x), length(category.levels)) + for (j in 1:length(category.levels)) { + if (is.factor(x[, 1])) { + for (i in 1:nrow(x)) { + category.counts[i, j] <- sum(x[i, ][!is.na(x[i, + ])] == category.levels[j]) + } + } + else { + for (i in 1:nrow(x)) { + category.counts[i, j] <- sum(x[i, ][!is.na(x[i, + ])] == as.numeric(category.levels[j])) + } + } + colnames(category.counts) <- category.levels } - }else{ - for(i in 1:length(id)){ - category.counts[i,j] <- sum(raters[i,][!is.na(raters[i,])]==as.numeric(category.levels[j])) - } -} -colnames(category.counts) <- category.levels -} -kap.ByCategory(x, as.data.frame(category.counts)) + kap.ByCategory( as.data.frame(category.counts), decimal=decimal) } ## Kappa statistics with id of the ratee and counts of rated categories -kap.ByCategory <- function(x, category.counts, ...){ -id <- x -n <- length(id) -mi <- rowSums(category.counts) -mbar <- sum(mi/n) -pbar <- NULL -qbar <- NULL -kapp <- NULL -z <- NULL -sekap <- NULL -p.value <- NULL -for(j in 1:ncol(category.counts)){ - xi <- category.counts[,j] - last.pbar <- sum(xi/(n*mbar)) - pbar <- c(pbar, last.pbar) - last.qbar <- 1-last.pbar - qbar <- c(qbar, last.qbar) - B <- 1/n*sum((xi-mi*last.pbar)^2/mi) # Between-subject mean square - W <- 1/(n*(mbar-1))*sum(xi*(mi-xi)/mi) # Within-subject mean square - mbarH <- 1/(mean(1/mi)) # harmonic mean of mi - kapp <- c(kapp, (B-W)/(B+(mbar-1)*W)) - if(ncol(category.counts)==2| var(mi)==0){ - last.sekap <- 1/((mbar-1)*sqrt(n*mbarH))* - sqrt(2*(mbarH-1)+(mbar-mbarH)*(1-4*last.pbar*last.qbar)/(mbar*last.pbar*last.qbar)) - sekap <- c(sekap, last.sekap) - last.z <- (B-W)/(B+(mbar-1)*W)/last.sekap - z <- c(z, last.z) - last.p.value <- pnorm(last.z, lower.tail = FALSE) - p.value <- c(p.value, last.p.value) - } +kap.ByCategory <- +function (x, decimal =3, ...) +{ + n <- nrow(x) + mi <- rowSums(x) + mbar <- sum(mi/n) + pbar <- NULL + qbar <- NULL + kapp <- NULL + z <- NULL + sekap <- NULL + p.value <- NULL + for (j in 1:ncol(x)) { + xi <- x[, j] + last.pbar <- sum(xi/(n * mbar)) + pbar <- c(pbar, last.pbar) + last.qbar <- 1 - last.pbar + qbar <- c(qbar, last.qbar) + B <- 1/n * sum((xi - mi * last.pbar)^2/mi) + W <- 1/(n * (mbar - 1)) * sum(xi * (mi - xi)/mi) + mbarH <- 1/(mean(1/mi)) + kapp <- c(kapp, (B - W)/(B + (mbar - 1) * W)) + if (ncol(x) == 2 | var(mi) == 0) { + last.sekap <- 1/((mbar - 1) * sqrt(n * mbarH)) * + sqrt(2 * (mbarH - 1) + (mbar - mbarH) * (1 - + 4 * last.pbar * last.qbar)/(mbar * last.pbar * + last.qbar)) + sekap <- c(sekap, last.sekap) + last.z <- (B - W)/(B + (mbar - 1) * W)/last.sekap + z <- c(z, last.z) + last.p.value <- pnorm(last.z, lower.tail = FALSE) + p.value <- c(p.value, last.p.value) + } + } + if (ncol(x) == 2) { + results <- list(Each.category=NULL, Overall = data.frame(kappa = kapp[1], + std.error = last.sekap, z = last.z, + p.value = last.p.value, row.names = ""), decimal = decimal) + } + else { + if (var(mi) == 0) { + each.category <- data.frame(kappa = kapp, std.error = sekap, + z = z, p.value = p.value, row.names = colnames(x)) + } + else { + each.category <- data.frame(kappa = kapp, std.error = ".", + z = ".", p.value = ".", row.names = colnames(x)) + } + kapp.bar <- sum(pbar * qbar * kapp)/sum(pbar * qbar) + if (ncol(x) == 2 | var(mi) == 0) { + m <- mi[1] + sekap.bar <- sqrt(2)/(sum(pbar * qbar) * sqrt(n * + m * (m - 1))) * sqrt((sum(pbar * qbar))^2 - sum(pbar * + qbar * (qbar - pbar))) + z.bar <- kapp.bar/sekap.bar + p.value.bar <- pnorm(z.bar, lower.tail = FALSE) + row.names.overall <- "" + for (i in 1:max(nchar(colnames(x)))) { + row.names.overall <- paste(row.names.overall, + " ", sep = "") + } + Overall <- data.frame(kappa = kapp.bar, std.error = sekap.bar, + z = z.bar, p.value = p.value.bar, row.names = row.names.overall) + list(Each.category = each.category, Overall = Overall) + } + else { + row.names.overall <- "" + for (i in 1:max(nchar(colnames(x)))) { + row.names.overall <- paste(row.names.overall, + " ", sep = "") + } + Overall <- data.frame(kappa = kapp.bar, std.error = ".", + z = ".", p.value = ".", row.names = row.names.overall) + + } + results <- list(Each.category = each.category, Overall = Overall, decimal = decimal) + } + class(results) <- "kap.ByCategory" + results } -if(ncol(category.counts)==2){ -data.frame(kappa=kapp[1], std.error=last.sekap, z=last.z, p.value=last.p.value, row.names="") -}else{ - if( var(mi)==0){ -each.category <- data.frame(kappa = kapp, std.error = sekap, - z = z, p.value = p.value, row.names=colnames(category.counts)) -}else{ -each.category <- data.frame(kappa = kapp, std.error = ".", z=".", p.value = ".", row.names=colnames(category.counts)) -} -kapp.bar <- sum(pbar*qbar*kapp)/sum(pbar*qbar) - if(ncol(category.counts)==2| var(mi)==0){ -m <- mi[1] -sekap.bar <- sqrt(2)/(sum(pbar*qbar)*sqrt(n*m*(m-1)))*sqrt((sum(pbar*qbar))^2-sum(pbar*qbar*(qbar-pbar))) -z.bar <- kapp.bar/sekap.bar -p.value.bar <- pnorm(z.bar, lower.tail = FALSE) -row.names.overall <- "" -for(i in 1:max(nchar(colnames(category.counts)))){row.names.overall <- paste(row.names.overall, " ", sep="")} -Overall <-data.frame(kappa = kapp.bar, std.error = sekap.bar, z=z.bar, p.value = p.value.bar, row.names=row.names.overall) -list(Each.category=each.category, Overall=Overall) -}else{ -row.names.overall <- "" -for(i in 1:max(nchar(colnames(category.counts)))){row.names.overall <- paste(row.names.overall, " ", sep="")} -Overall <-data.frame(kappa = kapp.bar, std.error = ".", z=".", p.value = ".", row.names=row.names.overall) -list(Each.category=each.category, Overall=Overall) + +## Print kap.ByCategory +print.kap.ByCategory <- +function(x, ...) +{ +if(!is.null(x$Each.category)){ +cat("Each category:", "\n") +dataA <- x$Each.category +if(class(dataA$std.error)!="numeric"){ +print(data.frame(kappa=round(dataA$kappa,x$decimal), + std.error=".", + z = ".", + p.value = ".", + row.names=row.names(dataA))) + +}else{ +print(data.frame(kappa=round(dataA$kappa,x$decimal), + std.error=round(dataA$std.error, x$decimal), + z = round(dataA$z, x$decimal-1), + p.value = ifelse(dataA$p.value < 0.001,"< 0.001", + round(dataA$p.value, x$decimal)), + row.names=row.names(dataA))) } +cat("\n") +cat("Overall:", "\n") +dataB <- x$Overall +if(class(dataA$std.error)!="numeric"){ +print(data.frame(kappa=round(dataB$kappa, x$decimal), + std.error=".", + z = ".", + p.value = ".", + row.names=paste(rep(" ",max(nchar(row.names(dataB)))),collapse=""))) +}else{ +print(data.frame(kappa=round(dataB$kappa, x$decimal), + std.error=round(dataB$std.error, x$decima), + z = round(dataB$z, x$decimal-1), + p.value = ifelse(dataB$p.value < 0.001,"< 0.001", + round(dataB$p.value, x$decimal)), + row.names=paste(rep(" ",max(nchar(row.names(dataB)))),collapse=""))) +} +}else{ +dataC <- x$Overall +print(data.frame(kappa=round(dataC$kappa, x$decimal), + std.error=round(dataC$std.error, x$decima), + z = round(dataC$z, x$decimal-1), + p.value = ifelse(dataC$p.value < 0.001,"< 0.001", + round(dataC$p.value, x$decimal)), row.names=" ")) } } @@ -4402,7 +4509,7 @@ for(i in 1:length(y)){ if(length(get(y[i]))==nrow(data1)){ nam <- y[i] - assign (nam, (get(y[i]))[order(...)], env = .GlobalEnv) + assign (nam, (get(y[i]))[order(...)], envir = .GlobalEnv) } } } @@ -4726,7 +4833,7 @@ if (bin=="auto"){ if(!is.null(attr(max(x, na.rm=TRUE)-min(x, na.rm=TRUE), "units")) & !any(class(x)=="difftime")){ unit1 <- "weeks" - bin <- as.numeric(difftime(max(x, na.rm=TRUE), min(x,na.rm=TRUE), unit=unit1))+1 + bin <- as.numeric(difftime(max(x, na.rm=TRUE), min(x,na.rm=TRUE), units=unit1))+1 while(bin!=trunc(bin)){ if(unit1=="weeks"){ unit1 <- "days" }else @@ -4735,21 +4842,18 @@ if(unit1=="hours"){ unit1 <- "mins" }else if(unit1=="mins") unit1 <- "secs" - bin <- as.numeric(difftime(max(x, na.rm=TRUE), min(x,na.rm=TRUE), unit=unit1))+1 + bin <- as.numeric(difftime(max(x, na.rm=TRUE), min(x,na.rm=TRUE), units=unit1))+1 } }else{ if(is.integer(x)){ bin <- as.integer(max(x, na.rm=TRUE)- min(x, na.rm=TRUE) +1) }else{ if(any(class(x)=="Date")){ - bin <- as.numeric(difftime(max(x, na.rm=TRUE), min(x,na.rm=TRUE), unit=unit1))+1 + bin <- as.numeric(difftime(max(x, na.rm=TRUE), min(x,na.rm=TRUE), units=unit1))+1 }else{ bin <- 40 }}}} character.x <- deparse(substitute(x)) - if(any(class(x)=="date")){ - x <- as.Date(paste(date.mdy(x)$year,"-", date.mdy(x)$month,"-", date.mdy(x)$day, sep="")) - } if (is.null(by)){ value <- subset(x, !is.na(x)) }else{ @@ -4998,21 +5102,32 @@ names(nl) <- names(data1) var.order <- eval(substitute(vars), nl, parent.frame()) if(all(var.order < 0)) var.order <- (1:ncol(dataFrame))[var.order] - if (exists(names(data1)[var.order], where = 1, inherit = FALSE)) + if (exists(names(data1)[var.order], where = 1, inherits = FALSE)) warning("Name(s) of vars duplicates with an object outside the dataFrame.") tx <- cbind(old.value, new.value) if (is.numeric(old.value) | is.integer(old.value) | any(class(data1[, var.order]) == "POSIXt")) { if (length(old.value) == 1) { +if(all(is.integer(data1[, var.order]))){ + data1[, var.order][data1[, var.order] == old.value] <- as.integer(new.value) +}else{ data1[, var.order][data1[, var.order] == old.value] <- new.value +} + } else { if (length(old.value) != length(new.value) & length(new.value) != 1) stop("Lengths of old and new values are not equal") for (i in var.order) { +if(is.integer(data1[,i])){ + data1[, i] <- as.integer(lookup(data1[, i, drop = TRUE], + tx)) + +}else{ data1[, i] <- lookup(data1[, i, drop = TRUE], tx) +} } } } @@ -5072,7 +5187,7 @@ nl <- as.list(1:ncol(data1)) names(nl) <- names(data1) var.order <- eval(substitute(vars), nl, parent.frame()) - if (exists(names(data1)[var.order], where = 1, inherit = FALSE)) + if (exists(names(data1)[var.order], where = 1, inherits = FALSE)) warning("Name(s) of vars duplicates with an object outside the dataFrame.") for (i in var.order) { temp.vector <- data1[, i, drop=TRUE] @@ -5627,22 +5742,23 @@ } ## Aggregate a numeric variable aggregate.numeric <- -function (x, by, FUN = c("count", "sum", "mean", "median", "sd", "se", - "min", "max"), na.rm = TRUE, length.warning = TRUE, ...) +function (x, by, FUN = c("count", "sum", "mean", "median", "sd", + "se", "min", "max"), na.rm = TRUE, length.warning = TRUE, + ...) { count <- function(x1) { length(na.omit(x1)) } -se <- function(x1){ -sd(x1, na.rm=TRUE)/sqrt(count(x1)) -} + se <- function(x1) { + sd(x1, na.rm = TRUE)/sqrt(count(x1)) + } if (length(FUN) == 1 & class(FUN) == "function") { FUN <- as.character(substitute(FUN)) } else { - if (any(is.na(x)) & na.rm == FALSE & (is.element("var", + if (any(is.na(x)) & na.rm == FALSE & (is.element("var", FUN) | is.element("sd", FUN))) { - cat(paste("\n", " 'FUN = \"var\"' and 'FUN = \"sd\" not computable when 'na.rm=FALSE'", + cat(paste("\n", " 'FUN = \"var\"' and 'FUN = \"sd\" not computable when 'na.rm=FALSE'", "\n", " and therefore omitted"), "\n", "\n") FUN <- setdiff(FUN, c("sd", "var")) } @@ -5650,13 +5766,13 @@ stop("Too few FUN's") } if (any(is.na(x)) & length.warning & na.rm) { - if (any(FUN == "var") | any(FUN == "sd") | any(FUN == + if (any(FUN == "var") | any(FUN == "sd") | any(FUN == "mean") | any(FUN == "sum")) { - cat("\n", "Note:", "\n", " Missing values removed.", + cat("\n", "Note:", "\n", " Missing values removed.", "\n") } if (any(FUN == "length")) { - cat(" 'length' computed with missing records included.", + cat(" 'length' computed with missing records included.", "\n") } cat("\n") @@ -5665,20 +5781,20 @@ if (FUN[1] != "length") { if (FUN[1] == "count") { y <- aggregate.data.frame(x, by, FUN = count) - names(y)[length(names(y))] <- paste("count", as.character(substitute(x)), + names(y)[length(names(y))] <- paste("count", as.character(deparse(substitute(x))), sep = ".") } else { - if (FUN[1] == "sum" | FUN[1] == "mean" | FUN[1] == - "median" | FUN[1] == "var" | FUN[1] == "sd" | + if (FUN[1] == "sum" | FUN[1] == "mean" | FUN[1] == + "median" | FUN[1] == "var" | FUN[1] == "sd" | FUN[1] == "min" | FUN[1] == "max") { - y <- aggregate.data.frame(x, by, FUN = FUN[1], + y <- aggregate.data.frame(x, by, FUN = FUN[1], na.rm = na.rm) } else { y <- aggregate.data.frame(x, by, FUN = FUN[1]) } - names(y)[length(names(y))] <- paste(FUN[1], as.character(substitute(x)), + names(y)[length(names(y))] <- paste(FUN[1], as.character(deparse(substitute(x))), sep = ".") } } @@ -5694,10 +5810,10 @@ y <- data.frame(y, y1[, length(names(y1))]) } else { - if (FUN[i] == "sum" | FUN[i] == "mean" | FUN[i] == - "median" | FUN[i] == "var" | FUN[i] == "sd" | + if (FUN[i] == "sum" | FUN[i] == "mean" | FUN[i] == + "median" | FUN[i] == "var" | FUN[i] == "sd" | FUN[i] == "min" | FUN[i] == "max") { - y1 <- aggregate.data.frame(x, by, FUN = FUN[i], + y1 <- aggregate.data.frame(x, by, FUN = FUN[i], na.rm = na.rm) } else { @@ -5705,7 +5821,7 @@ } y <- data.frame(y, y1[, length(names(y1))]) } - names(y)[length(names(y))] <- paste(FUN[i], as.character(substitute(x)), + names(y)[length(names(y))] <- paste(FUN[i], as.character(deparse(substitute(x))), sep = ".") } else { @@ -5718,6 +5834,7 @@ y } + ## Aggregate plot aggregate.plot <- function (x, by, grouping = NULL, FUN = c("mean", "median"), @@ -6494,8 +6611,8 @@ } if (reverse) { - score <- factanal(na.omit(selected.matrix), factor = 1, - score = "regression")$score + score <- factanal(na.omit(selected.matrix), factors = 1, + scores = "regression")$score sign1 <- NULL for (i in 1:length(selected)) { sign1 <- c(sign1, sign(cor(score, na.omit(selected.matrix)[, @@ -6652,14 +6769,14 @@ ## Table stack -tableStack <- -function (vars, minlevel = "auto", maxlevel = "auto", count = TRUE, +tableStack <- +function (vars, minlevel = "auto", maxlevel = "auto", count = TRUE, na.rm = FALSE, means = TRUE, medians = FALSE, sds = TRUE, decimal = 1, dataFrame = .data, total = TRUE, var.labels = TRUE, var.labels.trunc = 150, reverse = FALSE, vars.to.reverse = NULL, by = NULL, vars.to.factor = NULL, iqr = "auto", prevalence = FALSE, percent = c("column", "row", "none"), frequency = TRUE, test = TRUE, name.test = TRUE, - total.column = FALSE, simulate.p.value = FALSE, sample.size=TRUE) + total.column = FALSE, simulate.p.value = FALSE, sample.size = TRUE) { nl <- as.list(1:ncol(dataFrame)) names(nl) <- names(dataFrame) @@ -6754,8 +6871,8 @@ "\n", " Remove one of them from 'vars' if 'reverse' is required.") } else { - score <- factanal(na.omit(selected.matrix), factor = 1, - score = "regression")$score + score <- factanal(na.omit(selected.matrix), factors = 1, + scores = "regression")$score sign1 <- NULL for (i in 1:length(selected)) { sign1 <- c(sign1, sign(cor(score, na.omit(selected.matrix)[, @@ -6772,16 +6889,17 @@ } table1 <- NULL for (i in as.integer(selected)) { - if (!is.factor(dataFrame[, i])) { + if (!is.factor(dataFrame[, i]) & !is.logical(dataFrame[,i, drop=TRUE])) { x <- factor(dataFrame[, i]) - if (!is.logical(dataFrame[, i, drop = TRUE])) { levels(x) <- nlevel - } tablei <- table(x) } else { + if(is.logical(dataFrame[,i, drop=TRUE])){ + tablei <- table(factor(dataFrame[,i, drop=TRUE], levels=c("FALSE","TRUE"))) + }else{ tablei <- table(dataFrame[, i]) - } + }} if (count) { tablei <- c(tablei, length(na.omit(dataFrame[, i]))) @@ -6894,7 +7012,7 @@ if (is.integer(selected.dataFrame[, 1]) | is.numeric(selected.dataFrame[, 1])) { results <- c(results, list(total.score = rowSums(selected.matrix)), - list(mean.score = rowMeans(selected.matrix)), + list(mean.score = rowMeans(selected.matrix, na.rm=na.rm)), list(mean.of.total.scores = mean.of.total.scores, sd.of.total.scores = sd.of.total.scores, mean.of.average.scores = mean.of.average.scores, @@ -6929,28 +7047,26 @@ if (is.integer(dataFrame[, selected[i]]) | is.numeric(dataFrame[, selected[i]])) { if (length(table(by1)) > 1) { - if(all(table(dataFrame[,selected[i]]) > 2)) { - if (nrow(dataFrame) < 5000) { - if (nrow(dataFrame) < 3) { - selected.iqr <- c(selected.iqr, selected[i]) - } - else if (shapiro.test(lm(dataFrame[, - selected[i]] ~ by1)$residuals)$p.value < - 0.01 | bartlett.test(dataFrame[, selected[i]] ~ - by1)$p.value < 0.01) { - selected.iqr <- c(selected.iqr, selected[i]) + if (nrow(dataFrame) < 5000) { + if (nrow(dataFrame) < 3) { + selected.iqr <- c(selected.iqr, selected[i]) + } + else if (shapiro.test(lm(dataFrame[, + selected[i]] ~ by1)$residuals)$p.value < + 0.01 | bartlett.test(dataFrame[, + selected[i]] ~ by1)$p.value < 0.01) { + selected.iqr <- c(selected.iqr, selected[i]) + } } - } - else { - sampled.shapiro <- sample(lm(dataFrame[, - selected[i]] ~ by1)$residuals, 250) - if (shapiro.test(sampled.shapiro)$p.value < - 0.01 | bartlett.test(dataFrame[, selected[i]] ~ - by1)$p.value < 0.01) { - selected.iqr <- c(selected.iqr, selected[i]) + else { + sampled.shapiro <- sample(lm(dataFrame[, + selected[i]] ~ by1)$residuals, 250) + if (shapiro.test(sampled.shapiro)$p.value < + 0.01 | bartlett.test(dataFrame[, + selected[i]] ~ by1)$p.value < 0.01) { + selected.iqr <- c(selected.iqr, selected[i]) + } } - } - } } } } @@ -6960,36 +7076,46 @@ } } table2 <- NULL - if(sample.size){ - if(test) - { - if(name.test) - { - if(total.column){ - table2 <- rbind(c(table(by1),length(by1),"",""), c(rep("",length(table(by1))+1),"","")) - colnames(table2)[ncol(table2)-(2:0)] <- c("Total", "Test stat.", "P value") - }else{ - table2 <- rbind(c(table(by1),"",""), c(rep("",length(table(by1))),"","")) - colnames(table2)[ncol(table2)-(1:0)] <- c("Test stat.", "P value") - } - }else{ - if(total.column){ - table2 <- rbind(c(table(by1),length(by1),""), c(rep("", length(table(by1))+1),"","")) - colnames(table2)[ncol(table2)-(1:0)] <- c("Total", "P value") - }else{ - table2 <- rbind(c(table(by1),""), c(rep("",length(table(by1))),"")) - colnames(table2)[ncol(table2)] <- "P value" - } - } - } - else{ - total.column <- FALSE - table2 <- rbind(table(by1), "") - } + if (sample.size) { + if (test) { + if (name.test) { + if (total.column) { + table2 <- rbind(c(table(by1), length(by1), + "", ""), c(rep("", length(table(by1)) + + 1), "", "")) + colnames(table2)[ncol(table2) - (2:0)] <- c("Total", + "Test stat.", "P value") + } + else { + table2 <- rbind(c(table(by1), "", ""), c(rep("", + length(table(by1))), "", "")) + colnames(table2)[ncol(table2) - (1:0)] <- c("Test stat.", + "P value") + } + } + else { + if (total.column) { + table2 <- rbind(c(table(by1), length(by1), + ""), c(rep("", length(table(by1)) + 1), + "", "")) + colnames(table2)[ncol(table2) - (1:0)] <- c("Total", + "P value") + } + else { + table2 <- rbind(c(table(by1), ""), c(rep("", + length(table(by1))), "")) + colnames(table2)[ncol(table2)] <- "P value" + } + } + } + else { + total.column <- FALSE + table2 <- rbind(table(by1), "") + } } for (i in 1:length(selected)) { if (is.factor(dataFrame[, selected[i]]) | is.logical(dataFrame[, - selected[i]])) { + selected[i]]) | is.character(dataFrame[, selected[i]])) { x0 <- table(dataFrame[, selected[i]], by1) if (total.column) { x <- addmargins(x0, margin = 2) @@ -7107,45 +7233,51 @@ } table0 <- term.numeric if (test) { -if(any(as.integer(table(by1[!is.na(dataFrame[,selected[i]])]))<3) | length(table(by1)) > length(table(by1[!is.na(dataFrame[,selected[i]])]))){ - test.method <- paste("Sample too small: group",paste(which(as.integer(table(factor(by)[!is.na(dataFrame[,selected[i]])]))<3), collapse=" ")) - p.value <- NA - }else{ - if (any(selected.iqr == selected[i])) { - if (length(levels(by1)) > 2) { - test.method <- "Kruskal-Wallis test" - p.value <- kruskal.test(dataFrame[, selected[i]] ~ - by1)$p.value - } - else { - test.method <- "Ranksum test" - p.value <- wilcox.test(dataFrame[, selected[i]] ~ - by1, exact = FALSE)$p.value - } + if (any(as.integer(table(by1[!is.na(dataFrame[, + selected[i]])])) < 3) | length(table(by1)) > + length(table(by1[!is.na(dataFrame[, selected[i]])]))) { + test.method <- paste("Sample too small: group", + paste(which(as.integer(table(factor(by)[!is.na(dataFrame[, + selected[i]])])) < 3), collapse = " ")) + p.value <- NA } else { - if (length(levels(by1)) > 2) { - test.method <- paste("ANOVA F-test (", - anova(lm(dataFrame[, selected[i]] ~ by1))[1, - 1], ", ", anova(lm(dataFrame[, selected[i]] ~ - by1))[2, 1], " df) = ", round(anova(lm(dataFrame[, - selected[i]] ~ by1))[1, 4], decimal + - 1), sep = "") - p.value <- anova(lm(dataFrame[, selected[i]] ~ - by1))[1, 5] - } + if (any(selected.iqr == selected[i])) { + if (length(levels(by1)) > 2) { + test.method <- "Kruskal-Wallis test" + p.value <- kruskal.test(dataFrame[, selected[i]] ~ + by1)$p.value + } + else { + test.method <- "Ranksum test" + p.value <- wilcox.test(dataFrame[, selected[i]] ~ + by1, exact = FALSE)$p.value + } + } else { - test.method <- paste("t-test", paste(" (", - t.test(dataFrame[, selected[i]] ~ by1, - var.equal = TRUE)$parameter, " df)", - sep = ""), "=", round(abs(t.test(dataFrame[, - selected[i]] ~ by1, var.equal = TRUE)$statistic), - decimal + 1)) - p.value <- t.test(dataFrame[, selected[i]] ~ - by1, var.equal = TRUE)$p.value + if (length(levels(by1)) > 2) { + test.method <- paste("ANOVA F-test (", + anova(lm(dataFrame[, selected[i]] ~ + by1))[1, 1], ", ", anova(lm(dataFrame[, + selected[i]] ~ by1))[2, 1], " df) = ", + round(anova(lm(dataFrame[, selected[i]] ~ + by1))[1, 4], decimal + 1), sep = "") + p.value <- anova(lm(dataFrame[, selected[i]] ~ + by1))[1, 5] + } + else { + test.method <- paste("t-test", paste(" (", + t.test(dataFrame[, selected[i]] ~ by1, + var.equal = TRUE)$parameter, " df)", + sep = ""), "=", round(abs(t.test(dataFrame[, + selected[i]] ~ by1, var.equal = TRUE)$statistic), + decimal + 1)) + p.value <- t.test(dataFrame[, selected[i]] ~ + by1, var.equal = TRUE)$p.value + } } } - }} + } } if (test) { if (name.test) { @@ -7216,10 +7348,9 @@ blank.row <- t(blank.row) rownames(blank.row) <- "" table2 <- rbind(table2, label.row, table0, blank.row) -} - if(sample.size) - { - rownames(table2)[1:2] <- c("Total","") + } + if (sample.size) { + rownames(table2)[1:2] <- c("Total", "") } class(table2) <- c("tableStack", "table") table2 Binary files /tmp/j91a4z_oV0/r-cran-epicalc-2.13.2.1/data/ANCtable.txt.gz and /tmp/w12l0p0laa/r-cran-epicalc-2.14.1.6/data/ANCtable.txt.gz differ Binary files /tmp/j91a4z_oV0/r-cran-epicalc-2.13.2.1/data/Bang.txt.gz and /tmp/w12l0p0laa/r-cran-epicalc-2.14.1.6/data/Bang.txt.gz differ Binary files /tmp/j91a4z_oV0/r-cran-epicalc-2.13.2.1/data/Hakimi.txt.gz and /tmp/w12l0p0laa/r-cran-epicalc-2.14.1.6/data/Hakimi.txt.gz differ Binary files /tmp/j91a4z_oV0/r-cran-epicalc-2.13.2.1/data/Montana.txt.gz and /tmp/w12l0p0laa/r-cran-epicalc-2.14.1.6/data/Montana.txt.gz differ diff -Nru r-cran-epicalc-2.13.2.1/debian/README.Debian r-cran-epicalc-2.14.1.6/debian/README.Debian --- r-cran-epicalc-2.13.2.1/debian/README.Debian 2010-06-04 11:22:07.000000000 +0000 +++ r-cran-epicalc-2.14.1.6/debian/README.Debian 1970-01-01 00:00:00.000000000 +0000 @@ -1,5 +0,0 @@ -Notes on how this package can be tested. -──────────────────────────────────────── - -This package can be tested by loading it into R with the command -‘library(epicalc)’ in order to confirm its integrity. diff -Nru r-cran-epicalc-2.13.2.1/debian/README.test r-cran-epicalc-2.14.1.6/debian/README.test --- r-cran-epicalc-2.13.2.1/debian/README.test 1970-01-01 00:00:00.000000000 +0000 +++ r-cran-epicalc-2.14.1.6/debian/README.test 2010-06-04 11:22:07.000000000 +0000 @@ -0,0 +1,5 @@ +Notes on how this package can be tested. +──────────────────────────────────────── + +This package can be tested by loading it into R with the command +‘library(epicalc)’ in order to confirm its integrity. diff -Nru r-cran-epicalc-2.13.2.1/debian/changelog r-cran-epicalc-2.14.1.6/debian/changelog --- r-cran-epicalc-2.13.2.1/debian/changelog 2011-10-25 15:14:49.000000000 +0000 +++ r-cran-epicalc-2.14.1.6/debian/changelog 2013-05-05 16:11:56.000000000 +0000 @@ -1,3 +1,25 @@ +r-cran-epicalc (2.14.1.6-1precise0) precise; urgency=low + + * Compilation for Ubuntu 12.04.2 LTS + + -- Michael Rutter Sun, 05 May 2013 16:11:56 +0000 + +r-cran-epicalc (2.14.1.6-1) unstable; urgency=low + + * New upstream version + * debian/control: + - Standards-Version: 3.9.3 (no changes needed) + - Build-Depends: r-base-dev (>= 2.14.2~20120222) + * debian/rules: + - Remove R:Depends substitution variable which is now + included in /usr/share/R/debian/r-cran.mk + * debian/README.Debian is rather README.test + * debian/docs: Install README.test + * debian/copyright: Enhanced DEP5 compatibility and verified using + cme fix dpkg-copyright + + -- Andreas Tille Mon, 26 Mar 2012 15:42:12 +0200 + r-cran-epicalc (2.13.2.1-1) unstable; urgency=low * New upstream version diff -Nru r-cran-epicalc-2.13.2.1/debian/control r-cran-epicalc-2.14.1.6/debian/control --- r-cran-epicalc-2.13.2.1/debian/control 2011-10-25 15:04:51.000000000 +0000 +++ r-cran-epicalc-2.14.1.6/debian/control 2012-03-26 13:44:06.000000000 +0000 @@ -4,9 +4,9 @@ Maintainer: Debian Med Packaging Team Uploaders: Andreas Tille DM-Upload-Allowed: yes -Build-Depends: debhelper (>= 8), cdbs, r-base-dev, r-cran-foreign, r-cran-survival, - r-cran-mass, r-cran-nnet -Standards-Version: 3.9.2 +Build-Depends: debhelper (>= 8), cdbs, r-base-dev (>= 2.14.2~20120222), r-cran-foreign, + r-cran-survival, r-cran-mass, r-cran-nnet +Standards-Version: 3.9.3 Homepage: http://cran.r-project.org/web/packages/epicalc Vcs-Browser: http://svn.debian.org/wsvn/debian-med/trunk/packages/R/r-cran-epicalc/trunk/ Vcs-Svn: svn://svn.debian.org/debian-med/trunk/packages/R/r-cran-epicalc/trunk/ diff -Nru r-cran-epicalc-2.13.2.1/debian/copyright r-cran-epicalc-2.14.1.6/debian/copyright --- r-cran-epicalc-2.13.2.1/debian/copyright 2009-11-20 07:51:11.000000000 +0000 +++ r-cran-epicalc-2.14.1.6/debian/copyright 2012-03-26 13:47:55.000000000 +0000 @@ -1,33 +1,31 @@ -Format: Machine-readable license summary, see http://dep.debian.net/deps/dep5/ - -Name: epicalc -Contact: Virasakdi Chongsuvivatwong +Format: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ +Upstream-Name: epicalc +Upstream-Contact: Virasakdi Chongsuvivatwong Source: http://cran.r-project.org/web/packages/epicalc +Files: * +Copyright: 2009-2012 Virasakdi Chongsuvivatwong License: GPL-2+ -Copyright: 2009 Virasakdi Chongsuvivatwong - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . +Files: debian/* +Copyright: 2008-2012 Andreas Tille + 2009 Charles Plessy +License: GPL-2+ -Comment: On Debian systems, the complete text of the GNU Public +License: GPL-2+ + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 2 of the License, or + (at your option) any later version. + . + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + . + You should have received a copy of the GNU General Public License + along with this program. If not, see . + . + On Debian systems, the complete text of the GNU Public License version 2 can be found in `/usr/share/common-licenses/GPL-2'. - -Files: debian/* -Copyright: 2008 Andreas Tille - 2009 Charles Plessy -License: Same as r-cran-epicalc itelf - (see above) -Packaged-By: Andreas Tille -Packaged-Date: Thu, 19 Nov 2009 15:38:39 +0100 diff -Nru r-cran-epicalc-2.13.2.1/debian/docs r-cran-epicalc-2.14.1.6/debian/docs --- r-cran-epicalc-2.13.2.1/debian/docs 1970-01-01 00:00:00.000000000 +0000 +++ r-cran-epicalc-2.14.1.6/debian/docs 2012-03-23 22:41:02.000000000 +0000 @@ -0,0 +1 @@ +debian/README.test diff -Nru r-cran-epicalc-2.13.2.1/debian/rules r-cran-epicalc-2.14.1.6/debian/rules --- r-cran-epicalc-2.13.2.1/debian/rules 2011-10-25 15:14:16.000000000 +0000 +++ r-cran-epicalc-2.14.1.6/debian/rules 2012-03-26 13:43:28.000000000 +0000 @@ -6,6 +6,4 @@ include /usr/share/R/debian/r-cran.mk install/$(package):: - # Require a number equal or superior than the R version the package was built with. - echo "R:Depends=r-base-core (>= $(shell R --version | head -n1 | perl -ne 'print / +([0-9]\.[0-9]+\.[0-9])/')~)" >> debian/r-$(debRreposname)-$(cranName).substvars chmod a-x debian/$(package)/usr/lib/R/site-library/epicalc/DESCRIPTION \ No newline at end of file diff -Nru r-cran-epicalc-2.13.2.1/man/adjust.rd r-cran-epicalc-2.14.1.6/man/adjust.rd --- r-cran-epicalc-2.13.2.1/man/adjust.rd 2011-10-04 10:17:48.000000000 +0000 +++ r-cran-epicalc-2.14.1.6/man/adjust.rd 2012-02-17 04:09:42.000000000 +0000 @@ -48,6 +48,9 @@ Table.crude.means Table.adjusted.means +# Price by category of DriveTrain adjusted for Horsepower & Origina +adjust(c(Horsepower,Origin), list(DriveTrain), model=model1) + ## Now for crude and adjusted probabilities of having manual transmission manual <- Man.trans.avail =="Yes" model2 <- glm(manual ~ Origin + Horsepower + DriveTrain, family=binomial) diff -Nru r-cran-epicalc-2.13.2.1/man/kap.rd r-cran-epicalc-2.14.1.6/man/kap.rd --- r-cran-epicalc-2.13.2.1/man/kap.rd 2011-10-04 10:17:49.000000000 +0000 +++ r-cran-epicalc-2.14.1.6/man/kap.rd 2012-02-17 04:09:42.000000000 +0000 @@ -12,13 +12,13 @@ \method{kap}{default}(x, ...) -\method{kap}{table}(x, wttable = c(NULL, "w", "w2"), print.wttable = FALSE, ...) +\method{kap}{table}(x, decimal =3, wttable = c(NULL, "w", "w2"), print.wttable = FALSE, ...) -\method{kap}{2.raters}(x, rater2, ...) +\method{kap}{2.raters}(x, rater2, decimal =3, ...) -\method{kap}{m.raters}(x, raters, ...) +\method{kap}{m.raters}(x, decimal =3, ...) -\method{kap}{ByCategory}(x, category.counts, ...) +\method{kap}{ByCategory}(x, decimal =3, ...) } \arguments{ \item{x}{an object serving the first argument for different methods @@ -26,14 +26,14 @@ \tab FUNCTION \tab 'x'\cr \tab 'kap.table' \tab table\cr \tab 'kap.2.raters' \tab rater1\cr - \tab 'kap.m.raters' \tab 'id' of subjects being rated\cr - \tab 'kap.ByCategory' \tab 'id' of subjects being rated\cr + \tab 'kap.m.raters' \tab data frame with raters in column\cr + \tab 'kap.ByCategory' \tab data frame with categories in column\cr }} - \item{wttable}{cross tabulation of weights of agreement among categories. Applicable only for 'kap.table' and 'kap.2.raters'} + + \item{decimal}{number of decimal in the print} + \item{wttable}{cross tabulation of weights of agreement among categories. Applicable only for 'kap.table' and 'kap.2.raters'} \item{print.wttable}{whether the weights table will be printed out} \item{rater2}{a vector or factor containing opinions of the second rater among two raters.} - \item{raters}{a data frame or a matrix containing opinions of two or more raters} - \item{category.counts}{a data frame or a matrix containing columns of frequencies of rating categories.} \item{...}{further arguments passed to or used by other methods.} } \details{ @@ -79,40 +79,38 @@ kap(table1, wttable = "w2", print.wttable=TRUE) ## A data set from 5 raters with 3 possible categories. -id <- 1:10 category.lab <- c("yes","no","Don't know") rater1 <- factor(c(1,1,3,1,1,1,1,2,1,1), labels=category.lab) rater2 <- factor(c(2,1,3,1,1,2,1,2,3,1), labels=category.lab) rater3 <- factor(c(2,3,3,1,1,2,1,2,3,1), labels=category.lab) rater4 <- factor(c(2,3,3,1,3,2,1,2,3,3), labels=category.lab) rater5 <- factor(c(2,3,3,3,3,2,1,3,3,3), labels=category.lab) -kap.m.raters(id, raters=data.frame(rater1,rater2,rater3,rater4,rater5)) +kap.m.raters(data.frame(rater1,rater2,rater3,rater4,rater5)) # The above is the same as YES <- c(1,2,0,4,3,1,5,0,1,3) NO <- c(4,0,0,0,0,4,0,4,0,0) DONTKNOW <- c(0,3,5,1,2,0,0,1,4,2) -kap.ByCategory(id, category.counts = data.frame(YES,NO,DONTKNOW)) +kap.ByCategory(data.frame(YES,NO,DONTKNOW)) # Using 'kap.m.raters' for 2 raters is inappropriate. Kappa obtained # from this method assumes that the agreement can come from any two raters, # which is usually not the case. -kap.m.raters(id, data.frame(rater1, rater2)) +kap.m.raters(data.frame(rater1, rater2)) # 'kap.2.raters' gives correct results kap.2.raters(rater1, rater2) # When there are missing values, rater3[9] <- NA; rater4[c(1,9)] <- NA -kap.m.raters(id, raters=data.frame(rater1,rater2,rater3,rater4,rater5)) +kap.m.raters(data.frame(rater1,rater2,rater3,rater4,rater5)) # standard errors and other related statistics are not available. # Two exclusive rating categories give only one common set of results. # The standard error is obtainable even if the numbers of raters vary # among individual subjects being rated. -id2 <- 1:25 totalRaters <- c(2,2,3,4,3,4,3,5,2,4,5,3,4,4,2,2,3,2,4,5,3,4,3,3,2) pos <- c(2,0,2,3,3,1,0,0,0,4,5,3,4,3,0,2,1,1,1,4,2,0,0,3,2) neg <- totalRaters - pos -kap.ByCategory(id2, category.counts = data.frame(neg, pos)) +kap.ByCategory(data.frame(neg, pos)) } \keyword{array} diff -Nru r-cran-epicalc-2.13.2.1/man/lrtest.rd r-cran-epicalc-2.14.1.6/man/lrtest.rd --- r-cran-epicalc-2.13.2.1/man/lrtest.rd 2011-10-04 10:17:49.000000000 +0000 +++ r-cran-epicalc-2.14.1.6/man/lrtest.rd 2012-02-17 04:09:42.000000000 +0000 @@ -3,13 +3,12 @@ \title{Likelihood ratio test} \description{Likelihood ratio test for objects of class 'glm'} \usage{ -lrtest (model1, model2, print=TRUE) +lrtest (model1, model2) } \details{Likelihood ratio test checks the difference between -2*logLikelihood of the two models against the change in degrees of freedom using a chi-squared test. It is best applied to a model from 'glm' to test the effect of a factor with more than two levels. The records used in the dataset for both models MUST be the same. The function can also be used with "clogit", which does not have real logLikelihood. } \arguments{ \item{model1, model2}{Two models of class "glm" having the same set of records and the same type ('family' and 'link')} - \item{print}{whether the results will be printed} } \author{Virasakdi Chongsuvivatwong \email{ } diff -Nru r-cran-epicalc-2.13.2.1/man/print.kap.ByCategory.rd r-cran-epicalc-2.14.1.6/man/print.kap.ByCategory.rd --- r-cran-epicalc-2.13.2.1/man/print.kap.ByCategory.rd 1970-01-01 00:00:00.000000000 +0000 +++ r-cran-epicalc-2.14.1.6/man/print.kap.ByCategory.rd 2012-02-17 04:09:42.000000000 +0000 @@ -0,0 +1,17 @@ +\name{print kap.ByCategory} +\alias{print.kap.ByCategory} +\title{Print kap.ByCategory results} +\description{Print results for kap.Bycategory commands} +\usage{ +\method{print}{kap.ByCategory}(x, ...) +} +\arguments{ + \item{x}{object of class 'kap.ByCategory'} + \item{...}{further arguments passed to or used by methods.} +} +\author{Virasakdi Chongsuvivatwong + \email{ } +} +\seealso{'kap.ByCategory'} +\keyword{database} + diff -Nru r-cran-epicalc-2.13.2.1/man/print.kap.table.rd r-cran-epicalc-2.14.1.6/man/print.kap.table.rd --- r-cran-epicalc-2.13.2.1/man/print.kap.table.rd 1970-01-01 00:00:00.000000000 +0000 +++ r-cran-epicalc-2.14.1.6/man/print.kap.table.rd 2012-02-17 04:09:42.000000000 +0000 @@ -0,0 +1,17 @@ +\name{print kap.table} +\alias{print.kap.table} +\title{Print kap.table results} +\description{Print results for kap.table commands} +\usage{ +\method{print}{kap.table}(x, ...) +} +\arguments{ + \item{x}{object of class 'kap.table'} + \item{...}{further arguments passed to or used by methods.} +} +\author{Virasakdi Chongsuvivatwong + \email{ } +} +\seealso{'kap.table'} +\keyword{database} + diff -Nru r-cran-epicalc-2.13.2.1/man/print.lrtest.rd r-cran-epicalc-2.14.1.6/man/print.lrtest.rd --- r-cran-epicalc-2.13.2.1/man/print.lrtest.rd 1970-01-01 00:00:00.000000000 +0000 +++ r-cran-epicalc-2.14.1.6/man/print.lrtest.rd 2012-02-17 04:09:42.000000000 +0000 @@ -0,0 +1,23 @@ +\name{print lrtest} +\alias{print.lrtest} +\title{Print lrtest results} +\description{Print results for likelihood ratio test} +\usage{ +\method{print}{lrtest}(x, ...) +} +\arguments{ + \item{x}{object of class 'lrtest'} + \item{...}{further arguments passed to or used by methods.} +} +\author{Virasakdi Chongsuvivatwong + \email{ } +} +\seealso{'logistic.display'} +\examples{ +model0 <- glm(case ~ induced + spontaneous, family=binomial, data=infert) +model1 <- glm(case ~ induced, family=binomial, data=infert) +lrtest (model0, model1) +lrtest (model1, model0) -> a +a} +\keyword{database} + diff -Nru r-cran-epicalc-2.13.2.1/man/tableStack.rd r-cran-epicalc-2.14.1.6/man/tableStack.rd --- r-cran-epicalc-2.13.2.1/man/tableStack.rd 2011-10-04 10:17:49.000000000 +0000 +++ r-cran-epicalc-2.14.1.6/man/tableStack.rd 2012-02-17 04:09:42.000000000 +0000 @@ -3,7 +3,7 @@ \title{Tabulation of variables in a stack form} \description{Tabulation of variables with the same possible range of distribution and stack into a new table with or without other descriptive statistics or to breakdown distribution of more than one row variables against a column variable} \usage{ -tableStack (vars, minlevel = "auto", maxlevel = "auto", count = TRUE, +tableStack (vars, minlevel = "auto", maxlevel = "auto", count = TRUE, na.rm =FALSE, means = TRUE, medians = FALSE, sds = TRUE, decimal = 1, dataFrame = .data, total = TRUE, var.labels = TRUE, var.labels.trunc =150, reverse = FALSE, vars.to.reverse = NULL, by = NULL, vars.to.factor = NULL, iqr = "auto", @@ -16,6 +16,7 @@ \item{minlevel}{possible minimum value of items specified by user} \item{maxlevel}{possible maximum value of items specified by user} \item{count}{whether number of valid records for each item will be displayed} + \item{na.rm}{whether missing value would be removed during calculation mean score of each person} \item{means}{whether means of all selected items will be displayed} \item{medians}{whether medians of all selected items will be displayed} \item{sds}{whether standard deviations of all selected items will be displayed}