Publish/0000755000176200001440000000000015040441566011665 5ustar liggesusersPublish/tests/0000755000176200001440000000000015040357764013035 5ustar liggesusersPublish/tests/testthat/0000755000176200001440000000000015040441566014667 5ustar liggesusersPublish/tests/testthat/test-publish.R0000644000176200001440000000160414142666146017443 0ustar liggesusers### test-publish.R --- #---------------------------------------------------------------------- ## author: Brice Ozenne ## created: apr 6 2017 (10:04) ## Version: ## last-updated: Aug 14 2017 (19:29) ## By: Thomas Alexander Gerds ## Update #: 10 #---------------------------------------------------------------------- ## ### Commentary: ## ### Change Log: #---------------------------------------------------------------------- ## ### Code: library(testthat) library(Publish) context("publish: default and matrix") test_that("publish rounding of a matrix with NA", { set.seed(7) y0 <- cbind(a=rnorm(2),b=1:2,c=letters[1:2]) y1 <- y0 y1[1,1] <- NA y1[2,2] <- NA b <- publish(y1,digits=1) expect_equal(c(b),c(" NA","-1.2","1.0"," NA","a","b")) }) #---------------------------------------------------------------------- ### test-publish.R ends here Publish/tests/testthat/test-publish-mi.R0000644000176200001440000000124214142666146020044 0ustar liggesuserslibrary(testthat) library(Publish) library(mitools) library(smcfcs) library(riskRegression) test_that("multiple imputation",{ set.seed(71) d=sampleData(100) ## generate missing values d[X1==1,X6:=NA] d[X2==1,X3:=NA] d=d[,.(X8,X4,X3,X6,X7)] sapply(d,function(x)sum(is.na(x))) d[,X4:=factor(X4,levels=c("0","1"),labels=c("0","1"))] set.seed(17) f= smcfcs(d,smtype="lm",smformula=X8~X4*X3+X6+X7,method=c("","","logreg","norm",""),m=3) ccfit=lm(X8~X4*X3+X6+X7,data=d) impobj <- imputationList(f$impDatasets) models <- with(impobj,lm(X8~X4*X3+X6+X7)) mifit <- MIcombine(models) a <- publish(mifit,fit=ccfit,data=d) }) Publish/tests/testthat/test-univariateTable.R0000644000176200001440000000715214222267557021122 0ustar liggesusers### test-univariateTable.R --- #---------------------------------------------------------------------- ## author: Thomas Alexander Gerds ## created: May 9 2015 (07:55) ## Version: ## last-updated: Apr 3 2022 (11:57) ## By: Thomas Alexander Gerds ## Update #: 10 #---------------------------------------------------------------------- ## ### Commentary: ## ### Change Log: #---------------------------------------------------------------------- ## ### Code: library(testthat) library(prodlim) library(Publish) data(Diabetes) test_that("univariateTable no groups",{ u1 <- univariateTable(~age +gender + height + weight,data=Diabetes) a <- summary(u1,show.missing=1L) expect_equal(NROW(a),9) b <- summary(u1,show.missing=0L) expect_equal(NROW(b),5) u2 <- univariateTable(~age,data=Diabetes) u3 <- univariateTable(~gender,data=Diabetes) a1 <- publish(univariateTable(~age+gender+ height+weight,data=Diabetes)) a2 <- publish(summary(univariateTable(~age+gender+ height+weight,data=Diabetes))) expect_equal(a1,a2) }) test_that("Univariate table with groups and missing values and labels with special characters",{ Diabetes$AgeGroups <- cut(Diabetes$age, c(19,29,39,49,59,69,92), include.lowest=TRUE) univariateTable(location~age+gender+height+weight+AgeGroups,data=Diabetes) publish(summary(univariateTable(location~age+gender+height+weight, data=Diabetes)),org=TRUE) v <- univariateTable(gender ~age+height,data=Diabetes) sv <- summary(v,show.missing="always") univariateTable(location~factor(AgeGroups)+gender+height+weight, data=Diabetes, summary.format="median(x) {iqr(x)}") levels(Diabetes$frame) <- c("+large","medi()um=.<",">8") expect_output(publish(summary(univariateTable(frame~age+gender+height+weight+location, data=Diabetes)),org=TRUE)) expect_output(publish(summary(univariateTable(location~age+gender+height+weight+frame, data=Diabetes)),org=TRUE)) }) test_that("Univariate table with row percent",{ a <- summary(univariateTable(frame~gender+location, data=Diabetes,column.percent=TRUE)) b <- summary(univariateTable(frame~gender+location, data=Diabetes,column.percent=FALSE)) expect_equal(as.numeric(colSums(a[a$Variable=="gender"]==b[b$Variable=="gender"])),c(4,0)) }) if (FALSE){ test_that("Univariate table with stupid function",{ stupid <- function(x){ if (mean(x)>47) "large" else "small" } univariateTable(location~age+height+weight, data=Diabetes, summary.format="Mean: mean(x) stupid's distance: (stupid(x))") publish(summary(univariateTable(location~age+height+weight, data=Diabetes, summary.format="Mean: mean(x) stupid's distance: (stupid(x))")), org=TRUE) MeanSe <- function(x){ paste("Mean=",round(mean(x),1)," Standard.error=",round(sd(x)/sqrt(length(x)),3),sep="") } expect_output(publish(univariateTable(location~age+height+weight,data=Diabetes,summary.format="MeanSe(x)"))) ux <- univariateTable(location~gender+age+AgeGroups, data=Diabetes, column.percent=FALSE, freq.format="count(x)") sux <- summary(ux) publish(sux,org=TRUE) }) } #---------------------------------------------------------------------- ### test-univariateTable.R ends here Publish/tests/testthat/test-regressionTable.R0000644000176200001440000000272414142666146021131 0ustar liggesusers### test-regressionTable.R --- #---------------------------------------------------------------------- ## Author: Thomas Alexander Gerds ## Created: Aug 13 2017 (07:39) ## Version: ## Last-Updated: Nov 3 2019 (19:32) ## By: Thomas Alexander Gerds ## Update #: 6 #---------------------------------------------------------------------- ## ### Commentary: ## ### Change Log: #---------------------------------------------------------------------- ## ### Code: library(testthat) library(Publish) data(Diabetes) test_that("regressiontable: transformed variables and factor levels",{ Diabetes$hyp1 <- factor(1*(Diabetes$bp.1s>140)) Diabetes$ofak <- ordered(sample(letters[1:11],size=NROW(Diabetes),replace=1L)) levels(Diabetes$frame) <- c("+large","medi()um=.<",">8") f <- glm(hyp1~frame+gender+log(age)+I(chol>245)+ofak,data=Diabetes,family="binomial") regressionTable(f) summary(regressionTable(f)) }) test_that("plot.regressionTable",{ Diabetes$hyp1 <- factor(1*(Diabetes$bp.1s>140)) Diabetes$ofak <- ordered(sample(letters[1:11],size=NROW(Diabetes),replace=1L)) levels(Diabetes$frame) <- c("+large","medi()um=.<",">8") f <- glm(hyp1~frame+gender+log(age)+I(chol>245)+ofak,data=Diabetes,family="binomial") f <- glm(hyp1~log(age)+I(chol>245),data=Diabetes,family="binomial") u <- regressionTable(f) plot(u) }) ###################################################################### ### test-regressionTable.R ends here Publish/tests/testthat.R0000644000176200001440000000056615040357725015024 0ustar liggesusers# This file is part of the standard setup for testthat. # It is recommended that you do not modify it. # # Where should you do additional test configuration? # Learn more about the roles of various files in: # * https://r-pkgs.org/tests.html # * https://testthat.r-lib.org/reference/test_package.html#special-files library(testthat) library(Publish) test_check("Publish") Publish/MD50000644000176200001440000001715715040441566012210 0ustar liggesusers443a57f2a03fbddda13d11224a1d6bde *DESCRIPTION 0ab5a6e7dc32655c99e0a1009aee084a *NAMESPACE 5a729150ff2b9449cd7ad0278c7e5025 *R/Spaghettiogram.R 08b4c82000709969e260bc85df19221b *R/Units.R eac0fb9112077cb7bdcde7654825f8cd *R/acut.R e92f6f4332f5d5b5ab64c864c4fdfd7e *R/canbe.numeric.R 85f883ece7362b27557b83797d8702a1 *R/ci.geomean.R 2f4b1a1c71f087184245bcdebaba59d3 *R/ci.geomean.formula.R 7ab365301f8323fafb0b39e92e1244bb *R/ci.mean.R aaabc563ab85b6a93c64edf7ff58766b *R/ci.mean.default.R 148cf267253b2224e2cbbb8fe011d07c *R/ci.mean.formula.R 0e21cb8e131d030f429ecd63c7f9e330 *R/coxphSeries.R 2d8e9298d8f2cb4c867614c9851c736e *R/fixRegressionTable.R a686a6e7e0626fc4476550c819785bae *R/followupTable.R 65b59048180c7ed50b61703ea4819c54 *R/formatCI.R da27ffb6df70957faedfe8480b5a4997 *R/getFrequency.R ae9ce41fe159f5594946a826724a34e5 *R/getPyntDefaults.R 3248219b71e32865daaeda84fe01d36f *R/getSummary.R cf08b20c8dc5598ade92d0269e4f6600 *R/glmSeries.R 8ebbd8baa5999f391c3a525bfe733714 *R/iqr.R b7e9aa6ddda0a67041aeafbe28072d7c *R/labelUnits.R 7db173d33723b34e29fdf3ed07b03732 *R/lazyDateCoding.R 07c0d3cdcec0bbddb43bb84e4dd221e4 *R/lazyFactorCoding.R ef9962eaa6ccf40454528920c64449df *R/lhs.R 7a3a8af06f7c605e07cb619c0e29fa7c *R/org.R 2327466271b8dc0ac38d5106e5ae240f *R/parseFrequencyFormat.R c72ecae4428489d8a4f6b7bfad890445 *R/parseInteractionTerms.R 4da2f37c84a338b6168a4644a79eb7c2 *R/parseSummaryFormat.R 41360905a5dc88d3ab020fbd41289abf *R/plot.ci.R cc20db420e3646f562930f2cec045fde *R/plot.regressionTable.R ca5815922ea857258dd1c3e4aaeaadc1 *R/plot.subgroupAnalysis.R c563cdf3df59c8bff83619f472241833 *R/plotConfidence.R 602c21f685f9c5c5f0054d4fb6f5fafc *R/plotLabels.R 0c5f0f1a47224e5b7839f331da727986 *R/prepareLabels.R 404d201944a3c3454d5136dd3db5e485 *R/print.ci.R fac3a91bbb9c513fda4efbbbec5bbf96 *R/print.regressionTable.R 60ff8edd8d410ad8a1f558404496481c *R/print.subgroupAnalysis.R bf1289d69a2ae8518357c8b26d0b298c *R/print.table2x2.R e1bf4285c05fddf79cf52306f4fec8b4 *R/print.univariateTable.R b577fe41c2bebf54e679228aaf82a70a *R/pubformat.R d84c851020d221bb2cc0178b5a7617bc *R/publish-package.R 7d3429caf2374f6f53f0b0b62779116d *R/publish.CauseSpecificCox.R 908e233a42035c59c8aad0a1b9fad272 *R/publish.FGR.R cb042f795f38ed3241c5a5d152b8376f *R/publish.MIresult.R 5191f5f850a3b161930f7411408ca372 *R/publish.R bcbd113697334afaa541ff378fb448c3 *R/publish.Score.R 72d0bb54a083e611bea2562a4dce49a6 *R/publish.ci.R 8e9123e3d5d0225d952cd193fabac85a *R/publish.coxph.R 610ae466e4f17fed6d82511c88490fd0 *R/publish.data.frame.R 377644b1332154e37ac73441a6d97c08 *R/publish.default.R c0b4e14dc565177a242da263dc8d4f92 *R/publish.glm.R f31b987831c60180682063dd7793e416 *R/publish.htest.R 1c91d21d772f74ceb26087d524a3487e *R/publish.list.R 0139c6d8e16d0004dbc7650a014a535d *R/publish.matrix.R 389ba35d05e1310074404ab826cfe3b1 *R/publish.prodlim.R 9911a32e7793448c5262a9e0b7005b72 *R/publish.riskReclassification.R 2fddc799460327afb7c40f0b1c9272d0 *R/publish.riskRegression.R 80488ad11f84fdc6dfb8891277f073f0 *R/publish.subgroupAnalysis.R 45bece7acf7f00558dae7ec55a022e76 *R/publish.summary.aov.R c5ccd754c6f356b0e7c2d6b47291d917 *R/publish.summary.prodlim.R 354b2bf084b95b6ed5e0ecdd02ad7659 *R/publish.survdiff.R 1e95f5eefac90d928e1d8c7dacbcc93f *R/publish.table.R 89bdcc8004bfc4692ae551d17b1a6089 *R/publish.univariateTable.R 8ea80ba4940b657e4e072afc3f208d9a *R/regressionTable.R 01a69c4849ff14e5e591a34af7594beb *R/rhs.R b31afe3756186c737d3c1087be122e2d *R/specialFrame.R 7dc868202db71c1a86d2e5ea3e75ce6c *R/splinePlot.lrm.R 73d9c191d2bbbd2c0477cf2d6e7fa52d *R/stripes.R 47fb10a76a3f83e9f8643a7205669dac *R/subgroupAnalysis.R 47a693360c245efa9880960184cee603 *R/summary.ci.R cfbe83f62d55758d8f7a685b0aec64c7 *R/summary.regressionTable.R 4704ce7d32d0bf98ed0e2f2ae0bcd46b *R/summary.subgroupAnalysis.R 023e8bf54ecb522149c727f548dddbd8 *R/summary.univariateTable.R 3e951a9e40a12293039656483d492a9e *R/sutable.R 887016bd9f4a844d4e5ca27dee4ad581 *R/table2x2.R d7d1c0b677a40c3e68a21fbdb6da494a *R/univariateTable.R e7850a3e636e56080b99edbf5d8e677d *README.md a056465f80a60cf1da8dd86c4258ffba *data/CiTable.csv 615fa9de525f027cb85a4930f0b35e5d *data/Diabetes.csv 70f9101ce23026498c5b20c4a556ad5b *data/Diabetes.rda 32201723924050ac0906081edfa9df2c *data/SpaceT.csv 90b53e2a6a5110b3a08075cf68b9b261 *data/trace.rda 8fb74f79c54827f0d546724cc2f55675 *data/traceR.rda 511070ca513b957004bba4f73ff447fd *man/CiTable.Rd 3065c4aab2f2dcbf52f0b9757a2f78d6 *man/Diabetes.Rd fe9fa3f1f6bf71fa87d53a79ea772785 *man/Publish-package.Rd 11ca1b2aa1109d216bc57e99e8beb4a5 *man/SpaceT.Rd 278d52fa5781181e6de9ae7e44962352 *man/Units.Rd cb416cb8acb99d56d117342774f20b48 *man/acut.Rd ae6a153b9b6f341f1935e5da3a01b51d *man/ci.mean.Rd 8b7ae61e883914a38928ff09be871a9d *man/ci.mean.default.Rd 463f8aab4972651de0863062e199cc15 *man/coxphSeries.Rd 581ff1aabb51855ea7320ce2d01b0e0c *man/fixRegressionTable.Rd a45e121f6ef3292af5dbf2fb4d41b720 *man/followupTable.Rd d76d91aa5117f355819fee5c519654ea *man/formatCI.Rd 39f5c7d14c7c5ff2ac1dfdb18434aa8c *man/glmSeries.Rd 16a04abc48c828e2107b4e71631c89d5 *man/labelUnits.Rd 2c2b175b5774fcd425e8276b96725ff3 *man/lazyDateCoding.Rd b9cac71009612ca74925e32aa6692833 *man/lazyFactorCoding.Rd 1381f60f2b7fb4685d39935134d66dd3 *man/org.Rd 2d5b916eb758c31075050cc3eea37e82 *man/parseInteractionTerms.Rd 070372a74a72b8ac176f8b704ddb1dbb *man/plot.ci.Rd 4aed4af503f959cd2aff6d64a3f75399 *man/plot.regressionTable.Rd 56d89d76a112a20726438170e146bd08 *man/plot.subgroupAnalysis.Rd 5612c588c1ba2322f823d07fabc858b5 *man/plotConfidence.Rd 8a46d382df90dc71fe7a6e6f3b6a9f6f *man/print.ci.Rd 3ae438eb0431982fd6a83a5f76e40814 *man/print.regressionTable.Rd 08b194c2cebc70512b76006078183bc8 *man/print.subgroupAnalysis.Rd e6648af731a5eec0d08555a5b3b63c1b *man/print.table2x2.Rd 4761dfa45f61e5e86a4ca9b2dd515ace *man/print.univariateTable.Rd aba78afc99421ae9b1068b653c2fba11 *man/pubformat.Rd 70357f0895df211ca882898a5f6279bf *man/publish.CauseSpecificCox.Rd 70681623ecee218d11a9b8a5cdde124f *man/publish.MIresult.Rd e663cb0f13e3106229a23321fab57412 *man/publish.Rd a7bfa62b382c6cc2f479edb2342a68a2 *man/publish.Score.Rd 5a6f0ab242d87d13d0d6bd9b3666df06 *man/publish.ci.Rd 6468ddab712b3f48fed5afb85ad9df3d *man/publish.coxph.Rd b0ff83ad7a3b4bd6297bfe29844d190f *man/publish.glm.Rd 2994d066de2c163ffc914d2793b5c6ef *man/publish.htest.Rd 7df8eab494fed04a143d74d0ce4cfa97 *man/publish.matrix.Rd 8f2e464e6ba6fedffc7df784aa548f8f *man/publish.riskReclassification.Rd 40e749b2ee2824f18a000f4a9e7a91db *man/publish.riskRegression.Rd 889d20f799197078b31a75bbec790473 *man/publish.summary.aov.Rd 99a6cbc5e0d46534fc37c9f6fee72587 *man/publish.survdiff.Rd 19adf8a1b06729b13773e975b5690685 *man/regressionTable.Rd 32c38c7fa817e06cfd92e6c89190ed79 *man/spaghettiogram.Rd efceffac1d0f011430fbd1d312546610 *man/specialFrame.Rd 25973ff649c6db01774bd0d209fceb3d *man/splinePlot.lrm.Rd b3473683490a270ed8a8afbd0a859eea *man/stripes.Rd c54c58fa141e2d84ade65d1d34bcb081 *man/subgroupAnalysis.Rd ce1ca13751c62819315ae728622b7a3e *man/summary.ci.Rd aaabe1c48e9c59f5472d40c68a211a58 *man/summary.regressionTable.Rd 69377afb7b880f2ad53d7157ddf08852 *man/summary.subgroupAnalysis.Rd 3753e3217ef2740967b43fd85350ecd4 *man/summary.univariateTable.Rd 54ef61a13dde0da9c657f8d469da35c6 *man/sutable.Rd 546befe6a2000be4dcfb18d824c08f47 *man/table2x2.Rd 93c530f4c2cdcae12ba3773231422e39 *man/trace.Rd cca8325bea0c040f8b8ae93eab781ca7 *man/traceR.Rd 41f573ecfe07bf1b7799c0b53a5d16a8 *man/univariateTable.Rd 289c22353b7d042f894f6ce939ad94b3 *tests/testthat.R 4800ac0c12a9c5425cff0f48dd20281c *tests/testthat/test-publish-mi.R f6c64ad6e2980547a6cd8a42f1fcc2dc *tests/testthat/test-publish.R f5fd4a5afde5af04b418262190a5b41c *tests/testthat/test-regressionTable.R d55c5e1feceae482d221cab6a98315d8 *tests/testthat/test-univariateTable.R Publish/R/0000755000176200001440000000000015040356425012065 5ustar liggesusersPublish/R/publish.subgroupAnalysis.R0000644000176200001440000000014514142666146017235 0ustar liggesusers##' @export publish.subgroupAnalysis <- function(object,...){ publish(summary(object,...),...) } Publish/R/univariateTable.R0000755000176200001440000005124214346334424015341 0ustar liggesusers##' Categorical variables are summarized using counts and frequencies and compared . ##' ##' This function can generate the baseline demographic characteristics ##' that forms table 1 in many publications. It is also useful for generating ##' other tables of univariate statistics. ##' ##' The result of the function is an object (list) which containe the various data ##' generated. In most applications the \code{summary} function should be applied which generates ##' a data.frame with a (nearly) publication ready table. Standard manipulation can be ##' used to modify, add or remove columns/rows and for users not accustomed to R the table ##' generated can be exported to a text file which can be read by other software, e.g., via ##' write.csv(table,file="path/to/results/table.csv") ##' ##' By default, continuous variables are summarized by means and standard deviations ##' and compared with t-tests. When continuous variables are summarized by medians ##' and interquartile ranges the ##' Deviations from the above defaults are obtained when the ##' arguments summary.format and freq.format are combined with suitable ##' summary functions. ##' ##' @title Univariate table ##' @aliases utable univariateTable ##' @param formula Formula specifying the grouping variable (strata) ##' on the left hand side (can be omitted) and on the right hand side ##' the variables for which to obtain (descriptive) statistics. ##' @param data Data set in which formula is evaluated ##' @param summary.format Format for the numeric (non-factor) ##' variables. Default is mean (SD). If different formats are ##' desired, either special Q can be used or the function is called ##' multiple times and the results are rbinded. See examples. ##' @param Q.format Format for quantile summary of numerical ##' variables: Default is median (inter quartile range). ##' @param freq.format Format for categorical variables. Default is ##' count (percentage). ##' @param column.percent Logical, if \code{TRUE} and the default ##' freq.format is used then column percentages are given instead of ##' row percentages for categorical variables (factors). ##' @param digits Number of digits ##' @param big.mark For formatting large numbers (i.e., greater than 1,000). \code{""} turn this off. ##' @param short.groupnames If \code{TRUE} group names are abbreviated. ##' @param compare.groups Method used to compare groups. If ##' \code{"logistic"} and there are exactly two groups logistic ##' regression is used instead of t-tests and Wilcoxon rank tests to ##' compare numeric variables across groups. ##' @param show.totals If \code{TRUE} show a column with totals. ##' @param n If \code{TRUE} show the number of subjects as a separate ##' row. If equal to \code{"inNames"}, show the numbers in ##' parentheses in the column names. If \code{FALSE} do not show ##' number of subjects. ##' @param outcome Outcome data used to calculate p-values when ##' compare groups method is \code{'logistic'} or \code{'cox'}. ##' @param ... saved as part of the result to be passed on to ##' \code{labelUnits} ##' @return List with one summary table element for each variable on the right hand side of formula. ##' The summary tables can be combined with \code{rbind}. The function \code{summary.univariateTable} ##' combines the tables, and shows p-values in custom format. ##' @author Thomas A. Gerds ##' @seealso summary.univariateTable, publish.univariateTable ##' @examples ##' data(Diabetes) ##' library(data.table) ##' univariateTable(~age,data=Diabetes) ##' univariateTable(~gender,data=Diabetes) ##' univariateTable(~age+gender+ height+weight,data=Diabetes) ##' ## same thing but less typing ##' utable(~age+gender+ height+weight,data=Diabetes) ##' ##' ## summary by location: ##' univariateTable(location~Q(age)+gender+height+weight,data=Diabetes) ##' ## continuous variables marked with Q() are (by default) summarized ##' ## with median (IQR) and kruskal.test (with two groups equivalent to wilcox.test) ##' ## variables not marked with Q() are (by default) summarized ##' ## with mean (sd) and anova.glm(...,test="Chisq") ##' ## the p-value of anova(glm()) with only two groups is similar ##' ## but not exactly equal to that of a t.test ##' ## categorical variables are (by default) summarized by count ##' ## (percent) and chi-square tests (\code{chisq.test}). When \code{compare.groups ='logistic'} ##' ## anova(glm(...,family=binomial,test="Chisq")) is used to calculate p-values. ##' ##' ## export result to csv ##' table1 = summary(univariateTable(location~age+gender+height+weight,data=Diabetes), ##' show.pvalues=FALSE) ##' # write.csv(table1,file="~/table1.csv",rownames=FALSE) ##' ##' ## change labels and values ##' utable(location~age+gender+height+weight,data=Diabetes, ##' age="Age (years)",gender="Sex", ##' gender.female="Female", ##' gender.male="Male", ##' height="Body height (inches)", ##' weight="Body weight (pounds)") ##' ##' ## Use quantiles and rank tests for some variables and mean and standard deviation for others ##' univariateTable(gender~Q(age)+location+Q(BMI)+height+weight, ##' data=Diabetes) ##' ##' ## Factor with more than 2 levels ##' Diabetes$AgeGroups <- cut(Diabetes$age, ##' c(19,29,39,49,59,69,92), ##' include.lowest=TRUE) ##' univariateTable(location~AgeGroups+gender+height+weight, ##' data=Diabetes) ##' ##' ## Row percent ##' univariateTable(location~gender+age+AgeGroups, ##' data=Diabetes, ##' column.percent=FALSE) ##' ##' ## change of frequency format ##' univariateTable(location~gender+age+AgeGroups, ##' data=Diabetes, ##' column.percent=FALSE, ##' freq.format="percent(x) (n=count(x))") ##' ##' ## changing Labels ##' u <- univariateTable(location~gender+AgeGroups+ height + weight, ##' data=Diabetes, ##' column.percent=TRUE, ##' freq.format="count(x) (percent(x))") ##' summary(u,"AgeGroups"="Age (years)","height"="Height (inches)") ##' ##' ## more than two groups ##' Diabetes$frame=factor(Diabetes$frame,levels=c("small","medium","large")) ##' univariateTable(frame~gender+BMI+age,data=Diabetes) ##' ##' Diabetes$sex=as.numeric(Diabetes$gender) ##' univariateTable(frame~sex+gender+BMI+age, ##' data=Diabetes,freq.format="count(x) (percent(x))") ##' ##' ## multiple summary formats ##' ## suppose we want for some reason mean (range) for age ##' ## and median (range) for BMI. ##' ## method 1: ##' univariateTable(frame~Q(age)+BMI, ##' data=Diabetes, ##' Q.format="mean(x) (range(x))", ##' summary.format="median(x) (range(x))") ##' ## method 2: ##' u1 <- summary(univariateTable(frame~age, ##' data=na.omit(Diabetes), ##' summary.format="mean(x) (range(x))")) ##' u2 <- summary(univariateTable(frame~BMI, ##' data=na.omit(Diabetes), ##' summary.format="median(x) (range(x))")) ##' publish(rbind(u1,u2),digits=2) ##' ##' ## Large number format (big.mark) ##' n=100000 ##' dat=data.frame(id=1:n,z=rbinom(n,1,.3),x=factor(sample(1:8,size=n,replace=TRUE))) ##' u3 <- summary(univariateTable(z~x, ##' data=dat,big.mark=",")) ##' u3 ##' ##' @export univariateTable <- function(formula, data=parent.frame(), summary.format="mean(x) (sd(x))", Q.format="median(x) [iqr(x)]", freq.format="count(x) (percent(x))", column.percent=TRUE, digits=c(1,1,3), big.mark=",", short.groupnames, compare.groups=TRUE, show.totals=TRUE, n="inNames", outcome=NULL, ...){ if (length(digits)<3) digits <- rep(digits,3) if (!is.numeric(digits.summary <- digits[[1]])) digits.summary <- 1 if (!is.numeric(digits.freq <- digits[[2]])) digits.freq <- 1 if (!is.numeric(pvalue.digits <- digits[[3]])) pvalue.digits <- 3 call <- match.call() # {{{ parse formula and find data oldnaaction <- options()$na.action options(na.action="na.pass") FRAME <- specialFrame(formula, data, specials.design=FALSE, unspecials.design=FALSE, specials=c("F","S","Q","strata","Strata","factor","Factor","Cont","nonpar"), specials.factor = FALSE, strip.specials=c("F","S","Q"), strip.arguments=list("S"="format"), strip.alias=list("F"=c("strata","factor","Strata","Factor"),"S"="Cont","Q"="nonpar"), na.action="na.pass") options(na.action=oldnaaction) # }}} # {{{ extract grouping variable if (is.null(FRAME$response)){ groupvar <- NULL groupname <- NULL grouplabels <- NULL groups <- NULL n.groups <- NROW(data) } else{ mr <- FRAME$response if(NCOL(mr)!=1) stop("Can only handle univariate outcome") groupname <- colnames(mr) groupvar <- as.character(FRAME$response[,1,drop=TRUE]) mr <- FRAME$response[,1,drop=TRUE] ## deal with missing values in group variable if (is.factor(mr)){ if (any(is.na(groupvar))){ groupvar[is.na(groupvar)] <- "Missing" groups <- c(levels(mr),"Missing") }else{ groups <- levels(mr) } } else { if (any(is.na(groupvar))){ groupvar[is.na(groupvar)] <- "Missing" } groups <- unique(groupvar) } groupvar <- factor(groupvar,levels=groups) n.groups <- table(groupvar) n.groups <- c(n.groups,sum(n.groups)) if (compare.groups=="logistic" & (length(groups)!=2)) stop("compare.groups can only be equal to 'logistic' when there are exactly two groups. You have ",length(groups)," groups") ## if (length(groups)>30) stop("More than 30 groups") if (missing(short.groupnames)){ if(all(nchar(groups)<2) || all(groups %in% c(TRUE,FALSE))) short.groupnames <- FALSE else short.groupnames <- TRUE } if (short.groupnames==TRUE) grouplabels <- groups else grouplabels <- paste(groupname,"=",groups) } # }}} # {{{ classify variables into continuous numerics and grouping factors automatrix <- FRAME$design continuous.matrix <- NULL factor.matrix <- NULL auto.type <- sapply(1:NCOL(automatrix),function(i){ x <- automatrix[,i] # type 0=other coerced to numeric # 1=factor # 2=numeric # 3=character ## set some useful default type.i <- is.factor(x)+2*is.numeric(x)+3*is.logical(x)+4*is.character(x) # treat character and logical as factors if (type.i %in% c(3,4)) type.i <- 1 # treat other variables as numeric (e.g. difftime) if (type.i==0) type.i <- 2 # force variables with less than 3 distinct values to be categorical (factors) if (length(unique(x))<3) type.i <- 1 type.i}) if (any(auto.type==2)){ if (is.null(FRAME$S)) continuous.matrix <- automatrix[,auto.type==2,drop=FALSE] else continuous.matrix <- cbind(FRAME$S,automatrix[,auto.type==2,drop=FALSE]) } if (any(auto.type==1)){ if (is.null(FRAME$F)) factor.matrix <- automatrix[,auto.type==1,drop=FALSE] else factor.matrix <- cbind(FRAME$F,automatrix[,auto.type==1,drop=FALSE]) } Q.matrix <- FRAME$Q NVARS <- NCOL(continuous.matrix)+ NCOL(continuous.matrix)+NCOL(factor.matrix)+ NCOL(Q.matrix) # }}} # {{{ summary numeric variables if (!is.null(continuous.matrix)){ # prepare format sumformat <- parseSummaryFormat(format=summary.format,digits=digits.summary) # get summary excluding missing in groups and in totals summaryNumeric <- getSummary(matrix=continuous.matrix, varnames=names(continuous.matrix), groupvar=groupvar, groups=groups, labels=grouplabels, stats=sumformat$stats, format=sumformat$format, digits=digits.summary,big.mark=big.mark) } else{ sumformat <- NULL summaryNumeric <- NULL } if (!is.null(Q.matrix)){ # prepare format Qformat <- parseSummaryFormat(format=Q.format,digits=digits.summary) # get summary excluding missing in groups and in totals qNumeric <- getSummary(matrix=Q.matrix, varnames=names(Q.matrix), groupvar=groupvar, groups=groups, labels=grouplabels, stats=Qformat$stats, format=Qformat$format,digits=digits.summary,big.mark=big.mark) } else{ Qformat <- NULL qNumeric <- NULL } # }}} # {{{ categorical variables (factors) if (!is.null(factor.matrix)){ if (column.percent==TRUE){ freq.format <- sub("percent","colpercent",freq.format) freq.format <- sub("colcolpercent","colpercent",freq.format) } # prepare format freqformat <- parseFrequencyFormat(format=freq.format,digits=digits.freq) # get frequencies excluding missing in groups and in totals freqFactor <- getFrequency(matrix=factor.matrix, varnames=names(factor.matrix), groupvar=groupvar, groups=groups, labels=grouplabels, stats=freqformat$stats, format=freqformat$format,big.mark=big.mark,digits=digits.freq) } else{ freqformat <- NULL freqFactor <- NULL } # }}} # {{{ missing values mlist <- list(continuous.matrix,Q.matrix,factor.matrix) allmatrix <- do.call("cbind",mlist[!sapply(mlist,is.null)]) totals.missing <- lapply(allmatrix,function(v){sum(is.na(v))}) if (!is.null(groups)){ group.missing <- lapply(allmatrix,function(v){ lapply(groups,function(g){ sum(is.na(v[groupvar==g])) }) })} else { group.missing <- NULL } # }}} # {{{ p-values p.cont <- NULL p.Q <- NULL p.freq <- NULL if (!is.null(groups) && (compare.groups!=FALSE)){ if (!is.null(continuous.matrix)){ p.cont <- sapply(names(continuous.matrix),function(v){ data.table::set(data,j=v,value=as.numeric(data[[v]])) switch(tolower(as.character(compare.groups[[1]])), "false"={NULL}, "logistic"={ ## logistic regression px <- anova(glm(update(formula,paste(".~",v)),data=data,family=binomial),test="Chisq")$"Pr(>Chi)"[2] px }, "cox"={ px <- anova(coxph(formula(paste("Surv(time,status)~",v)),data=cbind(outcome,data)))$"Pr(>|Chi|)"[2] px }, "true"={ ## glm fails when there are missing values ## in outcome, so we remove missing values fv <- formula(paste(v,"~",groupname)) vdata <- model.frame(fv,data,na.action=na.omit) px <- anova(glm(fv,data=vdata),test="Chisq")$"Pr(>Chi)"[2] px },NULL) }) } if (!is.null(Q.matrix)){ p.Q <- sapply(names(Q.matrix),function(v){ switch(tolower(as.character(compare.groups[[1]])), "false"={NULL}, "logistic"={ ## logistic regression ## glm fails when there are missing values ## in outcome, so we remove missing values fv <- formula(paste(v,"~",groupname)) vdata <- model.frame(fv,data,na.action=na.omit) px <- anova(glm(update(formula,paste(".~",v)),data=vdata,family=binomial),test="Chisq")$"Pr(>Chi)"[2] px }, "cox"={ px <- anova(coxph(formula(paste("Surv(time,status)~",v)),data=cbind(outcome,data)))$"Pr(>|Chi|)"[2] px }, "true"={ if (is.character(data[[groupname]])){ data[[paste0(groupname,"asfactor")]] <- factor(data[[groupname]]) px <- kruskal.test(formula(paste0(v,"~",groupname,"asfactor")),data=data)$p.value } else{ px <- kruskal.test(formula(paste(v,"~",groupname)),data=data)$p.value } px },NULL) }) } if (!is.null(factor.matrix)){ p.freq <- sapply(names(factor.matrix),function(v){ switch(tolower(as.character(compare.groups[[1]])), "false"={NULL}, "logistic"={ ## logistic regression fv <- formula(paste(v,"~",groupname)) vdata <- model.frame(fv,data,na.action=na.omit) px <- anova(glm(update(formula,paste(".~",v)),data=vdata,family=binomial),test="Chisq")$"Pr(>Chi)"[2] }, "cox"={ px <- anova(coxph(formula(paste("Surv(time,status)~",v)),data=cbind(outcome,data)))$"Pr(>|Chi|)"[2] px }, "true"={ fv <- factor.matrix[,v] tabx <- table(fv,groupvar) if (sum(tabx)==0) { px <- NA } else{ suppressWarnings(test <- chisq.test(tabx)) px <- test$p.value } ## FIXME: need to catch and pass the warnings ## test <- suppressWarnings(fisher.test(tabx)) ## if (any(test$expected < 5) && is.finite(test$parameter)) px },NULL) }) } } p.values <- c(p.cont,p.Q,p.freq) if (length(p.values)>0) if (is.null(p.values[[1]])) p.values <- NULL # }}} # {{{ output ## xlevels <- lapply(factor.matrix,function(x){ ## levels(as.factor(x,exclude=FALSE)) ## levels(as.factor(x)) ## }) vartypes <- rep(c("numeric","Q","factor"),c(length(names(continuous.matrix)),length(names(Q.matrix)),length(names(factor.matrix)))) names(vartypes) <- c(names(continuous.matrix),names(Q.matrix),names(factor.matrix)) out <- list(summary.groups=c(freqFactor$groupfreq,summaryNumeric$groupsummary,qNumeric$groupsummary), summary.totals=c(freqFactor$totals,summaryNumeric$totals,qNumeric$totals), missing=list(group=group.missing,totals=totals.missing), n.groups=n.groups, p.values=p.values, formula=formula, groups=grouplabels, vartype=vartypes, xlevels=freqFactor$xlevels, Q.format=Q.format, summary.format=summary.format, freq.format=freq.format, compare.groups=compare.groups, ## dots are passed to labelUnits without suitability checks show.totals=show.totals, n=n, big.mark=big.mark, labels=list(...)) class(out) <- "univariateTable" out # }}} } ## the name utable is more handy ##' @export utable utable <- univariateTable Publish/R/publish-package.R0000644000176200001440000001515715040353645015261 0ustar liggesusers#' A study was made of all 26 astronauts on the first eight space shuttle flights (Bungo et.al., 1985). #' On a voluntary basis 17 astronauts consumed large quantities of salt and fluid prior to landing as #' a countermeasure to space deconditioning, while nine did not. #' @name SpaceT #' @docType data #' @format A data frame with 52 observations on the following 4 variables: #' \describe{ #' \item{Status}{Factor with levels Post (after flight) and Pre (before flight)} #' \item{HR}{Supine heart rate(beats per minute)} #' \item{Treatment}{Countermeasure salt/fluid (1= yes, 0=no)} #' \item{ID}{Person id} #' } #' @references #' Altman, Practical statistics for medical research, Page 223, Ex. 9.1. #' Bungo et.al., 1985 #' @examples ##' data(SpaceT) NULL #' Diabetes data of Dr John Schorling #' #' These data are courtesy of Dr John Schorling, Department of Medicine, University of Virginia School of Medicine. #' The data consist of 19 variables on 403 subjects from 1046 subjects who were interviewed in a study to understand #' the prevalence of obesity, diabetes, and other cardiovascular risk factors in central Virginia for African Americans. #' According to Dr John Hong, Diabetes Mellitus Type II (adult onset diabetes) is associated most strongly with obesity. #' The waist/hip ratio may be a predictor in diabetes and heart disease. DM II is also agssociated with hypertension - #' they may both be part of "Syndrome X". The 403 subjects were the ones who were actually screened for diabetes. #' Glycosolated hemoglobin > 7.0 is usually taken as a positive diagnosis of diabetes. #' #' @name Diabetes #' @docType data #' @format A data frame with 205 observations on the following 12 variables. #' \describe{ #' \item{id}{subject id} #' \item{chol}{Total Cholesterol} #' \item{stab.glu}{Stabilized Glucose} #' \item{hdl}{High Density Lipoprotein} #' \item{ratio}{Cholesterol/HDL Ratio} #' \item{glyhb}{Glycosolated Hemoglobin} #' \item{location}{a factor with levels (Buckingham,Louisa)} #' \item{age}{age (years)} #' \item{gender}{male or female} #' \item{height}{height (inches)} #' \item{height.europe}{height (cm)} #' \item{weight}{weight (pounds)} #' \item{weight.europe}{weight (kg)} #' \item{frame}{a factor with levels (small,medium,large)} #' \item{bp.1s}{First Systolic Blood Pressure} #' \item{bp.1d}{First Diastolic Blood Pressure} #' \item{bp.2s}{Second Diastolic Blood Pressure} #' \item{bp.2d}{Second Diastolic Blood Pressure} #' \item{waist}{waist in inches} #' \item{hip}{hip in inches} #' \item{time.ppn}{Postprandial Time when Labs were Drawn in minutes} #' \item{AgeGroups}{Categorized age} #' \item{BMI}{Categorized BMI} #' } #' @references #' Willems JP, Saunders JT, DE Hunt, JB Schorling: Prevalence of coronary heart disease risk factors among rural blacks: A community-based study. Southern Medical Journal 90:814-820; 1997 #' Schorling JB, Roach J, Siegel M, Baturka N, Hunt DE, Guterbock TM, Stewart HL: A trial of church-based smoking cessation interventions for rural African Americans. Preventive Medicine 26:92-101; 1997. #' @keywords datasets ##' @examples ##' ##' data(Diabetes) ##' NULL #' trace data #' #' These data are from screening to the TRACE study, a comparison between the angiotensin converting #' enzyme inhibitor trandolapril and placebo ford large myocardial infarctions. A total of 6676 #' patients were screened for the study. Survival has been followed for the screened population for #' 16 years. The current data has been prepared for a poisson regression to examine survival. The data #' has been "split" in 0.5 year intervals (plitLexis function from Epi package) and then collapsed #' on all variables (aggregate function). #' @name trace #' @docType data #' @format A data frame with 1832 observations on the following 6 variables. #' \describe{ #' \item{Time}{Time after myocardial infarction, in 6 months intervals} #' \item{smoking}{Smoking status. A factor with levels (Never, Current, Previous)} #' \item{sex}{A factor with levels (Female, Male)} #' \item{age}{Age in years at the time of myocardial infarction} #' \item{ObsTime}{Cumulative risk time in each split} #' \item{dead}{Count of deaths} #' } #' @references #' Kober et al 1995 Am. J. Cardiol 76,1-5 #' #' @keywords datasets ##' @examples ##' ##' data(trace) ##' Units(trace,list("age"="years")) ##' fit <- glm(dead ~ smoking+sex+age+Time+offset(log(ObsTime)), family="poisson",data=trace) ##' rtf <- regressionTable(fit,factor.reference = "inline") ##' summary(rtf) ##' publish(fit) ##' NULL #' CiTable data #' #' These data are used for testing Publish package functionality. #' @name CiTable #' @docType data #' @format A data frame with 27 observations on the following 9 variables. #' \describe{ #' \item{Drug}{} #' \item{Time}{} #' \item{Drug.Time}{} #' \item{Dose}{} #' \item{Mean}{} #' \item{SD}{} #' \item{n}{} #' \item{HazardRatio}{} #' \item{lower}{} #' \item{upper}{} #' \item{p}{} #' } #' #' @keywords datasets ##' @examples ##' ##' data(CiTable) ##' labellist <- split(CiTable[,c("Dose","Mean","SD","n")],CiTable[,"Drug"]) ##' labellist ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], labels=labellist) ##' ##' NULL #' Publish package #' #' This package processes results of descriptive statistcs and regression analysis into final tables and figures of a manuscript #' @keywords internal #' @name Publish-package #' @importFrom data.table as.data.table copy data.table is.data.table melt rbindlist setnames setorder setcolorder setkey ":=" ".N" ".SD" "_PACKAGE" #' traceR data #' #' These data are from the TRACE randomised trial, a comparison between the angiotensin converting #' enzyme inhibitor trandolapril and placebo ford large myocardial infarctions. In all, 1749 patients #' were randomised. The current data are from a 15 year follow-up. #' @name traceR #' @docType data #' @format A data frame with 1749 observations on the following variables. #' \describe{ #' \item{weight}{Weight in kilo} #' \item{height}{Height in meters} #' \item{abdominalCircumference}{in centimeters} #' \item{seCreatinine}{in mmol per liter} #' \item{wallMotionIndex}{left ventricular function 0-2, 0 worst, 2 normal} #' \item{observationTime}{time to death or censor} #' \item{age}{age in years} #' \item{sex}{0=female,1=male} #' \item{smoking}{0=never,1=prior,2=current} #' \item{dead}{0=censor,1=dead} #' \item{treatment}{placebo or trandolapril} #' #' } #' @references #' Kober et al 1995 NEJM 333,1670 #' #' @keywords datasets ##' @examples ##' ##' data(trace) ##' Units(trace,list("age"="years")) ##' fit <- glm(dead ~ smoking+sex+age+Time+offset(log(ObsTime)), family="poisson",data=trace) ##' rtf <- regressionTable(fit,factor.reference = "inline") ##' summary(rtf) ##' publish(fit) ##' NULL Publish/R/publish.summary.aov.R0000755000176200001440000000332614142666146016153 0ustar liggesusers##' Format summary table of aov results ##' ##' Format summary table of aov results ##' @export ##' @param object glm object ##' @param print Logical. Decide about whether or not to print the results. ##' @param handler see \code{pubformat} ##' @param digits see \code{pubformat} ##' @param nsmall see \code{pubformat} ##' @param ... used to transport further arguments ##' @examples ##' ##' data(Diabetes) ##' f <- glm(bp.1s~age+chol+gender+location,data=Diabetes) ##' publish(summary(aov(f)),digits=c(1,2)) ##' publish.summary.aov <- function(object, print=TRUE, handler="sprintf", digits=c(2,4), nsmall=digits, ...){ y <- object[[1]] if (length(digits)==1) digits <- rep(digits,2) pvalue.defaults <- list(digits=digits[[2]],eps=10^{-digits[[2]]},stars=FALSE) smartF <- prodlim::SmartControl(call=list(...), keys=c("pvalue"), ignore=c("object","print","handler","digits","nsmall"), defaults=list("pvalue"=pvalue.defaults), forced=list("pvalue"=list(y$"Pr(>F)")), verbose=FALSE) yy <- cbind(Df=y$Df, "F statistic"= pubformat(y$"F value",handler=handler,digits=digits[[1]],nsmall=nsmall[[1]]), "p-value"=do.call("format.pval",smartF$pvalue)) rownames(yy) <- rownames(object[[1]]) ## remove residual line yy <- yy[-NROW(yy),,drop=FALSE] if (print) publish(yy,rownames=TRUE,colnames=TRUE,col1name="Factor",...) invisible(yy) } Publish/R/Spaghettiogram.R0000644000176200001440000001565114142666146015204 0ustar liggesusers# {{{ header ##' A spaghettiogram is showing repeated measures (longitudinal data) ##' ##' ##' @title Spaghettiogram ##' @aliases spaghettiogram Spaghettiogram ##' @param formula A formula which specifies the variables for the ##' spaghettiograms. If Y ~ X + id(Z) then for each value of Z the ##' spaghettiogram is the graph (X,Y) in the subset defined by the ##' value of Z. Data are expected to be in the "long" format. Y is ##' a numeric vector and X is a factor whose levels define the X-axis. ##' Each level of the id-vector corresponds to ##' one line (spaghetti) in the plot. ##' ##' @param data data set in which variables X, Y and Z are defined. ##' @param xlim Limits for x-axis ##' @param ylim Limits for y-axis ##' @param xlab Label for x-axis ##' @param ylab Label for x-axis ##' @param axes Logical indicating if axes should be drawn. ##' @param col Colors for the spaghettiograms ##' @param lwd Widths for the spaghettiograms ##' @param lty Type for the spaghettiograms ##' @param pch Point-type for the spaghettiograms ##' @param legend If \code{TRUE} add a legend. Argument A of legend is ##' controlled as legend.A. E.g., when \code{legend.cex=2} legend will ##' be called with argument cex=2. ##' @param add If \code{TRUE} add to existing plot device. ##' @param background Control the background color of the graph. ##' @param ... used to transport arguments which are passed to the ##' following subroutines: \code{"plot"}, \code{"lines"}, ##' \code{"legend"}, \code{"background"}, \code{"axis1"}, ##' \code{"axis2"}. ##' @return List with data of each subject ##' @examples ##' ##' data(SpaceT) ##' Spaghettiogram(HR~Status+id(ID), ##' data=SpaceT) ##' @export spaghettiogram <- function(formula, data, xlim, ylim, xlab="", ylab="", axes=TRUE, col, lwd, lty, pch, legend=FALSE, add=FALSE, background=TRUE, ...){ # {{{ read formula and split data cl <- match.call(expand.dots=TRUE) sf <- specialFrame(formula, data, unspecials.design=FALSE, specials=c("id"), strip.specials=c("id"), specials.factor=TRUE, specials.design=FALSE, drop.intercept=TRUE) ## sf <- specialFrame(cl, ## special="id", ## specials.factor=TRUE, ## drop.intercept=TRUE) ## if (NCOL(X)!=1||NCOL(Y)!=1||NCOL(Y)!=1) stop("Can only handle one x-variable, one y-variable and one z-variable, formula must have the form: y~ x + id(z) where\ny is a measurement\nx tells when the measurement was taken\nand z identifies repeated measurements of the same subject. ") X <- sf$design[[1]] Y <- sf$response[[1]] if (missing(ylab)) ylab <- names(sf$response)[1] Z <- sf$id[[1]] if (!is.numeric(Y)) { if (is.factor(Y)){ ylevs <- levels(Y) Y <- as.numeric(Y) } else{ Y <- factor(Y) ylevs <- levels(Y) Y <- as.numeric(Y) } }else{ ylevs <- NULL } if (is.numeric(X)){ xat <- sort(unique(X)) xlevs <- as.character(xat) }else{ if (!is.factor(X)) X <- factor(X) xlevs <- levels(X) ## now values are 1= xlev[1], 2= xlev[2], etc. X <- as.numeric(X) xat <- sort(unique(X)) } XY <- data.frame(cbind(X=X,Y=Y)) ## names(XY) <- c("X","Y") object <- split(XY,Z) # }}} # {{{ resolve line type and color nlines <- length(object) if (missing(xlim)) xlim <- range(xat) if (missing(ylim)) ylim <- range(Y) if (missing(lwd)) lwd <- rep(3,nlines) if (missing(col)) col <- 1:nlines if (missing(lty)) lty <- rep(1, nlines) if (missing(pch)) pch <- rep(1, nlines) if (length(lwd) < nlines) lwd <- rep(lwd, nlines) if (length(lty) < nlines) lty <- rep(lty, nlines) if (length(col) < nlines) col <- rep(col, nlines) if (length(pch) < nlines) pch <- rep(pch, nlines) # }}} # {{{ processing graphical arguments axis1.DefaultArgs <- list(side=1,las=1,at=xat,lab=xlevs) axis2.DefaultArgs <- list(side=2,las=2) background.DefaultArgs <- list(bg="white") lines.DefaultArgs <- list(type="b",cex=1.3) ## text.DefaultArgs <- list(cex=1.4,x=xlim[1],y=ylim[2],pos=3,offset=2,xpd=NA) ## mtext.DefaultArgs <- list(cex=1.4,xpd=NA,text="",line=2,cex=2,las=1) plot.DefaultArgs <- list(x=0,y=0,type = "n",ylim = ylim,xlim = xlim,xlab = xlab,ylab = ylab) legend.DefaultArgs <- list(legend=names(object),title=names(sf$id),lwd=2,col=col,lty=lty,cex=1.5,bty="n",y.intersp=1.3,x="topright") smartA <- prodlim::SmartControl(call= list(...), keys=c("plot","lines","legend","background","axis1","axis2"), ignore=c("formula","data","add","col","lty","lwd","ylim","xlim","xlab","ylab","legend","axes","background"), defaults=list("plot"=plot.DefaultArgs,"lines"=lines.DefaultArgs,"legend"=legend.DefaultArgs,"background"=background.DefaultArgs,"axis1"=axis1.DefaultArgs,"axis2"=axis2.DefaultArgs), forced=list("plot"=list(axes=FALSE),"axis1"=list(side=1)), verbose=TRUE) # }}} # {{{ empty plot, background if (add==FALSE){ do.call("plot",smartA$plot) if (background) do.call(prodlim::backGround,smartA$background) } # }}} # {{{ axes if (!add) { if (axes){ do.call("axis",smartA$axis1) do.call("axis",smartA$axis2) } } # }}} # {{{ text ## if (text) do.call("text",smartA$text) # }}} # {{{ mtext ## do.call("mtext",smartA$mtext) # }}} # {{{ legend if (legend) do.call("legend",smartA$legend) # }}} # {{{ adding spaghetti's nix <- sapply(1:length(object),function(i){ a=object[[i]] data.table::setDT(a) setkey(a,X) a <- na.omit(a) do.call("lines",c(list(x=a[["X"]], y=a[["Y"]], pch=pch[i], col=col[i], lty=lty[i], lwd=lwd[i]),smartA$lines)) do.call("lines", c(list(x=a[["X"]], y=a[["Y"]], pch=pch[i], col=col[i], lty=lty[i], lwd=lwd[i]), replace(smartA$lines,"type","l"))) }) # }}} invisible(object) } ##' @export Spaghettiogram <- spaghettiogram Publish/R/regressionTable.R0000644000176200001440000004606415040353303015342 0ustar liggesusers##' Tabulate the results of a regression analysis. ##' ##' The basic use of this function is to generate a near publication worthy table from a regression ##' object. As with summary(object) reference levels of factor variables are not included. Expansion ##' of the table with such values can be performed using the "fixRegressionTable" function. Forest ##' plot can be added to the output with "plotRegressionTable". ##' ##' regressionTable produces an object (list) with the parameters deriveds. The summary function creates ##' a data frame which can be used as a (near) publication ready table. ##' ##' The table shows changes in mean for linear regression, odds ratios ##' for logistic regression (family = binomial) and hazard ratios for ##' Cox regression. ##' @title Regression table ##' @param object Fitted regression model obtained with \code{lm}, ##' \code{glm} or \code{coxph}. ##' @param param.method Method to obtain model coefficients. ##' @param confint.method Method to obtain confidence ##' intervals. Default is 'default' which leads to Wald ##' type intervals using the model based estimate of standard ##' error. 'profile' yields profile likelihood confidence ##' intervals, available from library MASS for \code{lm} and ##' \code{glm} objects. 'robust' uses the sandwich form ##' standard error to construct Wald type intervals (see ##' \code{lava::estimate.default}). 'simultaneous' calls ##' \code{multcomp::glht} to obtain simultaneous confidence ##' intervals. ##' @param pvalue.method Method to obtain p-values. If ##' \code{'default'} show raw p-values. If \code{'robust'} use ##' p-value corresponding to robust standard error as provided by ##' \code{lava::estimate.default}. If \code{'simultaneous'} call ##' \code{multcomp::glht} to obtain p-values. ##' @param factor.reference Style for showing results for categorical ##' variables. If \code{'extraline'} show an additional line for ##' the reference category. If \code{'inline'} display as level ##' vs. reference. ##' @param intercept Logical. If \code{FALSE} suppress intercept. ##' @param units List of units for continuous variables. See examples. ##' @param noterms Position of terms that should be ignored. E.g., for ##' a Cox model with a cluster(id) term, there will be no hazard ##' ratio for variable id. ##' @param probindex Logical. If \code{TRUE} show coefficients on probabilistic index scale instead of hazard ratio scale. ##' @param ... Not yet used ##' @return List of regression blocks ##' @examples ##' # linear regression ##' data(Diabetes) ##' f1 <- glm(bp.1s~age+gender+frame+chol,data=Diabetes) ##' summary(regressionTable(f1)) ##' summary(regressionTable(f1,units=list("chol"="mmol/L","age"="years"))) ##' ## with interaction ##' f2 <- glm(bp.1s~age*gender+frame+chol,data=Diabetes) ##' summary(regressionTable(f2)) ##' #Add reference values ##' summary(regressionTable(f2)) ##' f3 <- glm(bp.1s~age+gender*frame+chol,data=Diabetes) ##' publish(f3) ##' regressionTable(f3) ##' ##' # logistic regression ##' Diabetes$hyp1 <- factor(1*(Diabetes$bp.1s>140)) ##' l1 <- glm(hyp1~age+gender+frame+chol,data=Diabetes,family="binomial") ##' regressionTable(l1) ##' publish(l1) ##' plot(regressionTable(l1)) ##' ##' ## with interaction ##' l2 <- glm(hyp1~age+gender+frame*chol,data=Diabetes,family="binomial") ##' regressionTable(l2) ##' l3 <- glm(hyp1~age*gender+frame*chol,data=Diabetes,family="binomial") ##' regressionTable(l3) ##' ##' # Cox regression ##' library(survival) ##' data(pbc) ##' pbc$edema <- factor(pbc$edema,levels=c("0","0.5","1"),labels=c("0","0.5","1")) ##' c1 <- coxph(Surv(time,status!=0)~log(bili)+age+protime+sex+edema,data=pbc) ##' regressionTable(c1) ##' # with interaction ##' c2 <- coxph(Surv(time,status!=0)~log(bili)+age+protime*sex+edema,data=pbc) ##' regressionTable(c2) ##' c3 <- coxph(Surv(time,status!=0)~edema*log(bili)+age+protime+sex+edema+edema:sex,data=pbc) ##' regressionTable(c3) ##' ##' ##' if (requireNamespace("nlme",quietly=TRUE)){ ##' ## gls regression ##' library(lava) ##' library(nlme) ##' m <- lvm(Y ~ X1 + gender + group + Interaction) ##' distribution(m, ~gender) <- binomial.lvm() ##' distribution(m, ~group) <- binomial.lvm(size = 2) ##' constrain(m, Interaction ~ gender + group) <- function(x){x[,1]*x[,2]} ##' d <- sim(m, 1e2) ##' d$gender <- factor(d$gender, labels = letters[1:2]) ##' d$group <- factor(d$group) ##' ##' e.gls <- gls(Y ~ X1 + gender*group, data = d, ##' weights = varIdent(form = ~1|group)) ##' regressionTable(e.gls) ##' summary(regressionTable(e.gls)) ##' } ##' @export ##' @author Thomas A. Gerds regressionTable <- function(object, param.method="coef", confint.method=c("default","profile","robust","simultaneous"), pvalue.method=c("default","robust","simultaneous"), factor.reference="extraline", intercept=0L, units=NULL, noterms=NULL, probindex=0L, ...){ # {{{ model type if("lme" %in% class(object)){ confint.lme <- function(object, parm, level = 0.95, ...){ res <- nlme::intervals(object, level = level, ...) out <- cbind(res$fixed[,"lower"],res$fixed[,"upper"]) colnames(out) <- c("2.5 %","97.5 %") return(out) } param.method <- "fixef" if(confint.method[1] == "default"){ confint.method <- "profile" } } if (is.character(object$family)){ logisticRegression <- (object$family=="binomial") poissonRegression <- (object$family=="poisson") } else{ logisticRegression <- (!is.null(object$family$family) && object$family$family=="binomial") poissonRegression <- (!is.null(object$family$family) && object$family$family=="poisson") } coxRegression <- any(match(class(object),c("coxph","cph"),nomatch=0)) # }}} # {{{ intercept if (any(c("lm","gls") %in% class(object))) if (names(coef(object))[1]!="(Intercept)") stop("This function works only for models that have an Intercept.\nI.e., you should reformulate without the `~-1' term.") # }}} # {{{ parse terms formula <- try(formula(object), silent = TRUE) if("formula" %in% class(formula) == FALSE){ if (!is.null(object$formula)){ formula <- object$formula }else if (is.null(object$terms)){ if (class(object$call$formula)[[1]]=="name"){ stop("Cannot extract the formula from object") } else{ formula <- object$call$formula } } } if (is.null(data <- object$model)){ if (is.null(object$data)) data <- eval(object$call$data,envir=parent.frame()) else data <- object$data } if (is.null(units)) units <- attr(data,"units") else{ units <- c(units,attr(data,"units")) units <- units[unique(names(units))] } terms <- terms(formula) termlabels <- attr(terms,"term.labels") termorder <- attr(terms,"order") if (length(noterms)>0 & all(noterms>0)){ termlabels <- termlabels[-noterms] termorder <- termorder[-noterms] } terms1 <- termlabels[termorder==1] ## remove strata terms if (any(class(object) %in% c("coxph")) && length(strata.pos <- grep("^strata\\(",terms1))>0){ terms1 <- terms1[-strata.pos] } # }}} # {{{ types of variables/terms coef <- do.call(param.method, args = list(object)) termnames <- names(coef) if("xlevels" %in% names(object)){ factorlevels <- object$xlevels }else if("contrasts" %in% names(object)){ # for gls factorlevels <- lapply(object$contrasts, rownames) }else{ factorlevels <- NULL } ## for some reason logical value variables, ie with levels ## TRUE, FALSE do not get xlevels in the output of glm islogical <- grep("TRUE$",termnames,value=TRUE) if (length(islogical)>0){ logicalnames <- lapply(islogical,function(l){ substring(l,1,nchar(l)-4) }) names(logicalnames) <- logicalnames factorlevels <- c(factorlevels, lapply(logicalnames,function(l){c("FALSE","TRUE")})) } factornames <- names(factorlevels) ## for some reason ordinal variables get strange labels isordered <- sapply(factornames,function(x){length(grep(paste0(x,".L"),termnames,fixed=TRUE,value=FALSE))>0}) if (length(isordered)>0){ orderednames <- factornames[isordered] }else{ orderednames <- "" } # }}} # {{{ interactions terms2 <- parseInteractionTerms(terms,factorlevels) ## remove these variabeles from terms1 because main effects have no interpretation ## when there interactions terms1 <- setdiff(terms1,unlist(lapply(terms2,attr,"variables"))) vars2 <- unique(unlist(lapply(terms2,function(x)attr(x,"variables")))) if (length(isordered)>0 && length(terms2)>0 && any(hit <- match(vars2,sapply(isordered,function(x)substr(x,0,nchar(x)-2)),nomatch=0))) stop(paste0("Cannot (not yet) handle interaction terms which involve ordered factors.\nOffending term(s): ", sapply(isordered,function(x)substr(x,0,nchar(x)-2))[hit])) # }}} # {{{ confidence intervals confint.method <- match.arg(confint.method, choices=c("default","profile","robust","simultaneous"), several.ok=FALSE) if (confint.method=="robust") { lava.mat <- lava::estimate(object,robust=TRUE)$coefmat } if (is.function(confint.method)){ ci <- do.call(confint.method,list(object)) }else{ ci <- switch(confint.method, "default"={stats::confint.default(object)}, "profile"={ ## FIXME: what happens if profile method does not exist for this object? suppressMessages(confint(object))}, "robust"={ pvalue.method <- "robust" lava.mat[,c("2.5%","97.5%"),drop=FALSE]}, "simultaneous"={ pvalue.method <- "simultaneous" confint(multcomp::glht(object))$confint[,c("lwr","upr"),drop=FALSE] }, stop(paste("Sorry, don't know this confidence interval method:",confint.method))) } # }}} # {{{ p-values if (is.function(pvalue.method)){ pval <- do.call(pvalue.method,list(object)) }else{ pvalue.method <- match.arg(pvalue.method, choices=c("default","robust","simultaneous"), several.ok=FALSE) pval <- switch(pvalue.method, "default"={ sumcoef <- coef(summary(object)) sumcoef[,NCOL(sumcoef),drop=FALSE] }, ## "lrt"={ ## drop1(object,test="Chisq")[,"Pr(>Chi)",drop=TRUE] ## }, "robust"={ lava.mat[,c("P-value"),drop=FALSE] }, "simultaneous"={ summary(multcomp::glht(object))[,c("Pr(>|z|"),drop=TRUE] },stop(paste("Sorry, don't know this pvalue method:",pvalue.method))) } ## omnibus <- drop1(object,test="Chisq")[,"Pr(>Chi)",drop=TRUE] # }}} # {{{intercept if (intercept!=0){ terms1 <- c("(Intercept)",terms1) } # }}} # {{{ blocks level 1 ## reference.value <- ifelse((logisticRegression+coxRegression==0),0,1) reference.value <- 0 blocks1 <- lapply(terms1,function(vn){ isfactor <- match(vn,factornames,nomatch=0) isordered <- match(vn,orderednames,nomatch=0) ## catch the coefficients corresponding to term vn candidates <- grep(vn,termnames,fixed=TRUE,value=TRUE) # {{{ missing values ## number of missing values misscall <- paste0("sum(is.na(",vn,"))") if (vn=="Intercept"||vn=="(Intercept)") Missing <- "" else Missing <- try(eval(parse(text=misscall),data),silent=TRUE) if (class(Missing)[1]=="try-error") Missing <- NA # }}} if (isfactor){ vn.levels <- factorlevels[[isfactor]][-1] if (isordered){ suffix <- c(".L",".Q",".C",paste0("^",4:30))[1:length(vn.levels)] vn.regexp <- paste0(vn,suffix) parms <- termnames[match(vn.regexp,termnames,nomatch=0)] if(length(parms)!=length(vn.levels)) stop(paste0("Cannot identify terms corresponding to variable ",vn,".")) }else{ vn.regexp <- paste0(vn,vn.levels,sep="") parms <- termnames[match(vn.regexp,termnames,nomatch=0)] if (length(parms)!=length(vn.levels)){ vn.regexp <- paste0(vn,vn.levels,sep=":") parms <- termnames[match(vn.regexp,termnames,nomatch=0)] } if (length(parms)!=length(vn.levels)){ vn.regexp <- paste0(vn,vn.levels,sep=".") parms <- termnames[match(vn.regexp,termnames,nomatch=0)] } if (length(parms)!=length(vn.levels)) stop(paste0("Cannot identify terms corresponding to variable ",vn,".")) ## vn.regexp <- paste("^",vn,levs.regexp,"$","|","I\\(",vn,".*",levs.regexp,"|",vn,"\\)",".*",levs.regexp,sep="") } } else{ ## continuous variables may be enclosed by \log or \sqrt or similar ## protect special characters vn.protect <- sub("(","\\(",vn,fixed=TRUE) vn.protect <- sub(")","\\)",vn.protect,fixed=TRUE) vn.regexp <- paste("^",vn.protect,"$",sep="") parms <- grep(vn.regexp,termnames,fixed=FALSE) } coef.vn <- coef[parms] ci.vn <- ci[parms,,drop=FALSE] if (is.matrix(pval)){ p.vn <- pval[parms,,drop=TRUE] } else{ p.vn <- pval[parms] } # {{{ factor variables varname <- vn if (isfactor){ if (factor.reference=="inline"){ Variable <- c(vn,rep("",NROW(coef.vn)-1)) Units <- paste(factorlevels[[isfactor]][-1], "vs", factorlevels[[isfactor]][1]) Missing <- c(Missing,rep("",length(coef.vn)-1)) } else { Variable <- c(vn,rep("",length(coef.vn))) Units <- factorlevels[[isfactor]] Missing <- c(Missing,rep("",length(coef.vn))) coef.vn <- c(reference.value,coef.vn) ci.vn <- rbind(c(reference.value,reference.value),ci.vn) p.vn <- c(1,p.vn) } } else{ # }}} # {{{ numeric variables Variable <- vn if (!is.null(units[[varname]])) Units <- units[[varname]] else Units <- "" } block <- data.frame(Variable=Variable, Units=Units, Missing=as.character(Missing), Coefficient=coef.vn, Lower=ci.vn[,1], Upper=ci.vn[,2], Pvalue=as.vector(p.vn), stringsAsFactors=FALSE) if (any(class(object)%in%"MIresult")) colnames(block)[3] <- paste0("Imputed (",object$nimp,")") rownames(block) <- NULL block }) # }}} # }}} # {{{ blocks level 2 if (length(terms2)>0){ blocks2 <- lapply(terms2,function(t2){ vars <- attr(t2,"variables") # {{{ missing values ## number of missing values misscall <- paste0(paste0("sum(is.na(",vars,"))"),collapse="+") Missing <- try(eval(parse(text=misscall),data)) if (class(Missing)[1]=="try-error") Missing <- NA # }}} block <- try(data.frame(lava::estimate(object, f=function(p)lapply(t2,eval,envir=sys.parent(-1)), coef = coef, robust=confint.method=="robust")$coefmat), silent = TRUE) if(("try-error" %in% class(block)) == FALSE){ colnames(block) <- c("Coefficient","StandardError","Lower","Upper","Pvalue") block <- data.frame(Variable=attr(t2,"names"), Units="", Missing=Missing, block[,-2]) }else{ block <- data.frame(Variable=attr(t2,"names"), Units="", Missing=Missing, Coefficient=NA, Lower = NA, Upper = NA, Pvalue = NA) } rownames(block) <- NULL if (any("MIresult" %in% class(object))) colnames(block)[3] <- paste0("Imputed (",object$nimp,")") block }) names(blocks2) <- names(terms2) } # }}} # {{{ formatting names(blocks1) <- terms1 out <- blocks1 if (length(terms2)>0) out <- c(out,blocks2) if (logisticRegression) out <- lapply(out,function(x){ colnames(x) <- sub("Coefficient","OddsRatio",colnames(x)) x$OddsRatio <- exp(x$OddsRatio) x$Lower <- exp(x$Lower) x$Upper <- exp(x$Upper) x }) if (coxRegression | poissonRegression) out <- lapply(out,function(x){ if (probindex){ colnames(x) <- sub("Coefficient","ProbIndex",colnames(x)) x$ProbIndex <- 100/(1+exp(x$ProbIndex)) tmp <- 100/(1+exp(x$Upper)) x$Upper <- 100/(1+exp(x$Lower)) x$Lower <- tmp rm(tmp) x }else{ colnames(x) <- sub("Coefficient","HazardRatio",colnames(x)) x$HazardRatio <- exp(x$HazardRatio) x$Lower <- exp(x$Lower) x$Upper <- exp(x$Upper) x } }) attr(out,"terms1") <- terms1 attr(out,"terms2") <- terms2 attr(out,"factornames") <- factornames attr(out,"factor.reference") <- factor.reference attr(out,"orderednames") <- orderednames attr(out,"model") <- switch(as.character(logisticRegression+2*coxRegression+3*poissonRegression), "1"="Logistic regression", "2"="Cox regression", "3"="Poisson regression", "Linear regression") out <- out[] class(out) <- "regressionTable" out # }}} } Publish/R/publish.coxph.R0000755000176200001440000000723614142666146015017 0ustar liggesusers##' Tabulize the part of the result of a Cox regression analysis which is commonly shown in publications. ##' ##' Transforms the log hazard ratios to hazard ratios and returns them ##' with confidence limits and p-values. If explanatory variables are ##' log transformed or log2 transformed, a scaling factor is ##' multiplied to both the log-hazard ratio and its standard-error. ##' @title Tabulize hazard ratios with confidence intervals and ##' p-values. ##' @param object A \code{coxph} object. ##' @param confint.method See \code{regressionTable} ##' @param pvalue.method See \code{regressionTable} ##' @param print If \code{FALSE} do not print results. ##' @param factor.reference See \code{regressionTable} ##' @param units See \code{regressionTable} ##' @param probindex Logical. If \code{TRUE} show coefficients on probabilistic index scale instead of hazard ratio scale. ##' @param ... passed to \code{summary.regressionTable} and also to ##' \code{labelUnits}. ##' @return Table with hazard ratios, confidence intervals and ##' p-values. ##' @author Thomas Alexander Gerds ##' @examples ##' library(survival) ##' data(pbc) ##' pbc$edema <- factor(pbc$edema, ##' levels=c("0","0.5","1"), labels=c("0","0.5","1")) ##' fit = coxph(Surv(time,status!=0)~age+sex+edema+log(bili)+log(albumin), ##' data=na.omit(pbc)) ##' publish(fit) ##' ## forest plot ##' plot(publish(fit),cex=1.3) ##' ##' publish(fit,ci.digits=2,pvalue.eps=0.01,pvalue.digits=2,pvalue.stars=TRUE) ##' publish(fit,ci.digits=2,ci.handler="prettyNum",pvalue.eps=0.01, ##' pvalue.digits=2,pvalue.stars=TRUE) ##' publish(fit, ci.digits=2, ci.handler="sprintf", pvalue.eps=0.01, ##' pvalue.digits=2,pvalue.stars=TRUE, ci.trim=FALSE) ##' ##' fit2 = coxph(Surv(time,status!=0)~age+sex+edema+log(bili,base=2)+log(albumin)+log(protime), ##' data=na.omit(pbc)) ##' publish(fit2) ##' ##' # with cluster variable ##' fit3 = coxph(Surv(time,status!=0)~age+cluster(sex)+edema+log(bili,base=2) ##' +log(albumin)+log(protime), ##' data=na.omit(pbc)) ##' publish(fit3) ##' ##' # with strata and cluster variable ##' fit4 = coxph(Surv(time,status!=0)~age+cluster(sex)+strata(edema)+log(bili,base=2) ##' +log(albumin)+log(protime), ##' data=pbc) ##' publish(fit4) ##' ##' @export publish.coxph <- function(object, confint.method, pvalue.method, print=TRUE, factor.reference="extraline", units=NULL, probindex=FALSE, ...){ if (missing(confint.method)) confint.method="default" if (missing(pvalue.method)) pvalue.method=switch(confint.method, "robust"={"robust"}, "simultaneous"={"simultaneous"}, "default") spec <- attr(terms(object),"specials") cluster <- spec$cluster-1 strata <- spec$strata-1 # if (!is.null(cluster)) cluster <- cluster-1 rt <- regressionTable(object, noterms=c(cluster,strata), confint.method=confint.method, pvalue.method=pvalue.method, factor.reference=factor.reference, units=units, probindex=probindex) srt <- summary.regressionTable(rt, ## digits=digits, print=FALSE,...) if (print==TRUE) publish(srt$regressionTable,...) invisible(srt) } #---------------------------------------------------------------------- ### publish.coxph.R ends here Publish/R/plotConfidence.R0000644000176200001440000011640615040352654015154 0ustar liggesusers### plotConfidence.R --- #------- ## author: Thomas Alexander Gerds ## created: May 10 2015 (11:03) ## Version: ## last-updated: Jul 24 2025 (08:41) ## By: Thomas Alexander Gerds ## Update #: 563 #---------------------------------------------------------------------- ## ### Commentary: ## ### Change Log: #---------------------------------------------------------------------- ## ### Code: ##' Function to plot confidence intervals with their values and additional labels. ##' One anticipated use of this function involves first the generation of a regression object, ##' then arrangement of a result table with "regressionTable", further arrangment of table with ##' with e.g. "fixRegressionTable" and various user defined changes - and then finally table ##' along with forest plot using the current function. ##' ##' Function to plot means and other point estimates with confidence intervals, ##' their values and additional labels . ##' Horizonal margins as determined by par()$mar are ignored. ##' Instead layout is used to divide the plotting region horizontally ##' into two or three parts plus leftmargin and rightmargin. ##' ##' When values is FALSE there are only two parts. The default order is ##' labels on the left confidence intervals on the right. ##' When no labels are given or labels is FALSE there are only two parts. The default order is ##' confidence intervals on the left values on the right. ##' ##' The default order of three parts from left to right is ##' labels, confidence intervals, values. The order can be changed as shown ##' by the examples below. The relative widths of the two or three parts ##' need to be adapted to the actual size of the text of the labels. This ##' depends on the plotting device and the size of the font and figures and ##' thus has to be adjusted manually. ##' ##' Oma can be used to further control horizontal margins, e.g., par(oma=c(0,4,0,4)). ##' ##' If confidence limits extend beyond the range determined by xlim, then ##' arrows are drawn at the x-lim borders to indicate that the confidence ##' limits continue. ##' @title Plot confidence intervals ##' @param x Either a vector containing the point estimates or a list ##' whose first element contains the point estimates. Further list ##' elements can contain the confidence intervals and labels. In this ##' case the list needs to have names 'lower' and 'upper' to indicate ##' the values of the lower and the upper limits of the confidence ##' intervals, respectively, and may have an element 'labels' which is ##' a vector or matrix or list with labels. ##' @param y.at Optional vector of y-position for the confidence intervals and corresponding values and labels. ##' @param lower Lower confidence limits. Used if object \code{x} is a ##' vector and if \code{x} is a list \code{lower} overwrites element ##' \code{x$lower}. ##' @param upper Upper confidence limits. Used if object \code{x} is a ##' vector and if \code{x} is a list \code{upper} overwrites element ##' \code{x$upper}. ##' @param pch Symbol for points. ##' @param cex Defaults size of all figures and plotting symbol. ##' Single elements are controlled separately. See \code{...}. ##' @param lwd Default width of all lines Single elements are ##' controlled separately. See \code{...}. ##' @param col Default colour of confidence intervals. ##' @param xlim Plotting limits for the confidence intervals. See also ##' \code{xratio} on how to control the layout. ##' @param xlab Label for the x-axis. ##' @param labels Vector or matrix or list with \code{labels}. Used if ##' object \code{x} is a vector and if \code{x} is a list it ##' overwrites element \code{x$labels}. To avoid drawing of labels, set \code{labels=FALSE}. ##' @param title.labels Main title for the column which shows the \code{labels}. If \code{labels} ##' is a matrix or list \code{title.labels} should be a vector with as ##' many elements as labels has columns or elements. ##' @param values Either logical or vector, matrix or list with ##' values. If \code{values=TRUE} values are constructed according to ##' \code{format} from \code{lower} and \code{upper} overwrites ##' constructed values. If \code{values=FALSE} do not draw values. ##' @param title.values Main title for the column \code{values}. If \code{values} ##' is a matrix or list \code{title.labels} should be a vector with as ##' many elements as values has columns or elements. ##' @param section.sep Amount of space between paragraphs (applies only if \code{labels} is a named list) ##' @param section.title Intermediate section headings. ##' @param section.title.x x-position for section.titles ##' @param section.pos Vector with y-axis posititions for section.titles. ##' @param section.title.offset Y-offset for section.titles ##' @param order Order of the three columns: labels, confidence limits, ##' values. See examples. ##' @param leftmargin Percentage of plotting region used for ##' leftmargin. Default is 0.025. See also Details. ##' @param rightmargin Percentage of plotting region used for ##' rightmargin. Default is 0.025. See also Details. ##' @param stripes Vector of up to three Logicals. If \code{TRUE} draw ##' stripes into the background. The first applies to the labels, the ##' second to the graphical presentation of the confidence intervals ##' and the third to the values. Thus, stripes ##' @param factor.reference.pos Position at which factors attain ##' reference values. ##' @param factor.reference.label Label to use at ##' \code{factor.reference.pos} instead of values. ##' @param factor.reference.pch Plotting symbol to use at ##' \code{factor.reference.pos} ##' @param refline Position of a vertical line to indicate the null ##' hypothesis. Default is 1 which would work for odds ratios and ##' hazard ratios. ##' @param title.line Position of a horizontal line to separate the title line from the plot ##' @param xratio One or two values between 0 and 1 which determine ##' how to split the plot window in horizontal x-direction. If there ##' are two columns (labels, CI) or (CI, values) only one value is used ##' and the default is 0.618 (goldener schnitt) which gives the ##' graphical presentation of the confidence intervals 38.2 % of the ##' graph. The remaining 61.8 % are used for the labels (or values). ##' If there are three columns (labels, CI, values), xratio has two ##' values which default to fractions of 0.7 according to the relative ##' widths of labels and values, thus by default only 0.3 are used for ##' the graphical presentation of the confidence intervals. The ##' remaining 30 % are used for the graphical presentation of the ##' confidence intervals. See examles. ##' @param y.offset Either a single value or a vector determining the ##' vertical offset of all rows. If it is a single value all rows are ##' shifted up (or down if negative) by this value. This can be used ##' to add a second set of confidence intervals to an existing graph ##' or to achieve a visual grouping of rows that belong ##' together. See examples. ##' @param y.title.offset Numeric value by which to vertically shift ##' the titles of the labels and values. ##' @param digits Number of digits, passed to \code{pubformat} and ##' \code{formatCI}. ##' @param format Format for constructing values of confidence ##' intervals. Defaults to '(u;l)' if there are negative lower or ##' upper values and to '(u-l)' otherwise. ##' @param extremearrows.length Length of the arrows in case of ##' confidence intervals that stretch beyond xlim. ##' @param extremearrows.angle Angle of the arrows in case of ##' confidence intervals that stretch beyond xlim. ##' @param add Logical. If \code{TRUE} do not draw labels or values ##' and add confidence intervals to existing plot. ##' @param layout Logical. If \code{FALSE} do not call layout. This is useful when ##' several plotConfidence results should be combined in one graph and hence layout is called ##' externally. ##' @param xaxis Logical. If \code{FALSE} do not draw x-axis. ##' @param ... Used to control arguments of the following subroutines: ##' \code{plot}: Applies to plotting frame of the graphical ##' presentation of confidence intervals. Use arguments of ##' \code{plot}, e.g., \code{plot.main="Odds ratio"}. \code{points}, ##' \code{arrows}: Use arguments of \code{points} and \code{arrows}, ##' respectively. E.g., \code{points.pch=8} and \code{arrows.lwd=2}. ##' \code{refline}: Use arguments of \code{segments}, e.g., ##' \code{refline.lwd=2}. \code{labels}, ##' \code{values}, \code{title.labels}, \code{title.values}: Use ##' arguments of \code{text}, e.g., \code{labels.col="red"} or ##' \code{title.values.cex=1.8}. \code{xaxis}: Use arguments of ##' \code{axis}, e.g., \code{xaxis.at=c(-0.3,0,0.3)} \code{xlab}: Use ##' arguments of \code{mtext}, e.g., \code{xlab.line=2}. ##' \code{stripes}: Use arguments of \code{stripes}. See examples. ##' See examples for usage. ##' @return List of dimensions and coordinates ##' @examples ##' ##' library(Publish) ##' data(CiTable) ##' ##' ## A first draft version of the plot is obtained as follows ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper","p")], ##' labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")]) ##' ##' ## if argument labels is a named list the table is subdivided: ##' labellist <- split(CiTable[,c("Dose","Time","Mean","SD","n")],CiTable[,"Drug"]) ##' labellist ##' ## the data need to be ordered accordingly ##' CC= data.table::rbindlist(split(CiTable[,c("HazardRatio","lower","upper")],CiTable[,"Drug"])) ##' plotConfidence(x=CC, labels=labellist) ##' ##' ##' ## The graph consist of at most three columns: ##' ## ##' ## column 1: labels ##' ## column 2: printed values of the confidence intervals ##' ## column 3: graphical presentation of the confidence intervals ##' ## ##' ## NOTE: column 3 appears always, the user decides if also ##' ## column 1, 2 should appear ##' ## ##' ## The columns are arranged with the function layout ##' ## and the default order is 1,3,2 such that the graphical ##' ## display of the confidence intervals appears in the middle ##' ## ##' ## the order of appearance of the three columns can be changed as follows ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], ##' labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], ##' order=c(1,3,2)) ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], ##' labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], ##' order=c(2,3,1)) ##' ## if there are only two columns the order is 1, 2 ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], ##' labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], ##' values=FALSE, ##' order=c(2,1)) ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], ##' labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], ##' values=FALSE, ##' order=c(1,2)) ##' ##' ##' ##' ## The relative size of the columns needs to be controlled manually ##' ## by using the argument xratio. If there are only two columns ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], ##' labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], ##' xratio=c(0.4,0.15)) ##' ##' ## The amount of space on the left and right margin can be controlled ##' ## as follows: ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], ##' labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], ##' xratio=c(0.4,0.15), ##' leftmargin=0.1,rightmargin=0.00) ##' ##' ## The actual size of the current graphics device determines ##' ## the size of the figures and the space between them. ##' ## The sizes and line widths are increased as follows: ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], ##' xlab="Hazard ratio", ##' labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], ##' points.cex=3, ##' cex=2, ##' lwd=3, ##' xaxis.lwd=1.3, ##' xaxis.cex=1.3) ##' ## Note that 'cex' of axis ticks is controlled via 'par' but ##' ## cex of the label via argument 'cex' of 'mtext'. ##' ## The sizes and line widths are decreased as follows: ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], ##' labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], ##' cex=0.8, ##' lwd=0.8, ##' xaxis.lwd=0.8, ##' xaxis.cex=0.8) ##' ##' ## Another good news is that all figures can be controlled separately ##' ##' ## The size of the graphic device can be controlled in the usual way, e.g.: ##' \dontrun{ ##' pdf("~/tmp/testCI.pdf",width=8,height=8) ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], ##' labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")]) ##' dev.off() ##' } ##' ##' ## More control of the x-axis and confidence intervals that ##' ## stretch outside the x-range end in an arrow. ##' ## the argument xlab.line adjusts the distance of the x-axis ##' ## label from the graph ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], ##' xlab="Hazard ratio", ##' xlab.line=1.8, ##' xaxis.at=c(0.8,1,1.3), ##' labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], ##' xlim=c(0.8,1.3)) ##' ##' ## log-scale ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], ##' xlab="Hazard ratio", ##' xlab.line=1.8, ##' xaxis.at=c(0.8,1,1.3), ##' labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], ##' xlim=c(0.8,1.3),plot.log="x") ##' ## More pronounced arrows ##' ## Coloured xlab expression ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], ##' xlab=expression(HR[1](s)), ##' xlab.line=1.8, ##' xlab.col="darkred", ##' extremearrows.angle=50, ##' extremearrows.length=0.1, ##' labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], ##' xlim=c(0.8,1.3)) ##' ##' ## Controlling the labels and their titles ##' ## and the values and their titles ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], ##' labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], ##' xlab="Hazard ratio", ##' title.values=expression(bold(HR (CI[95]))), ##' title.labels=c("Drug/Time","Dose","Mean","St.dev.","N"), ##' factor.reference.pos=c(1,10,19), ##' factor.reference.pch=16, ##' cex=1.3, ##' xaxis.at=c(0.75,1,1.25,1.5,2)) ##' ##' ## For factor reference groups, one may want to replace the ##' ## confidence intervals by the word Reference, as in the previous example. ##' ## To change the word 'Reference' we use the argument factor.reference.label: ##' ## To change the plot symbol for the reference lines factor.reference.pch ##' ## To remove the plot symbol in the reference lines use 'NA' as follows: ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], ##' labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], ##' xlab="Hazard ratio", ##' factor.reference.label="Ref", ##' title.values=expression(bold(HR (CI[95]))), ##' title.labels=c("Drug/Time","Dose","Mean","St.dev.","N"), ##' factor.reference.pos=c(1,10,19), ##' factor.reference.pch=NA, ##' cex=1.3, ##' xaxis.at=c(0.75,1,1.25,1.5,2)) ##' ##' ##' ## changing the style of the graphical confidence intervals ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], ##' labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], ##' xlab="Hazard ratio", ##' factor.reference.pos=c(1,10,19), ##' points.pch=15, ##' points.col=rainbow(27), ##' points.cex=2, ##' arrows.col="darkblue", ##' cex=1.3, ##' order=c(1,3,2), ##' xaxis.at=c(0.75,1,1.25,1.5)) ##' ##' ## the values column of the graph can have multiple columns as well ##' ## to illustrate this we create the confidence intervals ##' ## before calling the function and then cbind them ##' ## to the pvalues ##' HR <- pubformat(CiTable[,6]) ##' CI95 <- formatCI(lower=CiTable[,7],upper=CiTable[,8],format="(l-u)") ##' pval <- format.pval(CiTable[,9],digits=3,eps=10^{-3}) ##' pval[pval=="NA"] <- "" ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], ##' labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], ##' values=list("HR"=HR,"CI-95"=CI95,"P-value"=pval), ##' cex=1.2, ##' xratio=c(0.5,0.3)) ##' ##' ## Finally, vertical columns can be delimited with background color ##' ## NOTE: this may slow things down and potentially create ##' ## large figures (many bytes) ##' col1 <- rep(c(prodlim::dimColor("green",density=22), ##' prodlim::dimColor("green")),length.out=9) ##' col2 <- rep(c(prodlim::dimColor("orange",density=22), ##' prodlim::dimColor("orange")),length.out=9) ##' col3 <- rep(c(prodlim::dimColor("blue",density=22), ##' prodlim::dimColor("blue")),length.out=9) ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], ##' labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], ##' stripes=c(1,0,1), ##' stripes.col=c(col1,col2,col3)) ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], ##' labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], ##' stripes=c(1,1,1), ##' stripes.col=c(col1,col2,col3)) ##' ##' threegreens <- c(prodlim::dimColor("green",density=55), ##' prodlim::dimColor("green",density=33), ##' prodlim::dimColor("green",density=22)) ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], ##' labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], ##' values=FALSE, ##' xlim=c(0.75,1.5), ##' stripes=c(1,1,1), ##' xratio=c(0.5,0.15), ##' stripes.horizontal=c(0,9,18,27)+0.5, ##' stripes.col=threegreens) ##' ##' # combining multiple plots into one ##' layout(t(matrix(1:5))) ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], ##' labels=CiTable[,c("Mean","n")], ##' layout=FALSE) ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], ##' layout=FALSE) ##' ##' ##' @export ##' @author Thomas A. Gerds plotConfidence <- function(x, y.at, lower, upper, pch=16, cex=1, lwd=1, col=4, xlim, xlab, labels, title.labels, values, title.values, section.pos, section.sep, section.title=NULL, section.title.x, section.title.offset, order, leftmargin=0.025, rightmargin=0.025, stripes, factor.reference.pos, factor.reference.label="Reference", factor.reference.pch=16, refline=1, title.line=TRUE, xratio, y.offset=0, y.title.offset, digits=2, format, extremearrows.length=0.05, extremearrows.angle=30, add=FALSE, layout=TRUE, xaxis=TRUE, ...){ # {{{ extract confidence data if (!is.list(x)) x <- list(x=x) m <- x[[1]] names(x) <- tolower(names(x)) if (missing(lower)) { lower <- x$lower } if (missing(upper)) upper <- x$upper if (missing(xlim)) xlim <- c(min(lower)-0.1*min(lower),max(upper)+0.1*min(upper)) if (missing(xlab)) xlab <- "" # }}} # {{{ preprocessing of labels and title.labels NR <- length(x[[1]]) if (length(lower)!=NR) stop(paste0("lower has wrong dimension. There are ",NR," contrasts but ",length(upper)," upper limits")) if (length(upper)!=NR) stop(paste0("upper has wrong dimension. There are ",NR," contrasts but ",length(upper)," upper limits")) if (!missing(labels) && (is.logical(labels) && labels[[1]]==FALSE)) do.labels <- FALSE else do.labels <- TRUE if (!do.labels || (!missing(title.labels) && (is.logical(title.labels) && title.labels[[1]]==FALSE))) do.title.labels <- FALSE else do.title.labels <- TRUE if (do.labels && missing(labels)) { labels <- x$labels if (is.null(labels)) do.labels <- FALSE } if (missing(labels)) labels <- NULL if (!is.data.frame(labels) && is.list(labels)){ section.rows <- sapply(labels,NROW) nsections <- length(labels) if (sum(section.rows)!=NR) stop(paste0("Label list has wrong dimension. There are ",NR," confidence intervals but ",sum(section.rows)," labels")) }else{ nsections <- 0 section.rows <- NULL } # }}} # {{{ set y positions and ylim if (missing(y.at)) {at <- 1:NR } else{ if(length(y.at)!=NR) stop(paste0("Number of y positions must match number of confidence intervals which is ",NR)) at <- y.at } if (nsections>0){ if (!missing(section.title) && length(section.title)>0){ names(labels) <- section.title ## stop("Cannot have section.titles when labels is a named list") } do.sections <- TRUE section.title <- rev(names(labels)) ## check for second level if (!is.data.frame(labels[[1]]) && is.list(labels[[1]])){ sublevels <- names(labels) labels <- lapply(1:length(labels),function(l){ cbind(sublevels[[l]],data.table::data.table(labels[[l]])) }) } labels <- data.table::rbindlist(lapply(labels,data.table::data.table),use.names=TRUE) section.pos <- cumsum(rev(section.rows)) }else{ if (!missing(section.title) && length(section.title)>0){ if (missing(section.pos)) stop("Need y-positions for section.titles") do.sections <- TRUE }else{ do.sections <- FALSE } } ## oneM <- strheight("M",cex=cex) oneM <- .5 if (do.sections){ if (missing(section.title.offset)) section.title.offset <- 1.5*oneM if (missing(section.sep)) section.sep <- 2*oneM section.shift <- rep(cumsum(c(0,section.sep+rep(section.sep,nsections-1))), c(section.pos[1],diff(section.pos))) section.pos+section.shift[section.pos] if ((sub.diff <- (length(at)-length(section.shift)))>0) section.shift <- c(section.shift,rep(section.title.offset+section.shift[length(section.shift)],sub.diff)) }else{ section.shift <- 0 } at <- at+section.shift ## if (!(length(y.offset) %in% c(1,NR))){ ## warning(paste("The given",length(y.offset),"many y-offsets are pruned/extended to the length",NR,"lines of the plot.")) ## } if (length(y.offset)!=NR) y.offset <- rep(y.offset,length.out=NR) at <- at+y.offset if (do.sections){ section.y <- at[section.pos] section.title.y <- section.y+section.title.offset }else{ section.title.y <- 0 } if (missing(y.title.offset)) { if (do.sections){ y.title.offset <- 1.5*oneM + section.title.offset } else{ y.title.offset <- 1.5*oneM } } title.y <- max(at)+y.title.offset rat <- rev(at) ylim <- c(0,at[length(at)]+1) dimensions <- list("NumberRows"=NR,xlim=xlim,ylim=ylim,y.at=at) # }}} # {{{ preprocessing of values and confidence intervals if (!missing(values) && (is.logical(values) && values[[1]]==FALSE)) do.values <- FALSE else do.values <- TRUE if (do.values==TRUE){ if (!missing(title.values) && (is.logical(title.values) && title.values[[1]]==FALSE)) do.title.values <- FALSE else do.title.values <- TRUE }else{ do.title.values <- FALSE } if (do.values){ if (missing(values)){ if (missing(format)) if (all(!is.na(upper)) && any(upper<0)) format <- "(u;l)" else format <- "(u-l)" values.defaults <- paste(pubformat(x[[1]],digits=digits), apply(cbind(lower,upper), 1, function(x)formatCI(lower=x[1],upper=x[2],format=format,digits=digits))) if (!missing(factor.reference.pos) && is.numeric(factor.reference.pos) && all(factor.reference.posvwidth) ## xratio <- c((1-(vwidth/lwidth))*0.7,(vwidth/lwidth)*0.7) ## else ## xratio <- c((1-(lwidth/vwidth))*0.7,(lwidth/vwidth)*0.7) ## xratio <- c(0.5,0.2) } labelswidth <- plotwidth * xratio[1] valueswidth <- plotwidth * xratio[2] ciwidth <- plotwidth - labelswidth - valueswidth mat <- matrix(c(0,c(1,3,2)[order],0),ncol=5) if (!missing(order) && length(order)!=3) order <- rep(order,length.out=3) if (layout) layout(mat,width=c(leftmarginwidth,c(labelswidth,ciwidth,valueswidth)[order],rightmarginwidth)) ## layout.show(n=3) } else{ ## only labels do.stripes <- rep(do.stripes,length.out=2) names(do.stripes) <- c("labels","ci") if (missing(xratio)) xratio <- 0.618 labelswidth <- plotwidth * xratio[1] ciwidth <- plotwidth - labelswidth valueswidth <- 0 if (!missing(order) && length(order)!=2) order <- rep(order,length.out=2) mat <- matrix(c(0,c(1,2)[order],0),ncol=4) if (layout) layout(mat,width=c(leftmarginwidth,c(labelswidth,ciwidth)[order],rightmarginwidth)) } } else{ if (do.values){ ## only values do.stripes <- rep(do.stripes,length.out=2) names(do.stripes) <- c("ci","values") if (missing(xratio)) xratio <- 0.618 valueswidth <- plotwidth * (1-xratio[1]) ciwidth <- plotwidth - valueswidth labelswidth <- 0 mat <- matrix(c(0,c(2,1)[order],0),ncol=4) if (!missing(order) && length(order)!=2) order <- rep(order,length.out=2) if (layout) layout(mat,width=c(leftmarginwidth,c(ciwidth,valueswidth)[order],rightmarginwidth)) }else{ # none xratio <- 1 ciwidth <- plotwidth do.stripes <- do.stripes[1] names(do.stripes) <- "ci" labelswidth <- 0 valueswidth <- 0 mat <- matrix(c(0,1,0),ncol=3) if (layout) layout(mat,width=c(leftmarginwidth,ciwidth,rightmarginwidth)) } } dimensions <- c(dimensions,list(xratio=xratio, labelswidth=labelswidth, valueswidth=valueswidth, ciwidth=ciwidth,layout=mat)) } # }}} # {{{ labels if (add==FALSE) par(mar=oldmar*c(1,0,1,0)) if (do.labels){ if (do.stripes[["labels"]]) preplabels <- c(preplabels,list(width=labelswidth,ylim=ylim,stripes=smartA$stripes)) else preplabels <- c(preplabels,list(width=labelswidth,ylim=ylim)) do.call("plotLabels",preplabels) # }}} # {{{ title underline if ((missing(title.line) || !is.null(title.line)) && ((add==FALSE) & is.infinite(smartA$title.line$x0))){ smartA$title.line$x0 <- par()$usr[1] smartA$title.line$x1 <- par()$usr[2] do.call("segments",smartA$title.line) smartA$title.line$x0 <- -Inf ## box() } } # }}} # {{{ section.titles if (do.sections){ do.call("text",smartA$section.title) } # }}} # {{{ values if (do.values){ if (do.stripes[["values"]]) prepvalues <- c(prepvalues,list(width=valueswidth,ylim=ylim,stripes=smartA$stripes)) else prepvalues <- c(prepvalues,list(width=valueswidth,ylim=ylim)) do.call("plotLabels",prepvalues) if ((missing(title.line) || !is.null(title.line)) && ((add==FALSE) & is.infinite(smartA$title.line$x0))){ smartA$title.line$x0 <- par()$usr[1] smartA$title.line$x1 <- par()$usr[2] do.call("segments",smartA$title.line) smartA$title.line$x0 <- -Inf ## box() } } # }}} # {{{ plot which contains the confidence intervals if (add==FALSE){ do.call("plot",smartA$plot) if (do.stripes[["ci"]]) do.call("stripes",smartA$stripes) if (do.xaxis==TRUE){ oldcexaxis <- par()$cex.axis on.exit(par(cex.axis=oldcexaxis)) par(cex.axis=smartA$xaxis$cex) if (is.null(smartA$xaxis$labels)) do.call("axis",smartA$xaxis) } do.call("mtext",smartA$xlab) } # }}} # {{{ ref line if (add==FALSE){ if (missing(refline) || !is.null(refline)) do.call("segments",smartA$refline) } # }}} # {{{ title underline if (add==FALSE){ if (missing(title.line) || !is.null(title.line)){ if (is.infinite(smartA$title.line$x0)){ smartA$title.line$x0 <- par()$usr[1] smartA$title.line$x1 <- par()$usr[2] } do.call("segments",smartA$title.line) } } # }}} # {{{ point estimates and confidence do.call("points",smartA$points) ## treat arrows that go beyond the x-limits if (any(smartA$arrows$x0>xlim[2],na.rm=TRUE)||any(smartA$arrows$x1xlim[2] tooHigh[is.na(tooHigh)] <- FALSE tooLow <- smartA$arrows$x00){ stripes$xlim <- c(0,width) do.call("stripes",stripes) } ## arrows(x0=0,x1=width,y0=12,y1=12,lwd=8,col="orange") ## abline(v=xpos,col=1:5) nix <- lapply(1:ncolumns,function(l){ labels.args$x <- xpos[[l]] labels.args$labels <- labels[[l]] labels.args$cex <- labels.args$cex[[l]] ## if (length(grep("\\;",labels[[1]]))>0) browser() ## if (!is.null(labels.args$adj)) labels.args$pos=NULL do.call("text",labels.args) }) ## to avoid that expression(bold(CI[95])) is ## changed to bold(CI[95]) we make titles a list if (length(titles)==1) titles <- list(titles) if (length(titles)>0){ ## title.columns <- lapply(1:ncolumns,function(cc){sprintf(fmt=fmt.columns[[cc]],titles[[cc]])}) nix <- lapply(1:ncolumns,function(l){ titles.args$x <- xpos[[l]] titles.args$labels <- titles[[l]] titles.args$cex <- titles.args$cex[[l]] do.call("text",titles.args) }) } } #---------------------------------------------------------------------- ### plotLabels.R ends here Publish/R/ci.mean.formula.R0000755000176200001440000000200614142666146015175 0ustar liggesusers#' @export ci.mean.formula <- function(x, data, alpha = 0.05, normal = TRUE, na.rm=T, statistic=c("arithmetic","geometric"),...){ work <- model.frame(x,data) nf <- ncol(work)-1 if (nf>1) f <- interaction(work[,-1,drop=FALSE],sep=" - ") else f <- factor(work[,2]) res <- lapply(split(model.response(work),f),ci.mean.default,alpha=alpha,normal=normal,na.rm=na.rm,statistic=statistic) statistic <- unique(unlist(lapply(res,function(x)x$statistic))) labels <- do.call("rbind",strsplit(names(res)," - ")) colnames(labels) <- names(work)[-1] ## we reverse the order of factors for nicer labeling ... labels <- labels[,rev(1:nf),drop=FALSE] res <- data.frame(do.call("rbind",res)) out <- lapply(res[,1:4],function(x)unlist(x)) out <- c(out,list(labels=labels,level=alpha,statistic=statistic)) class(out) <- c("ci",class(out)) out } Publish/R/iqr.R0000744000176200001440000000026714142666146013017 0ustar liggesusersiqr <- function (x, na.rm = FALSE,digits,...){ paste("[",paste(format(quantile(as.numeric(x), c(0.25, 0.75), na.rm = na.rm),digits=digits,nsmall=digits),collapse=","),"]",sep="") } Publish/R/print.subgroupAnalysis.R0000644000176200001440000000101114142666146016714 0ustar liggesusers##' Print function for subgroupAnalysis ##' ##' This function is simply calling \code{summary.subgroupAnalysis} ##' @title Printing univariate tables ##' @param x - An object obtained with \code{subgroupAnalysis} ##' @param ... Passed to summary.subgroupAnalysis ##' @return The result of \code{summary.subgroupAnalysis(x)} ##' @seealso \code{subgroupAnalysis} ##' @export ##' @author Christian Torp-Pedersen (ctp@heart.dk) print.subgroupAnalysis <- function(x,...){ sx <- summary(x,...) print(sx) invisible(sx) } Publish/R/parseFrequencyFormat.R0000744000176200001440000000160314142666146016364 0ustar liggesusersparseFrequencyFormat <- function(format,digits){ tmp <- strsplit(format,"[ \t]+|[^ \t]*=|[^ \t]*:|[^ \t]*-|[^ \t]*\\+|\\(|\\{|\\[|\\)",perl=TRUE)[[1]] stats <- tmp[grep("^x$",tmp)-1] for(s in 1:length(stats)){ subs <- switch(stats[s], "count"="%s", "total"="%s", "percent"="%s", #paste("%1.",digits,"f",sep=""), "colpercent"="%s", #paste("%1.",digits,"f",sep=""), stop(paste("Cannot parse function ", stats[s], ". ", "Can only parse count, total and compute percentages for categorical variables", sep=""))) format <- gsub(paste(stats[s],"(x)",sep=""),subs,format,fixed=TRUE) } list(format=format,stats=stats) } Publish/R/getSummary.R0000744000176200001440000000500214142666146014351 0ustar liggesusersgetSummary <- function(matrix, varnames, groupvar, groups, labels, stats, format, digits,big.mark){ iqr <- function(x)quantile(x,c(0.25,0.75)) minmax <- function(x)quantile(x,c(0,1)) CI.95 <- function(x,sep=";",big.mark=big.mark,...){ m <- ci.mean.default(x,...) paste(format(m$lower,digits=digits,nsmall=digits,bigmark=big.mark), sep," ", format(m$upper,digits=digits,nsmall=digits,bigmark=big.mark),sep="") } totals <- vector(NCOL(matrix),mode="list") names(totals) <- varnames groupsummary <- vector(NCOL(matrix),mode="list") names(groupsummary) <- varnames for (v in varnames){ vv <- matrix[,v] missing.v <- is.na(vv) vvv <- vv[!missing.v] totals.values <- lapply(stats,function(s){ do.call(s,list(vvv)) }) specialUnlist <- function(list){ if (any(sapply(list,function(l){length(l)})>1)){ ll <- lapply(list,function(x){ if (length(x)>1) as.list(x) else x }) return(as.list(unlist(ll,recursive=FALSE))) } else{ return(list) } } totals.values <- lapply(totals.values,function(x){ a <- sprintf(fmt=paste("%1.",digits,"f",sep=""),x) if (big.mark!="") a <- format(as.numeric(a),big.mark=big.mark,scientific=FALSE) a }) totals[[v]] <- do.call("sprintf",c(format,specialUnlist(totals.values))) if (!is.null(groupvar) && !missing(groupvar) && length(groupvar)==NROW(matrix)){ ggg <- factor(groupvar[!missing.v],levels=groups) gsum.v <- lapply(groups,function(g){ values <- lapply(stats,function(s){ do.call(s,list(vvv[ggg==g])) }) values <- lapply(values,function(x){ a <- sprintf(fmt=paste("%1.",digits,"f",sep=""),x) if (big.mark!="") a <- format(as.numeric(a),big.mark=big.mark,scientific=FALSE) a }) do.call("sprintf",c(format, specialUnlist(values))) }) names(gsum.v) <- labels groupsummary[[v]] <- do.call("cbind", gsum.v) } } list(totals=totals,groupsummary=groupsummary) } Publish/R/subgroupAnalysis.R0000644000176200001440000002674414361526316015602 0ustar liggesusers#' @title Subgroup Analysis - Interactions and estimates #' @description #' #' The function can examine Cox regression, logistic regression #' and Poisson regression (Poisson regression for survival analysis) #' where the effect of one variable is of particular interest. This function #' systematically checks for effect modification with a list of other variables. #' #' In randomised studies the main regression analysis is often univariate and #' includes only the exposure of interest. In #' observational studies the main regression analysis can readily be adjusted for #' other variables including those which may modify the effect of the variable #' of interest. #' #' @author Christian Torp-Pedersen #' @param object - glm, coxph or cph object for which subgroups should be #' analyzed. #' @param data - Dataset including all relevant variables #' @param treatment - Must be numeric - 0/1 #' @param subgroups - A vector of variable names presenting the factor variables #' where subgroups should be formed. These variables should #' all be "factors" #' @param confint.method "default" creates Wald type confidence interval, "robust", #' creates creates robust standard errors - see regressionTable function. #' @param factor.reference "extraline" creates an extraline for the reference, #' "inline" avoids this line. #' @param ... additional arguments such as case weights, which are passed on to \code{glm} and \code{coxph}. #' @details #' The function can only handle a bivariate treatment, which MUST coded as #' zero or one. The p-value for interaction is obtained with a likelihood ratio test #' comparing the main regression analysis with the interaction model. #' #' There are plot and print functions available for the function #' see helppages for plot.subgroupAnalysis and print.subgroupAnalysis #' @return A data.frame with subsgroup specifications, number in each subgroup, #' parameter estimates and p-value for interaction. A forest plot #' can be obtained with "plotConfidence". #' @seealso coxph, glm, plotConfidence #' @export #' @examples #' #load libraries #' library(data.table) #' library(Publish) #' library(survival) #' data(traceR) #get dataframe traceR #' data.table::setDT(traceR) #' traceR[,':='(wmi2=factor(wallMotionIndex<0.9,levels=c(TRUE,FALSE), #' labels=c("bad","good")), #' abd2=factor(abdominalCircumference<95, levels=c(TRUE,FALSE), #' labels=c("slim","fat")))] #' traceR[,sex:=as.factor(sex)] # all subgroup variables needs to be factor #' traceR[observationTime==0,observationTime:=1] #' # remove missing covariate values #' traceR=na.omit(traceR) #' # univariate analysis of smoking in subgroups of age and sex #' # Main regression analysis is a simple/univariate Cox regression #' fit_cox <- coxph(Surv(observationTime,dead)~treatment,data=traceR) #' sub_cox <- subgroupAnalysis(fit_cox,traceR,treatment="treatment", #' subgroups=c("smoking","sex","wmi2","abd2")) #' sub_cox #' #' # to see how the results are obtained consider the variable: smoking #' fit_cox_smoke <- coxph(Surv(observationTime,dead)~treatment*smoking,data=traceR) #' # the last three rows of the following output: #' publish(fit_cox_smoke) #' # are included in the first 3 rows of the result of the sub group analysis: #' sub_cox[1:3,] #' # the p-value is obtained as: #' fit_cox_smoke_add <- coxph(Surv(observationTime,dead)~treatment+smoking,data=traceR) #' anova(fit_cox_smoke_add,fit_cox_smoke,test="Chisq") #' #' # Note that a real subgroup analysis would be to subset the data #' fit_cox1a <- coxph(Surv(observationTime,dead)~treatment,data=traceR[smoking=="never"]) #' fit_cox1b <- coxph(Surv(observationTime,dead)~treatment,data=traceR[smoking=="current"]) #' fit_cox1c <- coxph(Surv(observationTime,dead)~treatment,data=traceR[smoking=="prior"]) #' #' #' ## when the main analysis is already adjusted #' fit_cox_adj <- coxph(Surv(observationTime,dead)~treatment+smoking+sex+wmi2+abd2, #' data=traceR) #' sub_cox_adj <- subgroupAnalysis(fit_cox_adj,traceR,treatment="treatment", #' subgroups=c("smoking","sex","wmi2","abd2")) # subgroups as character string #' sub_cox_adj #' #' # When both start and end are in the Surv statement: #' traceR[,null:=0] #' fit_cox2 <- coxph(Surv(null,observationTime,dead)~treatment+smoking+sex+wmi2+abd2,data=traceR) #' summary(regressionTable(fit_cox)) #' sub_cox2 <- subgroupAnalysis(fit_cox2,traceR,treatment="treatment", #' subgroups=c("smoking","sex","wmi2","abd2")) #' # Analysis with Poisson - and the unrealistic assumption of constant hazard #' # and adjusted for age in all subgroups #' fit_p <- glm(dead~treatment+age+offset(log(observationTime)),family="poisson", #' data=traceR) #' sub_pois <- subgroupAnalysis(fit_p,traceR,treatment="treatment", #' subgroups=~smoking+sex+wmi2+abd2) #' # Analysis with logistic regression - and very wrongly ignoring censoring #' fit_log <- glm(dead~treatment+age,family="binomial",data=traceR) #' sub_log <- subgroupAnalysis(fit_log,traceR,treatment="treatment", #' subgroups=~smoking+sex+wmi2+abd2, factor.reference="inline") subgroupAnalysis <- function(object, # glm, lrm, coxph or cph object data, # data with all variables treatment, # max 2 values subgroups, # Character vector or Formula. Factor list of subgroups variables confint.method="default", # Wald type confidence interval factor.reference="extraline",...){ level=tail=Variable=NULL if(!(class(object)[1] %in% c("coxph","cph","glm"))) stop ("Error - Object must be coxph, cph or glm") if(!(class(treatment)[1]=="character")) stop("Error - Variable treament must be character") if(class(subgroups)[1]=="formula") subgroups <- all.vars(subgroups) else if(!(class(subgroups)[1]=="character")) stop ("Error - subgroups must be formula or character") if (!(class(data)[1] %in% c("data.frame","data.table"))) stop ("Error - data must be data.frame og data.table") else{ datt <- data.table::copy(data) data.table::setDT(datt) } classes <- sapply(datt,class) if (!classes[treatment] =="factor") stop("Error - treatment must be a factor variable") for(i in 1:length(subgroups)) if (!classes[subgroups[i]]=="factor") stop("Error - subgroups must be a factor variables") ## if (!all(stats::complete.cases(data[,.SD,.SDcols=c(subgroups,all.vars(object$formula),treatment)]))) ## warning("data has missing values in columns used, may cause problems") if (!treatment %in% all.vars(object$formula)) stop("Error - treatment must be in the formula") #Define type of analysis if (class(object)[1] %in% c("coxph","cph")) model<-"cox" else if (class(object)[1]=="glm"){ if(object$family$family=="binomial") model<-"logistic" else if (object$family$family=="poisson") model<-"poisson" # Poisson no offset else stop("Error - type of study not an option or misspecified") } #subgroups variables should not be in the models ## for (i in all.vars(object$formula)) if (i %in% subgroups) ## stop("Subgroups variables should not be part of every model") Result <- rbindlist(lapply(subgroups,function(var){ ff1 <- update.formula(object$formula, paste("~ . +",var, "*", treatment)) #with interaction ff2 <- update.formula(object$formula, paste("~ . +",var, "+", treatment)) #without interaction if (model=='cox'){ fit1 <- do.call("coxph",list(formula = ff1,data=datt,...)) fit2 <- do.call("coxph",list(formula = ff2,data=datt,...)) pinteraction <- anova(fit1,fit2)[4][2,] lhs <- all.vars(object$formula[[2]]) if(!class(datt[,eval(parse(text=lhs[2]))]) %in% c("numeric","integer")) stop("Outcome must be provided as 0/1 numeric") if (length(lhs)==2){ # time fixed model eventtime <- datt[,list(sample=.N, event=sum(eval(parse(text=lhs[2])),na.rm=TRUE), time=sum(eval(parse(text=lhs[1])),na.rm=TRUE)), by=c(var,treatment)] } else{ # Time varying model if(!class(datt[,eval(parse(text=lhs[3]))]) %in% c("numeric","integer")) stop("Outcome must be provided as 0/1 numeric") eventtime <- datt[,list(sample=.N, event=sum(eval(parse(text=lhs[3])),na.rm=TRUE), time=sum(eval(parse(text=lhs[2]))-eval(parse(text=lhs[1])),na.rm=TRUE)), by=c(var,treatment)] } eventtime <- data.table::dcast(eventtime,paste(var,"~",treatment), value.var=list("sample","event","time")) } else if(model=="poisson"){ if (!is.null(object$offset)){ fit1 <- do.call("glm",list(formula = ff1,family="poisson",data=datt,...)) fit2 <- do.call("glm",list(formula = ff2,family="poisson",data=datt,...)) tt1 <- terms(ff1) timevar <- all.vars(ff1)[[attributes(tt1)$offset]] if(!class(datt[,eval(parse(text=all.vars(object$formula)[[1]]))]) %in% c("numeric","integer")) stop("Outcome must be provided as 0/1 numeric") eventtime <- datt[,list(sample=.N, event=sum(eval(parse(text=all.vars(object$formula)[[1]])),na.rm=TRUE), time=sum(eval(parse(text=timevar))),na.rm=TRUE), by=c(var,treatment)] eventtime <- data.table::dcast(eventtime,paste(var,"~",treatment), value.var=list("sample","event","time")) } else{ #no offset if(!class(datt[,eval(parse(text=all.vars(object$formula)[[1]]))]) %in% c("numeric","integer")) stop("Outcome must be provided as 0/1 numeric") fit1 <- do.call("glm",list(formula = ff1,family="poisson",data=datt,...)) fit2 <- do.call("glm",list(formula = ff2,family="poisson",data=datt,...)) eventtime <- datt[,list(sample=.N, event=sum(eval(parse(text=all.vars(object$formula)[[1]])),na.rm=TRUE)), by=c(var,treatment)] eventtime <- data.table::dcast(eventtime,paste(var,"~",treatment), value.var=list("sample","event")) } pinteraction <- anova(fit1,fit2,test="Chisq")$"Pr(>Chi)"[2] } else if(model=="logistic"){ fit1 <- glm(formula = ff1,family="binomial",data=datt,...) fit2 <- glm(formula = ff2,family="binomial",data=datt,...) if(!class(datt[,eval(parse(text=all.vars(object$formula)[[1]]))]) %in% c("numeric","integer")) stop("Outcome must be provided as 0/1 numeric") eventtime <- datt[,list(sample=.N, event=sum(eval(parse(text=all.vars(object$formula)[[1]])),na.rm=TRUE)), by=c(var,treatment)] eventtime <- data.table::dcast(eventtime,paste(var,"~",treatment), value.var=list("sample","event")) pinteraction <- anova(fit1,fit2,test="Chisq")$"Pr(>Chi)"[2] } setnames(eventtime,var,"level") eventtime <- eventtime[!(level=="")] length <- dim(eventtime)[1] variable <- data.table(subgroups=rep(var,length)) rt <- suppressMessages(data.table::setDT(summary(regressionTable(fit1),print=FALSE)$rawTable)[,tail(.SD,length)]) rt <- rt[,Variable:=NULL] OUT <- cbind(variable,eventtime,rt,pinteraction) OUT } ) ,fill=TRUE) # end rbindlist class(Result) <- c("subgroupAnalysis","data.frame","data.table") Result } Publish/R/publish.summary.prodlim.R0000755000176200001440000000124514142666146017032 0ustar liggesusers##' @export publish.summary.prodlim <- function(object, conf.int = 0.95, digits = 1, print=TRUE, latex=FALSE, ...){ otab <- object$table if (class(otab)[1]=="list"){ onames <- names(otab) nix <- lapply(1:length(otab),function(i){ ## publish(onames[i]) if (latex==TRUE) publish(onames[i]) cat("\n\n") publish(otab[[i]],digits=digits,rownames=FALSE,latex=latex,...) }) } else{ publish(otab,digits=digits,rownames=FALSE,latex=latex,...) } } Publish/R/ci.mean.default.R0000755000176200001440000000275214142666146015164 0ustar liggesusers##' Compute mean values with confidence intervals ##' ##' Normal approximation ##' @title Compute mean values with confidence intervals #' @param x numeric vector #' @param alpha level of significance #' @param normal If \code{TRUE} use quantile of t-distribution else use normal approximation and quantile of normal approximation. Do you think this is confusing? #' @param na.rm If \code{TRUE} remove missing values from \code{x}. #' @param statistic Decide which mean to compute: either \code{"arithmetic"} or \code{"geometric"} #' @param ... not used ##' @return a list with mean values and confidence limits ##' @author Thomas Gerds #' @export ci.mean.default <- function(x, alpha = 0.05, normal = TRUE, na.rm=TRUE, statistic="arithmetic",...){ stat <- match.arg(statistic,c("arithmetic","geometric")) if (na.rm){x <- x[!is.na(x)]} if (stat=="geometric") x <- log(x) n <- length(x) m <- mean(x) se <- sqrt(var(x)/n) df <- n - 1 if(normal) { q <- qt(1 - alpha/2, df) } else { q <- qnorm(1 - alpha/2) } low <- m - se * q up <- m + se * q if (stat=="geometric") out <- list(geomean = exp(m), se = exp(se),lower = exp(low), upper = exp(up), level=alpha, statistic=stat) else out <- list(mean = m, se = se,lower = low, upper = up, level=alpha, statistic=stat) class(out) <- c("ci",class(out)) out } Publish/R/lazyFactorCoding.R0000755000176200001440000000355114142666146015467 0ustar liggesusers##' This function eases the process of generating factor variables ##' with relevant labels. All variables in a data.frame with less than ##' a user set number of levels result in a line which suggests levels and ##' labels. The result can then be modified for use. ##' ##' The code needs to be copy-and-pasted from the R-output ##' buffer into the R-code buffer. This can be customized ##' for the really efficiently working people e.g. in emacs. ##' @title Efficient coding of factor levels ##' @param data Data frame in which to search for categorical variables. ##' @param max.levels Treat non-factor variables only if the number of unique values less than max.levels. Defaults to 10. ##' @return R-code one line for each variable. ##' @author Thomas Alexander Gerds ##' @examples ##' data(Diabetes) ##' lazyFactorCoding(Diabetes) ##' ##' @export lazyFactorCoding <- function(data,max.levels=10){ if (!is.character(data)) data <- as.character(substitute(data)) d <- get(data, envir=parent.frame()) isdt <- match("data.table",class(d),nomatch=FALSE) out <- lapply(names(d),function(x){ dx <- d[[x]] if ((is.factor(dx) && length(unique(dx)) ##' ##' @export publish.FGR <- function(object,digits=4,print=TRUE,...){ sum <- summary(object$crrFit) p <- sum$coef[,5,drop=TRUE] subHR <- pubformat(sum$coef[,2,drop=TRUE],handler="sprintf",digits=digits) ci <- sum$conf.int[,3:4] colnames(ci) <- c("lower","upper") ci <- formatCI(x=subHR, ci[,"lower"], ci[,"upper"], show.x=0L) out <- data.table::data.table(cbind(Variable=rownames(sum$coef), subHR, ci, p)) if (print==TRUE) publish(out,digits=digits,...) invisible(out) } Publish/R/ci.geomean.formula.R0000744000176200001440000000150414142666146015670 0ustar liggesusersci.geomean.formula <- function(formula,data,alpha = 0.05,normal = T,na.rm=T,statistic="geometric"){ work <- model.frame(formula,data) nf <- ncol(work)-1 if (nf>1) f <- interaction(work[,-1,drop=FALSE],sep=" - ") else f <- factor(work[,2]) res <- lapply(split(model.response(work),f),ci.mean.default,alpha=alpha,normal=normal,na.rm=na.rm,statistic=statistic) statistic <- unique(unlist(lapply(res,function(x)x$statistic))) labels <- do.call("rbind",strsplit(names(res)," - ")) colnames(labels) <- names(work)[-1] ## we reverse the order of factors for nicer labeling ... labels <- labels[,rev(1:nf),drop=FALSE] res <- data.frame(do.call("rbind",res)) out <- lapply(res[,1:4],function(x)unlist(x)) out <- c(out,list(labels=labels,level=alpha,statistic=statistic)) class(out) <- c("ci",class(out)) out } Publish/R/formatCI.R0000644000176200001440000000657114142666146013733 0ustar liggesusers##' Format confidence intervals ##' ##' The default format for confidence intervals is [lower; upper]. ##' @title Formatting confidence intervals ##' @param x not used (for compatibility with format) ##' @param lower Numeric vector of lower limits ##' @param upper Numeric vector of upper limits ##' @param show.x Logical. If \code{TRUE} show value of x in front of confidence interval. ##' @param handler Function to format numeric values. Default is ##' \code{sprintf}, also supported are \code{format} and ##' \code{prettyNum} ##' @param format Character string in which \code{l} will be replaced ##' by the value of the lower limit (argument lower) and \code{u} ##' by the value of the upper upper limit. For example, ##' \code{(l,u)} yields confidence intervals in round parenthesis ##' in which the upper and lower limits are comma ##' separated. Default is \code{[l;u]}. ##' @param degenerated String to show when lower==upper. Default is ##' '--' ##' @param digits If handler \code{format} or \code{prettyNum} used ##' format numeric vectors. ##' @param nsmall If handler \code{format} or \code{prettyNum} used ##' format numeric vectors. ##' @param sep Field separator ##' @param reference.pos Position of factor reference ##' @param reference.label Label for factor reference ##' @param ... passed to handler ##' @return String vector with confidence intervals ##' @seealso plot.ci ci.mean ##' @examples ##' ##' x=ci.mean(rnorm(10)) ##' formatCI(lower=x[3],upper=x[4]) ##' formatCI(lower=c(0.001,-2.8413),upper=c(1,3.0008884)) ##' # change format ##' formatCI(lower=c(0.001,-2.8413),upper=c(1,3.0008884),format="(l, u)") ##' # show x ##' formatCI(x=x$mean,lower=x$lower,upper=x$upper,format="(l, u)",show.x=TRUE) ##' ##' # change of handler function ##' l <- c(-0.0890139,0.0084736,144.898333,0.000000001) ##' u <- c(0.03911392,0.3784706,3338944.8821221,0.00001) ##' cbind(format=formatCI(lower=l,upper=u,format="[l;u)",digits=2,nsmall=2,handler="format"), ##' prettyNum=formatCI(lower=l,upper=u,format="[l;u)",digits=2,nsmall=2,handler="prettyNum"), ##' sprintf=formatCI(lower=l,upper=u,format="[l;u)",digits=2,nsmall=2,handler="sprintf")) ##' ##' @export ##' @author Thomas A. Gerds formatCI <- function(x, lower, upper, show.x=FALSE, handler="sprintf", format="[l;u]", degenerated="asis", digits=2, nsmall=digits, sep="", reference.pos, reference.label="", ...){ stopifnot(length(upper)==length(lower)) format <- sub("l","%s",format) format <- sub("u","%s",format) lower <- pubformat(lower,digits=digits[[1]],nsmall=nsmall[[1]],handler=handler) upper <- pubformat(upper,digits=digits[[1]],nsmall=nsmall[[1]],handler=handler) N <- length(lower) out <- sapply(1:N,function(i){ if (is.character(degenerated) && degenerated!="asis" && lower[i]==upper[i]) ci <- degenerated else ci <- do.call("sprintf",list(fmt=format,lower[i],upper[i])) ci }) if (show.x) out <- paste(pubformat(x,digits=digits,handler=handler,nsmall=nsmall),out) if (!missing(reference.pos)) out[reference.pos] <- reference.label out } Publish/R/print.regressionTable.R0000644000176200001440000000050415040353375016473 0ustar liggesusers##' printing regression tables ##' ##' @title printing regression tables ##' @param x regressionTable object ##' @param ... passed to summary ##' @author Thomas A. Gerds ##' @export print.regressionTable <- function(x,...){ Rtab <- summary(x,print=FALSE,...) print.listof(Rtab,...) Rtab } Publish/R/plot.subgroupAnalysis.R0000644000176200001440000000310614142666146016545 0ustar liggesusers#' @title plot.subgroupAnalysis #' @description #' This function operates on a "subgroupAnalysis" object to produce a formatted #' table and a forest plot #' @author Christian Torp-Pedersen #' @param x - a subgroupAnalysis object #' @param ... - passed on to plotConfidence #' @details #' This function produces a formatted table of a subgroupAnalysis object and #' adds a forest plot. If further details needs attention before plotting is #' is advisable use adjust the table produced by the summary function and then #' plotting with the plotConfidence function #' @return NULL #' @seealso subgroupAnalysis, plotConfidence #' @export #' @examples #' #load libraries #' library(Publish) #' library(survival) #' library(data.table) #' data(traceR) #get dataframe traceR #' setDT(traceR) #' traceR[,':='(wmi2=factor(wallMotionIndex<0.9,levels=c(TRUE,FALSE), #' labels=c("bad","good")), #' abd2=factor(abdominalCircumference<95, levels=c(TRUE,FALSE), #' labels=c("slim","fat")), #' sex=factor(sex))] #' fit_cox <- coxph(Surv(observationTime,dead)~treatment,data=traceR) #' # Selected subgroups - univariable analysis #' sub_cox <- subgroupAnalysis(fit_cox,traceR,treatment="treatment", #' subgroup=c("smoking","sex","wmi2","abd2")) # subgroups as character string #' plot(sub_cox) plot.subgroupAnalysis <- function(x,...) { if (class(x)[1]!="subgroupAnalysis") stop("Object not of class subgroupAnalysis") num <- length(names(x)) plotcols<-x[,(num-4):(num-2)] tabcols <-x[,1:2] Publish::plotConfidence(x=plotcols, labels=tabcols) }Publish/R/print.univariateTable.R0000744000176200001440000000100014142666146016460 0ustar liggesusers##' Print function for univariate tables ##' ##' This function is simply calling \code{summary.univariateTable} ##' @title Printing univariate tables ##' @param x An object obtained with \code{univariateTable} ##' @param ... Passed to summary.univariateTable ##' @return The result of \code{summary.univariateTable(x)} ##' @seealso \code{univariateTable} ##' @export ##' @author Thomas A. Gerds print.univariateTable <- function(x,...){ sx <- summary(x,...) print(sx) invisible(sx) } Publish/R/publish.list.R0000644000176200001440000000110714142666146014635 0ustar liggesusers##' @export publish.list <- function(object, title, level=0, hrule=0, title.level=1, title.hrule=1, ...){ if (!missing(title)) publish(title,level=title.level,hrule=title.hrule) xnames <- names(object) nix <- lapply(1:length(object),function(i){ if (!is.null(xnames)){ publish(xnames[i],level=level,hrule=hrule) } else cat("\n\n") inX <- object[[i]] publish(inX,level=min(level+1,3),...) }) } Publish/R/publish.data.frame.R0000755000176200001440000000013314142666146015665 0ustar liggesusers##' @export publish.data.frame <- function(object,...){ publish(as.matrix(object),...) } Publish/R/plot.regressionTable.R0000644000176200001440000000663214142666146016332 0ustar liggesusers### plot.regressionTable.R --- #---------------------------------------------------------------------- ## author: Thomas Alexander Gerds ## created: Feb 2 2015 (06:55) ## Version: ## last-updated: May 13 2018 (14:36) ## By: Thomas Alexander Gerds ## Update #: 103 #---------------------------------------------------------------------- ## ### Commentary: ## ### Change Log: #---------------------------------------------------------------------- ## ### Code: ##' Plotting regression coefficients with confidence limits ##' ##' ##' @title Plotting regression coefficients with confidence limits ##' @param x regression table obtained with regressionTable ##' @param xlim Limits for x-axis ##' @param xlab Label for x-axis ##' @param style Determines how to arrange variable names and their corresponding units ##' @param ... passed to plotConfidence ##' @return NULL ##' @seealso regressionTable ##' @examples ##' ## linear regression ##' data(Diabetes) ##' f <- glm(bp.1s~AgeGroups+chol+gender+location,data=Diabetes) ##' rtf <- regressionTable(f,factor.reference = "inline") ##' plot(rtf,cex=1.3) ##' ##' ## logistic regression ##' data(Diabetes) ##' f <- glm(I(BMI>25)~bp.1s+AgeGroups+chol+gender+location,data=Diabetes,family=binomial) ##' rtf <- regressionTable(f,factor.reference = "inline") ##' plot(rtf,cex=1.3) ##' ##' ## Poisson regression ##' data(trace) ##' fit <- glm(dead ~ smoking+ sex+ age+Time+offset(log(ObsTime)), family = poisson,data=trace) ##' rtab <- regressionTable(fit,factor.reference = "inline") ##' plot(rtab,xlim=c(0.85,1.15),cex=1.8,xaxis.cex=1.5) ##' ##' ## Cox regression ##' library(survival) ##' data(pbc) ##' coxfit <- coxph(Surv(time,status!=0)~age+log(bili)+log(albumin)+factor(edema)+sex,data=pbc) ##' pubcox <- publish(coxfit) ##' plot(pubcox,cex=1.5,xratio=c(0.4,0.2)) ##' ##' @export ##' @author Thomas A. Gerds plot.regressionTable <- function(x,xlim,xlab,style=1,...){ plot(summary(x,print=FALSE),xlim=xlim,xlab=xlab,style=style,...) } ##' @export plot.summary.regressionTable <- function(x,xlim,xlab,style=1,...){ X <- x$rawTable X <- labelUnits(X,...) if (sum(X$Units=="")>0) X[X$Units=="",]$Units <- "1 unit" model <- x$model if (missing(xlab)) xlab <- switch(model, "Linear regression"="Difference", "Logistic regression"="Odds ratio", "Poisson regression"="Hazard ratio", "Cox regression"="Hazard ratio") Coef <- X[,grep("OddsRatio|HazardRatio|ProbIndex|Coefficient",colnames(X))] Lower <- X$Lower Upper <- X$Upper if (missing(xlim)) xlim <- c(min(Lower),max(Upper)) U <- X$Units V <- X$Variable if (style==1){ Labs <- split(U,rep(1:length(x$blocks),x$blocks)) names(Labs) <- names(x$blocks) labels <- list(...) keys <- names(labels) Flabels <- labels[match(keys,names(Labs),nomatch=0)!=0] if (length(Flabels)>0) names(Labs)[match(keys,names(Labs),nomatch=0)] <- Flabels } else { Labs <- data.frame(Variable=V,Units=U) } plotConfidence(list(Coef,lower=Lower,upper=Upper), xlim=xlim, labels=Labs, xlab=xlab, refline=1*(model!="Linear regression"), ...) } #---------------------------------------------------------------------- ### plot.regressionTable.R ends here Publish/R/getPyntDefaults.R0000644000176200001440000000161614142666146015344 0ustar liggesusers### getPyntDefaults.R --- #---------------------------------------------------------------------- ## author: Thomas Alexander Gerds ## created: Feb 26 2015 (06:54) ## Version: ## last-updated: Feb 26 2015 (07:20) ## By: Thomas Alexander Gerds ## Update #: 10 #---------------------------------------------------------------------- ## ### Commentary: ## ### Change Log: #---------------------------------------------------------------------- ## ### Code: getPyntDefaults <- function(call,names){ call <- as.list(call) pub.args <- call[match(names(names),names(call),nomatch=FALSE)] pynt <- lapply(names(names),function(n){ if (length(pa <- pub.args[[n]])>0) eval(pa) else names[[n]] }) names(pynt) <- names(names) pynt } #---------------------------------------------------------------------- ### getPyntDefaults.R ends here Publish/R/sutable.R0000644000176200001440000000326114142666146013657 0ustar liggesusers### sutable.R --- #---------------------------------------------------------------------- ## author: Thomas Alexander Gerds ## created: Nov 28 2015 (08:40) ## Version: ## last-updated: Oct 22 2017 (12:57) ## By: Thomas Alexander Gerds ## Update #: 7 #---------------------------------------------------------------------- ## ### Commentary: ## ### Change Log: #---------------------------------------------------------------------- ## ### Code: ## the sutable first calls utable and then summary ##' First apply univariateTable then call summary. ##' ##' @title Fast summary of a univariate table ##' @param ... Unnamed arguments and are passed to \code{univariateTable} as well as named arguments ##' that match \code{univariateTable}'s arguments, other arguments ##' are passed to \code{summary.univariateTable} ##' @return Summary table ##' @seealso summary.univariateTable univariateTable ##' @examples ##' data(Diabetes) ##' sutable(gender~age+location+Q(BMI)+height+weight,data=Diabetes,BMI="Body mass index (kg/m^2)") ##' @export ##' @author Thomas A. Gerds sutable <- function(...){ args <- list(...) unames <- c("formula","data","summary.format","Q.format","freq.format","column.percent","digits","strataIsOutcome","short.groupnames","na.rm") ## no name arguments go into utable uargs <- args[names(args)==""] args <- args[names(args)!=""] test.args <- match(names(args),unames,nomatch=0) sargs <- args[test.args==0] uargs <- c(uargs,args[test.args!=0]) do.call(summary,c(list(object=do.call(univariateTable,uargs)),sargs)) } #---------------------------------------------------------------------- ### sutable.R ends here Publish/R/publish.prodlim.R0000755000176200001440000000251714762241647015344 0ustar liggesusers##' @export publish.prodlim <- function(object,times,intervals=TRUE,percent=TRUE,digits=ifelse(percent,1,3),cause=1,surv=TRUE,print=TRUE,...){ if (missing(times)) stop("Argument times is missing with no default.") so <- summary(object,times=times,intervals=intervals,percent=percent,cause=cause,surv=surv) data.table::setDT(so) if (match("cuminc",colnames(so),nomatch=FALSE)==0){ nn = "surv" se = "se.surv" NN = "Survival probability" data.table::set(so,j = "Survival probability",value = format(so[["surv"]],digits=digits,nsmall=digits)) } else{ nn = "cuminc" se = "se.cuminc" NN = "Absolute risk" data.table::set(so,j = "Absolute risk",value = format(so[["cuminc"]],digits=digits,nsmall=digits)) } data.table::set(so,j = "Interval", value = apply(format(so[,c("time0","time1"),drop=FALSE],digits=digits,nsmall=digits),1,paste,collapse="--")) data.table::set(so,j = "CI.95", value = formatCI(lower = so[["lower"]],upper = so[["upper"]],digits=digits,nsmall=digits)) for (n in c("time0","time1","lower","upper",nn,se)) data.table::set(so,j = n,value = NULL) vv = c("Interval",NN,"CI.95") not_vv = setdiff(names(so),vv) data.table::setcolorder(so,c(not_vv,vv)) if (print==TRUE){ publish(so,rownames=FALSE,...) } invisible(so) } Publish/R/stripes.R0000644000176200001440000000743415040352666013714 0ustar liggesusers### stripes.R --- #---------------------------------------------------------------------- ## author: Thomas Alexander Gerds ## created: May 12 2015 (06:52) ## Version: ## last-updated: Jul 24 2025 (08:41) ## By: Thomas Alexander Gerds ## Update #: 28 #---------------------------------------------------------------------- ## ### Commentary: ## ### Change Log: #---------------------------------------------------------------------- ## ### Code: #' Background and grid color control. #' #' Some users like background colors, and it may be helpful to have grid lines #' to read off e.g. probabilities from a Kaplan-Meier graph. Both things can be #' controlled with this function. However, it mainly serves #' \link[prodlim]{plot.prodlim}. #' #' #' @param xlim Limits for the horizontal x-dimension. Defaults to #' par("usr")[1:2]. #' @param ylim Limits for the vertical y-dimension. #' @param col Colors use for the stripes. Can be a vector of colors #' which are then repeated appropriately. #' @param lwd Line width #' @param gridcol Color of grid lines #' @param fill Color to fill the background rectangle given by #' par("usr"). #' @param horizontal Numerical values at which to show horizontal grid #' lines, and at which to change the color of the stripes. #' @param vertical Numerical values at which to show vertical grid #' lines. #' @param border If a fill color is provided, the color of the border #' around the background. #' @param xpd From \code{help(par)}: A logical value or NA. If FALSE, #' all plotting is clipped to the plot region, if TRUE, all plotting #' is clipped to the figure region, and if NA, all plotting is clipped #' to the device region. See also \code{clip}. #' @author Thomas Alexander Gerds #' @keywords survival #' @examples #' #' #' plot(0,0) #' backGround(bg="beige",fg="red",vertical=0,horizontal=0) #' #' plot(0,0) #' stripes(col=c("yellow","green"),gridcol="red",xlim=c(-1,1),horizontal=seq(0,1,.1)) #' stripes(col=c("yellow","green"),gridcol="red",horizontal=seq(0,1,.1)) #' #' @export stripes <- function(xlim, ylim, col="white", lwd=1, gridcol="gray77", fill="white", horizontal=NULL, vertical=NULL, border="black",xpd=FALSE){ U <- par("usr") if (!missing(xlim)){ U[1] <- xlim[1] U[2] <- xlim[2] } if (!missing(ylim)){ U[3] <- ylim[1] U[4] <- ylim[2] } print(U) # background if (!is.null(fill)) rect(U[1],U[3],U[2],U[4],col=fill, border=border,xpd=xpd) if (!is.null(col)){ if (length(col)==1){ rect(U[1],U[3],U[2],U[4],col=col[1], border=border,xpd=xpd) }else{ if (length(col)>1){ NR <- length(horizontal) bcol <- rep(col,length.out=NR) nix <- sapply(1:(NR-1),function(r){ polygon(x=c(U[1],U[1],U[2],U[2],U[1]), y=c(horizontal[r],horizontal[r+1],horizontal[r+1],horizontal[r],horizontal[r]), col=bcol[r], xpd=xpd, border=FALSE) ## do NOT specify: density=100 as this slows this down! }) } } } # grid if (length(gridcol)>0){ if (length(vertical)>0) abline(v=vertical,col=gridcol,xpd=xpd) if (length(horizontal)>0){ ## abline(h=horizontal,col=gridcol,xpd=xpd) for (h in horizontal){ segments(x0=U[1],x1=U[2],y0=h,y1=h,col=gridcol,xpd=xpd,lwd=lwd) } } } } #---------------------------------------------------------------------- ### stripes.R ends here Publish/R/ci.geomean.R0000744000176200001440000000074614142666146014233 0ustar liggesusersci.geomean <- function(x,alpha = 0.05,normal = T,na.rm=T){ if (na.rm){x <- x[!is.na(x)]} logx <- log(x) n <- length(logx) m <- mean(logx) se <- sqrt(var(logx)/n) df <- n - 1 if(normal) { q <- qt(1 - alpha/2, df) } else { q <- qnorm(1 - alpha/2) } low <- m - se * q up <- m + se * q m <- exp(m) se <- exp(se) low <- exp(low) up <- exp(up) out <- data.frame(geomean = m,se = se,lower = low,upper = up) class(out) <- c("ci", class(out)) out } Publish/R/print.table2x2.R0000644000176200001440000001241014142666146014772 0ustar liggesusers##' print results of 2x2 contingency table analysis ##' ##' @title print results of 2x2 contingency table analysis ##' @param x object obtained with table2x2 ##' @param digits rounding digits ##' @param ... not used ##' @return invisible x ##' @seealso table2x2 ##' @examples ##' table2x2(table("marker"=rbinom(100,1,0.4),"response"=rbinom(100,1,0.1))) ##' table2x2(matrix(c(71,18,38,8),ncol=2),stats="table") ##' table2x2(matrix(c(71,18,38,8),ncol=2),stats=c("rr","fisher")) ##' @export ##' @author Thomas A. Gerds print.table2x2 <- function(x,digits=1,...){ stats <- x$stats table2x2 <- x$table2x2 a <- table2x2[1,1] b <- table2x2[1,2] c <- table2x2[2,1] d <- table2x2[2,2] p1 <- a/(a+b) p2 <- c/(c+d) if ("table" %in% stats){ suppressWarnings(X <- data.frame(rbind(table2x2,rep("--",2),table2x2[1,]+table2x2[2,]))) if (is.null(rownames(table2x2))) rownames(table2x2) <- paste("exposure:",c("no","yes")) if (is.null(colnames(table2x2))) colnames(table2x2) <- paste("response:",c("no","yes")) X$Sum <- c(a+b,c+d,"--",a+b+c+d) colnames(X) <- c(paste(names(attr(table2x2,"dimnames"))[2],attr(table2x2,"dimnames")[[2]],sep=""),"Sum") rownames(X) <- c(paste(names(attr(table2x2,"dimnames"))[1],attr(table2x2,"dimnames")[[1]],sep=""),"--","Sum") cat("_____________________________\n\n2x2 contingency table\n_____________________________\n\n") print(X,print.gap=5) cat("\n_____________________________\n\nStatistics\n_____________________________\n\n") cat(paste("\na=",a,"\nb=",b,"\nc=",c,"\nd=",d)) cat(paste("\n\np1=a/(a+b)=",round(a/(a+b),4),"\np2=c/(c+d)=", round(c/(c+d),4)),"\n") } if ("rd" %in% stats){ rd <- x$rd se.rd <- x$se.rd rd.lower <- x$rd.lower rd.upper <- x$rd.upper cat(paste("\n_____________________________\n\nRisk difference\n_____________________________\n\n", "Risk difference = RD = p1-p2 = ", format(rd,digits=digits+3,nsmall=digits+3), "\nStandard error = SE.RD = sqrt(p1*(1-p1)/(a+b)+p2*(1-p2)/(c+d)) = ", format(se.rd,digits=digits+3,nsmall=digits+3), "\nLower 95%-confidence limit: = RD - 1.96 * SE.RD = ", format(rd.lower,digits=digits+3,nsmall=digits+3), "\nUpper 95%-confidence limit: = RD + 1.96 * SE.RD = ", format(rd.upper,digits=digits+3,nsmall=digits+3), "\n\nThe estimated risk difference is ",format(100*rd,digits=digits,nsmall=digits),"% ", paste(" (CI_95%: [", format(100*rd.lower,digits=digits,nsmall=digits), ";", format(100*rd.upper,digits=digits,nsmall=digits), "]", sep = ""), ").\n",sep="")) } if ("rr" %in% stats){ rr <- x$rr se.rr <- x$se.rr rr.lower <- x$rr.lower rr.upper <- x$rr.upper cat(paste("\n_____________________________\n\nRisk ratio\n_____________________________\n\n", "Risk ratio = RR = p1/p2 = ", format(rr,digits=digits+3,nsmall=digits+3), "\nStandard error = SE.RR = sqrt((1-p1)/a+(1-p2)/c)= ", format(se.rr,digits=digits+3,nsmall=digits+3), "\nLower 95%-confidence limit: = RR * exp(- 1.96 * SE.RR) = ", format(rr.lower,digits=digits+3,nsmall=digits+3), "\nUpper 95%-confidence limit: = RR * exp(1.96 * SE.RR) = ", format(rr.upper,digits=digits+3,nsmall=digits+3), "\n\nThe estimated risk ratio is ",format(rr,digits=digits+2,nsmall=digits+2),"", paste(" (CI_95%: [", format(rr.lower,digits=digits+2,nsmall=digits+2), ";", format(rr.upper,digits=digits+2,nsmall=digits+2), "]", sep = ""), ").\n",sep="")) } if ("or" %in% stats){ or <- x$or se.or <- x$se.or or.lower <- x$or.lower or.upper <- x$or.upper cat(paste("\n_____________________________\n\nOdds ratio\n_____________________________\n\n", "Odds ratio = OR = (p1/(1-p1))/(p2/(1-p2)) = ", format(or,digits=digits+3,nsmall=digits+3), "\nStandard error = SE.OR = sqrt((1/a+1/b+1/c+1/d)) = ", format(se.or,digits=digits+3,nsmall=digits+3), "\nLower 95%-confidence limit: = OR * exp(- 1.96 * SE.OR) = ", format(or.lower,digits=digits+3,nsmall=digits+3), "\nUpper 95%-confidence limit: = OR * exp(1.96 * SE.OR) = ", format(or.upper,digits=digits+3,nsmall=digits+3), "\n\nThe estimated odds ratio is ",format(or,digits=digits+2,nsmall=digits+2),"", paste(" (CI_95%: [", format(or.lower,digits=digits+2,nsmall=digits+2), ";", format(or.upper,digits=digits+2,nsmall=digits+2), "]", sep = ""), ").\n",sep="")) } if ("chisq" %in% stats){ cat("\n_____________________________\n\nChi-square test\n_____________________________\n\n") print(chisq.test(table2x2)) } if ("fisher" %in% stats){ cat("\n_____________________________\n\nFisher's exact test\n_____________________________\n\n") print(fisher.test(table2x2)) } invisible(x) } Publish/R/canbe.numeric.R0000744000176200001440000000033114142666146014725 0ustar liggesuserscanbe.numeric <- function(x){ if (!is.character(x)) x <- as.character(x) u <- x[!is.na(x) & x!="NA"] test <- suppressWarnings(as.numeric(u)) if (any(is.na(test))) FALSE else TRUE } Publish/R/org.R0000744000176200001440000000047114142666146013010 0ustar liggesusers##' Wrapper for \code{publish(...,org=TRUE)} ##' ##' ##' @title Wrapper function for publish with output format org ##' @param x object to format as org ##' @param ... passed to publish ##' @return See publish ##' @author Thomas Alexander Gerds ##' @export org <- function(x,...){ publish(x,...,org=TRUE) } Publish/R/publish.CauseSpecificCox.R0000644000176200001440000001033614142666146017046 0ustar liggesusers##' Publish cause-specific Cox models ##' ##' The cause-specific hazard ratio's are combined into one table. ##' @title Tabulizing cause-specific hazard ratio from all causes with confidence limits and Wald test p-values. ##' @param object Cause-specific hazard model obtained with ##' \code{CSC}. ##' @param cause Show a table for this cause. If omitted, list all ##' causes. ##' @param confint.method See \code{regressionTable} ##' @param pvalue.method See \code{regressionTable} ##' @param factor.reference See \code{regressionTable} ##' @param units See \code{regressionTable} ##' @param print If \code{TRUE} print the table(s). ##' @param ... passed on to control formatting of parameters, ##' confidence intervals and p-values. See ##' \code{summary.regressionTable}. ##' @return Table with cause-specific hazard ratios, confidence limits and p-values. ##' @author Thomas Alexander Gerds ##' @examples ##' if (requireNamespace("riskRegression",quietly=TRUE)){ ##' library(riskRegression) ##' library(prodlim) ##' library(survival) ##' data(Melanoma,package="riskRegression") ##' fit1 <- CSC(list(Hist(time,status)~sex,Hist(time,status)~invasion+epicel+age), ##' data=Melanoma) ##' publish(fit1) ##' publish(fit1,pvalue.stars=TRUE) ##' publish(fit1,factor.reference="inline",units=list("age"="years")) ##' ##' # wide format (same variables in both Cox regression formula) ##' fit2 <- CSC(Hist(time,status)~invasion+epicel+age, data=Melanoma) ##' publish(fit2) ##' ##' # with p-values ##' x <- publish(fit2,print=FALSE) ##' table <- cbind(x[[1]]$regressionTable, ##' x[[2]]$regressionTable[,-c(1,2)]) ##' } ##' ##' @export publish.CauseSpecificCox <- function(object, cause, confint.method, pvalue.method, factor.reference="extraline", units=NULL, print=TRUE, ...){ if (missing(confint.method)) confint.method="default" if (missing(pvalue.method)) pvalue.method=switch(confint.method, "robust"={"robust"}, "simultaneous"={"simultaneous"}, "default") if (missing(cause)) { clist <- lapply(object$models,function(m){ ## m$call$data <- object$call$data pm <- regressionTable(m, pvalue.method=pvalue.method, confint.method=confint.method, print=FALSE, factor.reference=factor.reference, units=units,...) summary.regressionTable(pm,print=FALSE,...) }) cause1 <- clist[[1]]$regressionTable ## colnames(cause1) <- paste(names(object$models)[[1]],names(cause1),sep=".") cause2 <- clist[[2]]$regressionTable if (NROW(cause1)==NROW(cause2)){ table=cbind(cause1[,1:2],"A"=paste(cause1[,3],cause1[,4]),"B"=paste(cause2[,3],cause2[,4])) colnames(table)[3:4] <- object$causes }else{table <- NULL} ## colnames(cause2) <- paste(names(object$models)[[2]],names(cause2),sep=".") out <- clist } else{ m <- object$models[[cause]] ## m$call$data <- object$call$data pm <- regressionTable(m, pvalue.method=pvalue.method, confint.method=confint.method, print=FALSE, factor.reference=factor.reference, units=units,...) ## now pm is a regression table out <- summary.regressionTable(pm,print=FALSE,...)$regressionTable } if (print==TRUE) { if (is.null(table)) lapply(1:length(out),function(i){ publish(names(out)[[i]]) publish(out[[i]]$regressionTable) }) else{ publish(table,...) } } invisible(out) } #---------------------------------------------------------------------- ### publish.CauseSpecificCox.R ends here Publish/R/publish.default.R0000755000176200001440000000105614142666146015314 0ustar liggesusers##' @export publish.default <- function(object,digits=4,title,bold=TRUE,level=0,hrule=FALSE,title.level,title.hrule,...){ if (missing(title.level)) title.level <- max(level-1,1) if (missing(title.hrule)) title.hrule <- 0 if (!missing(title)) publish(x=title,level=title.level,hrule=title.hrule) if (is.numeric(object) | canbe.numeric(object)){ x <- format(object,digits=digits,nsmall=digits) } cat(paste("\n",paste(rep("*",level),collapse=""),ifelse(level>0," ",""),object,"\n",sep="")) if (hrule==TRUE) cat("\n----\n") } Publish/R/getFrequency.R0000744000176200001440000001171714222265355014663 0ustar liggesusersgetFrequency <- function(matrix, varnames, groupvar, groups, labels, stats, format,digits,big.mark=","){ totals <- vector(NCOL(matrix),mode="list") xlevels <- vector(NCOL(matrix),mode="list") names(totals) <- varnames groupfreq <- vector(NCOL(matrix),mode="list") names(groupfreq) <- varnames for (v in varnames){ vv <- matrix[,v,drop=FALSE] missing.v <- is.na(vv) if (is.factor(vv[[1]])) vvv <- factor(vv[!missing.v],levels=levels(vv[[1]])) else vvv <- factor(vv[!missing.v],levels=unique(vv[[1]])) xlevels[[v]] <- levels(vvv) ggg <- factor(groupvar[!missing.v], levels=levels(groupvar)) ## totals tab.v <- table(vvv) total.v <- sum(tab.v) s.tab.v <- sum(tab.v) if ("colpercent" %in% stats) perc.v <- (100*tab.v/s.tab.v) else perc.v <- rep(100,length(names(tab.v))) ## avoid NA when 0/0 perc.v[s.tab.v==0] <- 0 # format percent perc.v <- lapply(perc.v,function(p){ sprintf(fmt=paste("%1.",digits,"f",sep=""),p) }) totals[[v]] <- sapply(1:length(perc.v),function(i){ values <- list(tab.v[i],total.v,perc.v[i]) if ("colpercent" %in% stats) names(values) <- c("count","total","colpercent") else names(values) <- c("count","total","percent") if (big.mark!="") values[["count"]] <- format(values[["count"]],big.mark=big.mark,scientific=FALSE) do.call("sprintf",c(format,values[stats])) }) ## ## groups ## if (!is.null(groupvar) && !missing(groupvar) && length(groupvar)==NROW(matrix)){ tables <- lapply(split(ggg,vvv),function(x){ xtab <- data.frame(table(factor(x,levels=groups))) if (match("percent",stats,nomatch=FALSE)){ xtab$Percent <- 100*xtab$Freq/sum(xtab$Freq) ## avoid NA when 0/0 xtab$Percent[xtab$Freq==0] <- 0 # format percent xtab$Percent <- sprintf(fmt=paste("%1.",digits,"f",sep=""),xtab$Percent) } tab.out <- lapply(1:NROW(xtab),function(row){ values <- xtab[row,-1] if (match("colpercent",stats,nomatch=FALSE)){ values } else{ vals <- as.list(unlist(values)) if (pos.count <- match("count",stats,nomatch=FALSE)){ if (big.mark!="") vals[["Freq"]] <- format(as.numeric(vals[["Freq"]]),big.mark=big.mark,scientific=FALSE) if (pos.count==1) do.call("sprintf",c(format,vals)) else # pos.count==2 do.call("sprintf",c(format,rev(vals))) }else{ ## only percent do.call("sprintf",c(format,vals["Percent"])) } } }) names(tab.out) <- labels unlist(tab.out) }) groupfreq[[v]] <- do.call("rbind",tables) if (match("colpercent",stats,nomatch=FALSE)){ groupfreq[[v]] <- apply(groupfreq[[v]],2,function(x){ val <- as.numeric(x) colp <- 100*val/sum(val) ## avoid NA when 0/0 colp[sum(val)==0] <- 0 # format percent colp <- sprintf(fmt=paste("%1.",digits,"f",sep=""),colp) if (pos.count <- match("count",stats,nomatch=FALSE)){ if (big.mark!="") val <- format(val,big.mark=big.mark,scientific=FALSE) sapply(1:length(val),function(i){ if (pos.count==1){ do.call("sprintf",c(format,as.list(c(val[i],colp[i])))) } else{ # pos.count==2 do.call("sprintf",c(format,as.list(c(colp[i],val[i])))) } }) }else{ ## show colpercent without count sapply(1:length(val),function(i){ do.call("sprintf",c(format,as.list(colp[i]))) }) } }) ## for "variables" with only one level if (length(tables)==1){ groupfreq[[v]] <- matrix(groupfreq[[v]],ncol=length(tables[[1]])) colnames(groupfreq[[v]]) <- names(tables[[1]]) } } } } list(totals=totals,groupfreq=groupfreq,xlevels=xlevels) } Publish/R/print.ci.R0000755000176200001440000000157014142666146013752 0ustar liggesusers##' Print confidence intervals ##' ##' This format of the confidence intervals is user-manipulable. ##' @title Print confidence intervals ##' @param x Object containing point estimates and the corresponding ##' confidence intervals ##' @param se If \code{TRUE} add the standard error. ##' @param print Logical: if \code{FALSE} do not actually print ##' confidence intervals but just return them invisibly. ##' @param ... passed to summary.ci ##' @return A string: the formatted confidence intervals ##' @seealso ci plot.ci formatCI summary.ci ##' @examples ##' library(lava) ##' m <- lvm(Y~X) ##' m <- categorical(m,Y~X,K=4) ##' set.seed(4) ##' d <- sim(m,24) ##' ci.mean(Y~X,data=d) ##' x <- ci.mean(Y~X,data=d) ##' print(x,format="(l,u)") ##' @export ##' @author Thomas A. Gerds print.ci <- function(x,se=FALSE,print=TRUE,...){ summary(x,se=se,print=print,...) } Publish/R/publish.riskReclassification.R0000644000176200001440000000467015040356425020037 0ustar liggesusers### publish.riskReclassification.R --- #---------------------------------------------------------------------- ## author: Thomas Alexander Gerds ## created: Dec 10 2015 (10:06) ## Version: ## last-updated: Jul 24 2025 (09:13) ## By: Thomas Alexander Gerds ## Update #: 11 #---------------------------------------------------------------------- ## ### Commentary: ## ### Change Log: #---------------------------------------------------------------------- ## ### Code: ##' Publishing riskReclassification objects ##' ##' ##' @title Publishing riskReclassification objects ##' @param object riskReclassification object ##' @param percent Logical. If \code{TRUE} multiply risks by 100. ##' @param digits Rounding ##' @param ... Passed to \code{publish.matrix} ##' @author Thomas A. Gerds ##' @export publish.riskReclassification <- function(object,percent=TRUE,digits=ifelse(percent,1,2),...){ cat("Observed overall re-classification table:\n\n") dnames <- dimnames(object$reclassification) cat(names(dnames)[1]," versus ", names(dnames)[2],"\n") publish(object$reclassification,...) cat("\nExpected re-classification probabilities (%) among subjects with event until time ",object$time,"\n\n",sep="") fmt <- paste0("%1.", digits[[1]], "f") dim <- dim(object$reclassification) if (percent==TRUE){ rlist <- lapply(object$event.reclassification,function(x){ matrix(sprintf(fmt=fmt,100*c(x)),nrow=dim[1],ncol=dim[2],dimnames=dnames) }) }else{ rlist <- lapply(object$event.reclassification,function(x){ matrix(sprintf(fmt=fmt,c(x)),nrow=dim[1],ncol=dim[2],dimnames=dnames) }) } if (object$model=="competing.risks"){ for (x in 1:(length(rlist)-1)){ cat("\n",names(rlist)[x],":\n",sep="") publish(rlist[[x]],quote=FALSE,...) } } else{ cat("\n",names(rlist)[1],":\n",sep="") publish(rlist[[1]],quote=FALSE,...) } cat("\nExpected re-classification probabilities (%) among subjects event-free until time ",object$time,"\n\n",sep="") cat("\n",names(rlist)[length(rlist)],":\n",sep="") publish(rlist[[length(rlist)]],quote=FALSE,...) ## print.listof(rlist[length(rlist)],quote=FALSE) } #---------------------------------------------------------------------- ### publish.riskReclassification.R ends here Publish/R/table2x2.R0000644000176200001440000000520014142666146013636 0ustar liggesusers##' 2x2 table calculus for teaching ##' ##' 2x2 table calculus for teaching ##' @title 2x2 table calculus for teaching ##' @param x 2x2 table ##' @param digits rounding digits ##' @param conf.level Confidence level used for constructing confidence intervals. Default is 0.95. ##' @param stats subset or all of \code{c("table","rd","or","rr","chisq","fisher")} where rd= risk difference, rr = risk ratio, or = odds ratio, chisq = chi-square test, fisher= fisher's exact test and table = the 2x2 table ##' @return see example ##' @examples ##' table2x2(table("marker"=rbinom(100,1,0.4),"response"=rbinom(100,1,0.1))) ##' table2x2(matrix(c(71,18,38,8),ncol=2),stats="table") ##' table2x2(matrix(c(71,18,38,8),ncol=2),stats=c("rr","fisher")) ##' @export ##' @author Thomas A. Gerds table2x2 <- function(x, digits=1, conf.level=0.95, stats=c("table","rd","rr","or","chisq","fisher")){ if (class(x)[1]=="data.frame"){ table2x2 <- as.matrix(x) } else{ if ("matrix"%in%class(x)||"table" %in% class(x)){ if ("table"%in%class(x)){table2x2 <- as.matrix(x)} else table2x2 <- x } else{ stop("first argument `x' must be a matrix or a data.frame") } } if (NROW(x)!=2) stop("Matrix must have exactly 2 rows") if (NCOL(x)!=2) stop("Matrix must have exactly 2 columns") a <- table2x2[1,1] b <- table2x2[1,2] c <- table2x2[2,1] d <- table2x2[2,2] p1 <- a/(a+b) p2 <- c/(c+d) ## ## test statistic ## n <- (a+b+c+d) ## chi2test <- (a*d-b*c)^2*n/((a+c)*(b+d)*(a+b)*(c+d)) ## 2x2 table out <- list(table2x2=table2x2,stats=stats) if ("rd" %in% stats){ rd <- (p1-p2) se.rd <- sqrt(p1*(1-p1)/(a+b)+p2*(1-p2)/(c+d)) rd.lower <- rd - qnorm(1-(1-conf.level)/2)*se.rd rd.upper <- rd + qnorm(1-(1-conf.level)/2)*se.rd out <- c(out,list(rd=rd,se.rd=se.rd,rd.lower=rd.lower,rd.upper=rd.upper)) } if ("rr" %in% stats){ rr <- p1/p2 se.rr <- sqrt((1-p1)/a+(1-p2)/c) rr.lower <- rr * exp(- qnorm(1-(1-conf.level)/2) * se.rr) rr.upper <- rr * exp( qnorm(1-(1-conf.level)/2) * se.rr) out <- c(out,list(rr=rr,se.rr=se.rr,rr.lower=rr.lower,rr.upper=rr.upper)) } if ("or" %in% stats){ or <- (a*d)/(b*c) se.or <- sqrt(1/a+1/b+1/c+1/d) or.lower <- exp(log(or) - qnorm(1-(1-conf.level)/2)*se.or) or.upper <- exp(log(or) + qnorm(1-(1-conf.level)/2)*se.or) out <- c(out,list(or=or,se.or=se.or,or.lower=or.lower,or.upper=or.upper)) } class(out) <- "table2x2" out } Publish/R/specialFrame.R0000644000176200001440000001441315040352502014576 0ustar liggesusers##' Extract data and design matrix including specials from call ##' ##' Obtain a list with the data used for event history regression analysis. This ##' function cannot be used directly on the user level but inside a function ##' to prepare data for survival analysis. ##' @title Special frame ##' @param formula Formula whose left hand side specifies the event ##' history, i.e., either via Surv() or Hist(). ##' @param data Data frame in which the formula is interpreted ##' @param unspecials.design Passed as is to ##' \link[prodlim]{model.design}. ##' @param specials Character vector of special function names. ##' Usually the body of the special functions is function(x)x but ##' e.g., \link[survival]{strata} does treat ##' the values ##' @param specials.factor Passed as is to \link[prodlim]{model.design}. ##' @param specials.design Passed as is to \link[prodlim]{model.design} ##' @param strip.specials Passed as \code{specials} to ##' \link[prodlim]{strip.terms} ##' @param strip.arguments Passed as \code{arguments} to ##' \link[prodlim]{strip.terms} ##' @param strip.alias Passed as \code{alias.names} to ##' \link[prodlim]{strip.terms} ##' @param strip.unspecials Passed as \code{unspecials} to ##' \link[prodlim]{strip.terms} ##' @param drop.intercept Passed as is to \link[prodlim]{model.design} ##' @param response If FALSE do not get response data. ##' @param na.action Decide what to do with missing values. ##' @return A list which contains ##' - the response ##' - the design matrix (see \link[prodlim]{model.design}) ##' - one entry for each special (see \link[prodlim]{model.design}) ##' @seealso model.frame model.design Hist ##' @examples ##' ##' ## Here are some data with an event time and no competing risks ##' ## and two covariates X1 and X2. ##' ## Suppose we want to declare that variable X1 is treated differently ##' ## than variable X2. For example, X1 could be a cluster variable, or ##' ## X1 should have a proportional effect on the outcome. ##' d <- data.frame(y=1:7, ##' X2=c(2.24,3.22,9.59,4.4,3.54,6.81,5.05), ##' X3=c(1,1,1,1,0,0,1), ##' X4=c(44.69,37.41,68.54,38.85,35.9,27.02,41.84), ##' X1=factor(c("a","b","a","c","c","a","b"), ##' levels=c("c","a","b"))) ##' ## define special functions prop and cluster ##' prop <- function(x)x ##' cluster <- function(x)x ##' ## We pass a formula and the data ##' e <- specialFrame(y~prop(X1)+X2+cluster(X3)+X4, ##' data=d, ##' specials=c("prop","cluster")) ##' ## The first element is the response ##' e$response ##' ## The other elements are the design, i.e., model.matrix for the non-special covariates ##' e$design ##' ## and a data.frame for the special covariates ##' e$prop ##' ## The special covariates can be returned as a model.matrix ##' e2 <- specialFrame(y~prop(X1)+X2+cluster(X3)+X4, ##' data=d, ##' specials=c("prop","cluster"), ##' specials.design=TRUE) ##' e2$prop ##' ## and the non-special covariates can be returned as a data.frame ##' e3 <- specialFrame(y~prop(X1)+X2+cluster(X3)+X4, ##' data=d, ##' specials=c("prop","cluster"), ##' specials.design=TRUE, ##' unspecials.design=FALSE) ##' e3$design ##' @export ##' @author Thomas A. Gerds specialFrame <- function(formula, data, unspecials.design=TRUE, specials, specials.factor=TRUE, specials.design=FALSE, strip.specials=TRUE, strip.arguments=NULL, strip.alias=NULL, strip.unspecials=NULL, drop.intercept=TRUE, response=TRUE, na.action=options()$na.action){ # {{{ get all variables and remove missing values ## get_all_vars fails when data.frame contains labelled variables (Hmisc) ## if (na.action %in% c("na.omit","na.fail","na.exclude") || is.function(na.action)) ## mm <- do.call(na.action,list(object=get_all_vars(formula,data))) ## else ## mm <- get_all_vars(formula,data) # }}} # {{{call model.frame ## data argument is used to resolve '.' see help(terms.formula) if (!is.null(strip.specials)){ ## eval without the data to avoid evaluating special specials # Terms <- terms(x=formula, specials=unique(c(specials,unlist( strip.alias)))) Terms <- terms(x=formula, specials=specials) Terms <- prodlim::strip.terms(Terms, specials=strip.specials, arguments= strip.arguments, alias.names= strip.alias, unspecials= strip.unspecials) }else{ ## data argument is used to resolve '.' see help(terms.formula) Terms <- terms(x=formula, specials=specials, data = data) } ## mm <- na.omit(get_all_vars(formula(Terms),data)) mm <- do.call(na.action,list(get_all_vars(formula(Terms),data))) #mm <- model.frame(formula=formula(Terms),data=data,na.action=na.action) if (NROW(mm) == 0) stop("No (non-missing) observations") # {{{ extract response if (response==TRUE && attr(Terms,"response")!=0){ response <- model.frame(update(formula,".~1"), data=mm,na.action="na.pass") }else response <- NULL # }}} # {{{ design design <- prodlim::model.design(Terms, data=mm, maxOrder=1, dropIntercept=drop.intercept, unspecialsDesign=unspecials.design, specialsFactor=specials.factor, specialsDesign=specials.design) # }}} out <- c(list(response=response), design[sapply(design,length)>0]) attr(out,"Terms") <- Terms attr(out,"na.action") <- attr(mm,"na.action") class(out) <- "specialFrame" out } ##' @export as.data.frame.specialFrame <- function(x,...){ Y <- data.frame(unclass(x$response)) X <- do.call("cbind",x[-1]) cbind(Y,X) } Publish/R/lhs.R0000744000176200001440000000006514142666146013006 0ustar liggesuserslhs <- function(formula){ update(formula,.~NULL) } Publish/R/publish.univariateTable.R0000755000176200001440000000014414142666146017004 0ustar liggesusers##' @export publish.univariateTable <- function(object,...){ publish(summary(object,...),...) } Publish/R/Units.R0000644000176200001440000000317114142666146013322 0ustar liggesusers### Units.R --- #---------------------------------------------------------------------- ## author: Thomas Alexander Gerds ## created: Apr 9 2015 (10:35) ## Version: ## last-updated: Apr 9 2015 (10:54) ## By: Thomas Alexander Gerds ## Update #: 8 #---------------------------------------------------------------------- ## ### Commentary: ## ### Change Log: #---------------------------------------------------------------------- ## ### Code: ##' Add variable units to data.frame (or data.table). ##' ##' If the object has units existing units are replaced by given units. ##' @title Add units to data set ##' @param object A data.frame or data.table ##' @param units Named list of units. Names are variable names. If omitted, show existing units. ##' @return ##' The object augmented with attribute \code{"units"} ##' @examples ##' data(Diabetes) ##' Diabetes <- Units(Diabetes,list(BMI="kg/m^2")) ##' Units(Diabetes) ##' Diabetes <- Units(Diabetes,list(bp.1s="mm Hg",bp.2s="mm Hg")) ##' Units(Diabetes) ##' @export ##' @author Thomas A. Gerds Units <- function(object,units){ stopifnot("data.frame" %in% class(object)) if (missing(units)){ return(attr(object,"units")) } else{ old.units <- attr(object,"units") if (is.null(old.units)) attr(object,"units") <- units else{ new.units <- c(units,old.units) new.units <- new.units[!duplicated(names(new.units))] attr(object,"units") <- new.units } } object } #---------------------------------------------------------------------- ### Units.R ends here Publish/R/summary.subgroupAnalysis.R0000644000176200001440000000605114142666146017266 0ustar liggesusers#' @title summary.subgroupAnalysis #' @description #' This function operates on a "subgroupAnalysis" object to produce a formatted #' table. #' @author Christian Torp-Pedersen #' @param object - a subgroupAnalysis object #' @param digits - number of digits for risk ratios #' @param eps - lowest value of p to be shown exactly, others will be "|^[ 0-9.]+",object)] <- paste("$",object[grep("<|>|^[ 0-9.]+",object)],"$") } cat(startrow,paste(object,collapse=collapse.row),endrow) } else{ for (r in 1:NROW(object)){ ## apply(object,1,function(object){ row.x <- object[r,,drop=TRUE] ## extra lines if (!is.null(inter.lines[[as.character(r)]])) cat(inter.lines[[as.character(r)]],"\n") ## protect numbers if (latex && latex.nodollar==FALSE){# if (latex) row.x[grep("<|>|^[ 0-9.]+",row.x)]=paste("$",row.x[grep("<|>|^[ 0-9.]+",row.x)],"$") } if (latex && latex.hline && object[[1]]!="") cat("\\hline\n") cat(startrow,paste(row.x,collapse=collapse.row),endrow) } } # }}} # {{{ footer if(latex && tabular==FALSE) NULL else cat(endtable) # }}} invisible(object) } Publish/R/publish.riskRegression.R0000644000176200001440000000257715040352070016671 0ustar liggesusers##' Preparing a publishable table from riskRegression results ##' ##' ##' @title Publishing results of riskRegression ##' @param object object of class riskRegression as obtained with ##' functions ARR and LRR. ##' @param digits Number of digits for regression coefficients ##' @param print If \code{FALSE} do not print the results ##' @param ... passed to \link{publish.matrix} ##' @return Table with regression coefficients, confidence intervals and p-values ##' @seealso ARR LRR ##' @examples ##' if (requireNamespace("riskRegression",quietly=TRUE)){ ##' library(riskRegression) ##' library(prodlim) ##' library(lava) ##' library(survival) ##' set.seed(20) ##' d <- SimCompRisk(20) ##' f <- ARR(Hist(time,event)~X1+X2,data=d,cause=1) ##' publish(f) ##' publish(f,digits=c(1,3)) ##' } ##' @export ##' @author Thomas A. Gerds publish.riskRegression <- function(object, digits=c(2,4), print=TRUE, ...) { if (length(digits)==1) digits <- rep(digits,2) sv <- summary(object,verbose=FALSE,digits=digits[[1]],eps=10^{-digits[[2]]}) out <- sv[,c("Factor","exp(Coef)","CI_95","Pvalue")] modeltype <- if (as.name("LRR")==object$call[[1]]) "LRR" else "ARR" colnames(out) <- c("Factor",modeltype,"CI_95","p-value") if (print) publish(out,...) invisible(out) } Publish/R/publish.MIresult.R0000644000176200001440000001577314142666146015444 0ustar liggesusers### publish.MIresult.R --- #---------------------------------------------------------------------- ## Author: Thomas Alexander Gerds ## Created: Aug 17 2017 (09:52) ## Version: ## Last-Updated: Dec 1 2020 (16:48) ## By: Thomas Alexander Gerds ## Update #: 52 #---------------------------------------------------------------------- ### Code: #' Regression tables after multiple imputations #' #' Show results of smcfcs based multiple imputations of missing covariates in publishable format #' @title Present logistic regression and Cox regression obtained with mitools::MIcombine based on smcfcs::smcfcs multiple imputation analysis #' @param object Object obtained with mitools::MIcombine based on smcfcs::smcfcs multiple imputation analysis #' @param confint.method No options here. Only Wald type confidence #' intervals. #' @param pvalue.method No options here. Only Wald type tests. #' @param digits Rounding digits for all numbers but the p-values. #' @param print If \code{FALSE} suppress printing of the results #' @param factor.reference Style for showing results for #' categorical. See \code{regressionTable}. #' @param intercept See \code{regressionTable}. #' @param units See \code{regressionTable}. #' @param fit One fitted model using the same formula as #' \code{object}. This can be the fit to the complete case data or #' the fit to one of the completed data. It is used to get #' xlevels, formula and terms. For usage see examples. is used to #' fit #' @param data Original data set which includes the missing values #' @param ... passed to summary.regressionTable, labelUnits and publish.default. #' @examples #' #' \dontrun{ #' if (requireNamespace("riskRegression",quietly=TRUE) #' & requireNamespace("mitools",quietly=TRUE) #' & requireNamespace("smcfcs",quietly=TRUE)){ #' library(riskRegression) #' library(mitools) #' library(smcfcs) #' ## continuous outcome: linear regression #' # lava some data with missing values #' set.seed(7) #' d=sampleData(78) #' ## generate missing values #' d[X1==1,X6:=NA] #' d[X2==1,X3:=NA] #' d=d[,.(X8,X4,X3,X6,X7)] #' sapply(d,function(x)sum(is.na(x))) #' #' # multiple imputation (should set m to a large value) #' #' set.seed(17) #' f= smcfcs(d,smtype="lm", #' smformula=X8~X4+X3+X6+X7, #' method=c("","","logreg","norm",""),m=3) #' ccfit=lm(X8~X4+X3+X6+X7,data=d) #' mifit=MIcombine(with(imputationList(f$impDatasets), #' lm(X8~X4+X3+X6+X7))) #' publish(mifit,fit=ccfit,data=d) #' publish(ccfit) #' #' ## binary outcome #' # lava some data with missing values #' set.seed(7) #' db=sampleData(78,outcome="binary") #' ## generate missing values #' db[X1==1,X6:=NA] #' db[X2==1,X3:=NA] #' db=db[,.(Y,X4,X3,X6,X7)] #' sapply(db,function(x)sum(is.na(x))) #' #' # multiple imputation (should set m to a large value) #' set.seed(17) #' fb= smcfcs(db,smtype="logistic", #' smformula=Y~X4+X3+X6+X7, #' method=c("","","logreg","norm",""),m=2) #' ccfit=glm(Y~X4+X3+X6+X7,family="binomial",data=db) #' mifit=MIcombine(with(imputationList(fb$impDatasets), #' glm(Y~X4+X3+X6+X7,family="binomial"))) #' publish(mifit,fit=ccfit) #' publish(ccfit) #' #' ## survival: Cox regression #' library(survival) #' # lava some data with missing values #' set.seed(7) #' ds=sampleData(78,outcome="survival") #' ## generate missing values #' ds[X5==1,X6:=NA] #' ds[X2==1,X3:=NA] #' ds=ds[,.(time,event,X4,X3,X6,X7)] #' sapply(ds,function(x)sum(is.na(x))) #' #' set.seed(17) #' fs= smcfcs(ds,smtype="coxph", #' smformula="Surv(time,event)~X4+X3+X6+X7", #' method=c("","","","logreg","norm",""),m=2) #' ccfit=coxph(Surv(time,event)~X4+X3+X6+X7,data=ds) #' mifit=MIcombine(with(imputationList(fs$impDatasets), #' coxph(Surv(time,event)~X4+X3+X6+X7))) #' publish(mifit,fit=ccfit,data=ds) #' publish(ccfit) #' #' ## competing risks: Cause-specific Cox regression #' library(survival) #' # lava some data with missing values #' set.seed(7) #' dcr=sampleData(78,outcome="competing.risks") #' ## generate missing values #' dcr[X5==1,X6:=NA] #' dcr[X2==1,X3:=NA] #' dcr=dcr[,.(time,event,X4,X3,X6,X7)] #' sapply(dcr,function(x)sum(is.na(x))) #' #' set.seed(17) #' fcr= smcfcs(dcr,smtype="compet", #' smformula=c("Surv(time,event==1)~X4+X3+X6+X7", #' "Surv(time,event==2)~X4+X3+X6+X7"), #' method=c("","","","logreg","norm",""),m=2) #' ## cause 2 #' ccfit2=coxph(Surv(time,event==2)~X4+X3+X6+X7,data=dcr) #' mifit2=MIcombine(with(imputationList(fcr$impDatasets), #' coxph(Surv(time,event==2)~X4+X3+X6+X7))) #' publish(mifit2,fit=ccfit2,data=dcr) #' publish(ccfit2) #' } #'} #' #' @author Thomas A. Gerds #' @export publish.MIresult <- function(object, confint.method, pvalue.method, digits=c(2,4), print=TRUE, factor.reference="extraline", intercept, units=NULL, fit, data, ...){ pvalMIresult <- function(object){ se <- sqrt(diag(stats::vcov(object))) p <- 2*stats::pnorm(-abs(object$coef/se)) p } if (missing(fit)) stop("Need the model fitted in the complete cases.") object$xlevels <- fit$xlevels object$formula <- fit$formula if (missing(data)){ if (is.null(fit$data)) stop("Need original data set via argument 'data' because argument 'fit' does not provide them.") else{ object$data <- fit$data } }else object$data <- data object$terms <- fit$terms ## make sure that a coxph object is treated as such class(object) <- c(class(object),class(fit)) ## make sure that a logistic regression is treated as such if ('glm' %in% class(fit)) object$family <- fit$family if (!missing(confint.method) && confint.method!="default") stop("Can only do simple Wald confidence intervals based on MIresults.") if (!missing(pvalue.method)) stop("Can only do simple Wald test p-values based on MIresults.") if (missing(intercept)){ intercept <- 1*(class(fit)[1] == "lm" || (class(fit)[1]=="glm" && stats::family(fit)!="binomial")) } rt <- regressionTable(object, confint.method="default", pvalue.method=pvalMIresult, factor.reference=factor.reference, intercept=intercept, units=units) srt <- summary.regressionTable(rt, digits=digits, print=FALSE,...) XXsrt <- do.call(labelUnits,c(list(x=srt),list(...),srt$Variable)) if (print==TRUE) publish(srt$regressionTable,...) invisible(srt) } ###################################################################### ### publish.MIresult.R ends here Publish/R/publish.table.R0000755000176200001440000000202514142666146014754 0ustar liggesusers##' @export publish.table <- function(object,title,level,...){ if ((NM=length(dim(object)))==3){ if (missing(title)) title <- "" stopifnot(NM<=4) invisibleOut=lapply(1:(dim(object)[NM]),function(m){ newtitle=paste(title,paste(names(dimnames(object))[NM],dimnames(object)[[NM]][m],sep=":")) xm <- object[,,m] colnames(xm) <- paste(names(dimnames(object))[2],dimnames(object)[[2]],sep=":") rownames(xm) <- paste(names(dimnames(object))[1],dimnames(object)[[1]],sep=":") publish(xm,title=newtitle,level=level) }) } else{ v <- as.matrix(object) nn <- names(dimnames(v)) if (is.null(nn)) if (is.matrix(object)) nn <- paste("Var",1:2,sep=".") else nn <- "Var.1" nn[nn==""] <- paste("Var",(1:length(nn))[nn==""],sep=".") rownames <- TRUE ## if (missing(title)) title <- paste("Frequency table:",nn[1],"versus",nn[2],sep=" ") if (missing(title)) title <- "" if (missing(level)) level <- 0 publish.matrix(v,title,level=level,rownames=rownames,...) } } Publish/R/parseInteractionTerms.R0000644000176200001440000002432714142666146016553 0ustar liggesusers##' Parse interaction terms for regression tables ##' ##' Prepare a list of contrasts which combines regression coefficients ##' to describe statistical interactions. ##' @title Parse interaction terms ##' @param terms Terms of a formula ##' @param xlevels Factor levels corresponding to the variables in ##' \code{terms} ##' @param units named list with unit labels. names should match variable names in formula. ##' @param format.factor For categorical variables. A string which specifies the print format for factor labels. ##' The string has to contain the keywords \code{"var"} and \code{"level"} which will be ##' replaced by the name of the variable and the current level, respectively. ##' Default is \code{"var(level)"}. ##' @param format.contrast For categorical variables. A string which specifies the print format for constrast statements. ##' The string has to contain the keywords \code{"var"}, \code{"level"} and \code{"ref"} which will be ##' replaced by the name of the variable, the current level and the reference level, respectively. ##' @param format.scale A string which specifies the print format for continuous variables without units. ##' The string has to contain the keyword \code{"var"} which will be ##' replaced by the name of the variable and the unit, respectively. ##' Default is \code{"var"}. ##' @param format.scale.unit A string which specifies the print format for continuous variables with units. ##' The string has to contain the keywords \code{"var"} and \code{"unit"} which will be ##' replaced by the name of the variable and the unit, respectively. ##' Default is \code{"var(unit)"}. ##' @param sep a character string to separate the terms. Default is \code{": "}. ##' @param ... Not yet used ##' @return List of contrasts which can be passed to ##' \code{lava::estimate}. ##' @seealso lava::estimate ##' @examples ##' ##' tt <- terms(formula(SBP~age+sex*BMI)) ##' xlev <- list(sex=c("male","female"),BMI=c("normal","overweight","obese")) ##' parseInteractionTerms(terms=tt,xlevels=xlev) ##' parseInteractionTerms(terms=tt,xlevels=xlev,format.factor="var level") ##' parseInteractionTerms(terms=tt,xlevels=xlev,format.contrast="var(level:ref)") ##' ##' tt2 <- terms(formula(SBP~age*factor(sex)+BMI)) ##' xlev2 <- list("factor(sex)"=c("male","female")) ##' parseInteractionTerms(terms=tt2,xlevels=xlev2) ##' parseInteractionTerms(terms=tt2,xlevels=xlev2,units=list(age="yrs")) ##' ##' ##' data(Diabetes) ##' fit <- glm(bp.2s~age*factor(gender)+BMI,data=Diabetes) ##' parseInteractionTerms(terms=terms(fit$formula),xlevels=fit$xlevels, ##' format.scale="var -- level:ref",units=list("age"='years')) ##' parseInteractionTerms(terms=terms(fit$formula),xlevels=fit$xlevels, ##' format.scale.unit="var [unit]",units=list("age"='years')) ##' it <- parseInteractionTerms(terms=terms(fit$formula),xlevels=fit$xlevels) ##' ivars <- unlist(lapply(it,function(x)attr(x,"variables"))) ##' lava::estimate(fit,function(p)lapply(unlist(it),eval,envir=sys.parent(-1))) ##' ##' ##' @export ##' @author Thomas A. Gerds parseInteractionTerms <- function(terms, xlevels, units, format.factor, format.contrast, format.scale, format.scale.unit, sep=": ", ...){ if(any(attr(terms,"order")>2)) stop("Interaction terms with order greater than 2 are not supported.") ilabs <- attr(terms,"term.labels")[attr(terms,"order")==2] inter.list <- strsplit(ilabs,":") intervars <- unique(unlist(inter.list)) if (missing(units)) units <- NULL if (length(inter.list)>0){ if (missing(format.factor)){ format.factor <- "var(level)" }else{ stopifnot(length(grep("var",format.factor))>0) stopifnot(length(grep("level",format.factor))>0) } if (missing(format.scale.unit)){ format.scale.unit <- "var(unit)" }else{ stopifnot(length(grep("var",format.scale.unit))>0) stopifnot(length(grep("unit",format.scale.unit))>0) } if (missing(format.scale)){ format.scale <- "var" }else{ stopifnot(length(grep("var",format.scale))>0) } if (missing(format.contrast)){ format.contrast <- "var(level vs ref)" }else{ stopifnot(length(grep("var",format.contrast))>0) stopifnot(length(grep("level",format.contrast))>0) stopifnot(length(grep("ref",format.contrast))>0) } format.factor <- sub("var","%s",format.factor) format.factor <- sub("level","%s",format.factor) format.contrast <- sub("level","%s",format.contrast) format.contrast <- sub("ref","%s",format.contrast) format.contrast <- sub("var","%s",format.contrast) format.scale <- sub("var","%s",format.scale) format.scale.unit <- sub("var","%s",format.scale.unit) format.scale.unit <- sub("unit","%s",format.scale.unit) iterms <- lapply(inter.list,function(vv){ v1 <- vv[1] ref1 <- xlevels[[v1]][[1]] v2 <- vv[2] ref2 <- xlevels[[v2]][[1]] if (is.null(ref1)){ if (is.null(ref2)){ stop(paste("Can only handle interactions when at least one variable is a factor.\nBut argument xlevels contains no entry for either", v1, "or", v2)) } else{ ## v1 is continuous, v2 is a factor ## model includes coef for one-unit change of v1 at ref2 ## need to ask for coef for one-unit change of v1 at other levs levs2 <- xlevels[[v2]] u1 <- units[[v1]] if (is.null(u1)) { labs <- sapply(levs2,function(l){ paste(sprintf(format.scale,v1),sprintf(format.factor,v2,l),sep=sep) }) }else{ labs <- sapply(levs2,function(l){ paste(sprintf(format.scale.unit,v1,u1),sprintf(format.factor,v2,l),sep=sep) }) } ## collect the corresponding coefficients contrast <- lapply(1:length(levs2),function(l){ if (l==1) x <- bquote(p[.(v1)]) else bquote(p[.(v1)]+p[.(paste(v1,":",paste(v2,levs2[[l]],sep=""),sep=""))]) }) names(contrast) <- labs attr(contrast,"variables") <- c(v1,v2) return(contrast) } }else{ if (is.null(ref2)){ ## v2 is continuous, v1 is a factor ## model includes coef for one-unit change of v2 at ref1 ## need to ask for coef for one-unit change of v2 at other levs levs1 <- xlevels[[v1]] u2 <- units[[v2]] if (is.null(u2)) { labs <- sapply(levs1,function(l){ paste(sprintf(format.scale,v2),sprintf(format.factor,v1,l),sep=sep) }) }else{ labs <- sapply(levs1,function(l){ paste(sprintf(format.scale.unit,v2,u2),sprintf(format.factor,v1,l),sep=sep) }) } ## collect the corresponding coefficients contrast <- lapply(1:length(levs1),function(l){ if (l==1) bquote(p[.(v2)]) else bquote(p[.(v2)]+p[.(paste(paste(v1,levs1[[l]],sep=""),":",v2,sep=""))]) }) names(contrast) <- labs attr(contrast,"variables") <- c(v1,v2) return(contrast) } else{ ## both are factors levs1 <- xlevels[[v1]] levs2 <- xlevels[[v2]] labs1 <- paste(rep(sprintf(format.factor,v1,levs1),rep(length(levs2)-1,length(levs1))), sprintf(format.contrast,v2,levs2[-1],levs2[1]),sep=sep) contrast1 <- unlist(lapply(1:length(levs1),function(l1){ if (l1==1) lapply(2:(length(levs2)),function(l2){bquote(p[.(paste(v2,levs2[l2],sep=""))])}) else lapply(2:(length(levs2)),function(l2){ bquote(p[.(paste(v2,levs2[l2],sep=""))]+p[.(paste(paste(v1,levs1[l1],sep=""),":",paste(v2,levs2[l2],sep=""),sep=""))]) }) })) names(contrast1) <- labs1 labs2 <- paste(rep(sprintf(format.factor,v2,levs2),rep(length(levs1)-1,length(levs2))), sprintf(format.contrast,v1,levs1[-1],levs1[1]),sep=sep) contrast2 <- unlist(lapply(1:length(levs2),function(l2){ if (l2==1) lapply(2:(length(levs1)),function(l1){bquote(p[.(paste(v1,levs1[l1],sep=""))])}) else lapply(2:(length(levs1)),function(l1){ ## need to reverse order in name of interaction term bquote(p[.(paste(v1,levs1[l1],sep=""))]+p[.(paste(paste(v1,levs1[l1],sep=""),":",paste(v2,levs2[l2],sep=""),sep=""))]) }) })) names(contrast2) <- labs2 contrast <- c(contrast1,contrast2) attr(contrast,"variables") <- c(v1,v2) return(contrast) } } }) names(iterms) <- ilabs iterms } } Publish/R/ci.mean.R0000744000176200001440000000052414142666146013532 0ustar liggesusers##' Compute mean values with confidence intervals ##' ##' Normal approximation ##' @title Compute mean values with confidence intervals ##' @param x object passed to methods ##' @param ... passed to methods ##' @return a list with mean values and confidence limits ##' @export ci.mean <- function(x,...){ UseMethod("ci.mean",object=x) } Publish/R/rhs.R0000744000176200001440000000006514142666146013014 0ustar liggesusersrhs <- function(formula){ update(formula,NULL~.) } Publish/R/publish.Score.R0000644000176200001440000000474014142666146014743 0ustar liggesusers### publish.Score.R --- #---------------------------------------------------------------------- ## Author: Thomas Alexander Gerds ## Created: Jun 10 2017 (17:47) ## Version: ## Last-Updated: Dec 1 2020 (16:49) ## By: Thomas Alexander Gerds ## Update #: 17 #---------------------------------------------------------------------- ## ### Commentary: ## ### Change Log: #---------------------------------------------------------------------- ## ### Code: ##' Write output of \code{riskRegression::Score} in tables ##' ##' Collect prediction accuracy results in tables ##' @title Publish predictive accuracy results ##' @param object Object obtained with \code{riskRegression::Score} ##' @param metrics Which metrics to put into tables. Defaults to ##' \code{object$metrics}. ##' @param score Logical. If \code{TRUE} print the score elements, i.e., metric applied to the risk prediction models. ##' @param contrasts Logical. If \code{TRUE} print the contrast elements (if any). These compare risk prediction models according to metrics. ##' @param level Level of subsection headers, i.e., ** for level 2 and ##' *** for level 3 (useful for emacs org-users). Default is plain ##' subsection headers no stars. A negative value will suppress ##' subjection headers. ##' @param ... Passed to publish ##' @return Results of Score in tabular form ##' @examples ##' if (requireNamespace("riskRegression",quietly=TRUE)){ ##' library(riskRegression) ##' library(survival) ##' learn = sampleData(100) ##' val= sampleData(100) ##' f1=CSC(Hist(time,event)~X1+X8,data=learn) ##' f2=CSC(Hist(time,event)~X1+X5+X6+X8,learn) ##' xs=Score(list(f1,f2),data=val,formula=Hist(time,event)~1) ##' publish(xs) ##' } ##' @export ##' @author Thomas A. Gerds publish.Score <- function(object,metrics,score=TRUE,contrasts=TRUE,level=3,...){ if (missing(metrics)) metrics <- object$metrics for (m in metrics){ if (level>0){ publish(paste0("Metric ",m,":\n"),level=level,...) publish("Assessment of predictive accuracy",level=level+1) } if (score){ publish(object[[m]]$score, ...) } if (contrasts && !is.null(object[[m]]$contrasts)){ if (level>0){ org("Comparison of predictive accuracy",level=level+1) } publish(object[[m]]$contrasts, ...) } } } ###################################################################### ### publish.Score.R ends here Publish/R/pubformat.R0000644000176200001440000000336714142666146014226 0ustar liggesusers### pubformat.R --- #---------------------------------------------------------------------- ## author: Thomas Alexander Gerds ## created: Feb 21 2015 (10:34) ## Version: ## last-updated: Feb 21 2015 (10:46) ## By: Thomas Alexander Gerds ## Update #: 5 #---------------------------------------------------------------------- ## ### Commentary: ## ### Change Log: #---------------------------------------------------------------------- ## ### Code: ##' Format numbers according to a specified handler function. ##' Currently supported are sprintf, format and prettyNum. ##' ##' @title Format numbers for publication ##' @param x numeric vector ##' @param digits number of digits ##' @param nsmall see handler ##' @param handler String specififying the name of the function which should ##' perform the formatting. See \code{sprintf}, \code{format} and \code{prettyNum}. ##' @param ... Passed to handler function if applicable, i.e., not to \code{sprintf}. ##' @return Formatted number ##' @seealso \code{sprintf}, \code{format}, \code{prettyNum} ##' @examples ##' ##' pubformat(c(0.000143,12.8,1)) ##' pubformat(c(0.000143,12.8,1),handler="format") ##' pubformat(c(0.000143,12.8,1),handler="format",trim=TRUE) ##' pubformat(c(0.000143,12.8,1),handler="prettyNum") ##' @export ##' @author Thomas A. Gerds pubformat <- function(x,digits=2, nsmall=digits, handler="sprintf",...){ if (handler=="sprintf"){ fmt <- paste0("%1.",digits[[1]],"f")} if (handler=="sprintf"){ sprintf(fmt=fmt,x) }else{ do.call(handler,list(x,digits=digits[[1]],nsmall=nsmall,...)) } } #---------------------------------------------------------------------- ### pubformat.R ends here Publish/R/prepareLabels.R0000644000176200001440000000445514142666146015007 0ustar liggesusers### prepareLabels.R --- #---------------------------------------------------------------------- ## author: Thomas Alexander Gerds ## created: May 13 2015 (07:21) ## Version: ## last-updated: Mar 5 2018 (19:39) ## By: Thomas Alexander Gerds ## Update #: 18 #---------------------------------------------------------------------- ## ### Commentary: ## ### Change Log: #---------------------------------------------------------------------- ## ### Code: prepareLabels <- function(labels,titles,...){ labs <- labels tits <- titles labels <- labs$labels titles <- tits$labels labs$labels <- NULL tits$labels <- NULL if (is.matrix(labels)) { cnames <- colnames(labels) labels <- lapply(1:ncol(labels),function(j)labels[,j]) names(labels) <- cnames } if (is.factor(labels) || is.numeric(labels) || is.character(labels)) labels <- list(" "=labels) ncolumns <- length(labels) if (is.null(titles)){ titles <- names(labels) do.titles <- TRUE if (is.null(titles)){ do.titles <- FALSE } } else do.titles <- TRUE if (do.titles && length(titles)!=length(labels)){ message(paste("Wrong number of titles: there are",ncolumns,"columns but ",length(titles),"title labels:",paste(titles,collapse=", "))) } if (length(labs$cex) ##' @examples ##' data(Diabetes) ##' ## Linear regression ##' f = glm(bp.2s~frame+gender+age,data=Diabetes) ##' publish(f) ##' publish(f,factor.reference="inline") ##' publish(f,pvalue.stars=TRUE) ##' publish(f,ci.format="(l,u)") ##' ##' ### interaction ##' fit = glm(bp.2s~frame+gender*age,data=Diabetes) ##' summary(fit) ##' publish(fit) ##' ##' Fit = glm(bp.2s~frame*gender+age,data=Diabetes) ##' publish(Fit) ##' ##' ## Logistic regression ##' Diabetes$hyper1 <- factor(1*(Diabetes$bp.1s>140)) ##' lrfit <- glm(hyper1~frame+gender+age,data=Diabetes,family=binomial) ##' publish(lrfit) ##' ##' ### interaction ##' lrfit1 <- glm(hyper1~frame+gender*age,data=Diabetes,family=binomial) ##' publish(lrfit1) ##' ##' lrfit2 <- glm(hyper1~frame*gender+age,data=Diabetes,family=binomial) ##' publish(lrfit2) ##' ##' ## Poisson regression ##' data(trace) ##' trace <- Units(trace,list("age"="years")) ##' fit <- glm(dead ~ smoking+sex+age+Time+offset(log(ObsTime)), family="poisson",data=trace) ##' rtf <- regressionTable(fit,factor.reference = "inline") ##' summary(rtf) ##' publish(fit) ##' ##' ## gls regression ##' if (requireNamespace("nlme",quietly=TRUE)){ ##' requireNamespace("lava",quietly=TRUE) ##' library(lava) ##' library(nlme) ##' m <- lvm(Y ~ X1 + gender + group + Interaction) ##' distribution(m, ~gender) <- binomial.lvm() ##' distribution(m, ~group) <- binomial.lvm(size = 2) ##' constrain(m, Interaction ~ gender + group) <- function(x){x[,1]*x[,2]} ##' d <- sim(m, 1e2) ##' d$gender <- factor(d$gender, labels = letters[1:2]) ##' d$group <- factor(d$group) ##' ##' e.gls <- gls(Y ~ X1 + gender*group, data = d, ##' weights = varIdent(form = ~1|group)) ##' publish(e.gls) ##' ##' ## lme ##' fm1 <- lme(distance ~ age*Sex, ##' random = ~1|Subject, ##' data = Orthodont) ##' res <- publish(fm1) ##' } ##' @export publish.glm <- function(object, confint.method, pvalue.method, digits=c(2,4), print=TRUE, factor.reference="extraline", intercept=ifelse((is.null(object$family)||object$family$family=="gaussian"),1L,0L), units=NULL, ...){ if (missing(confint.method)) confint.method="default" if (missing(pvalue.method)) pvalue.method=switch(confint.method, "robust"={"robust"}, "simultaneous"={"simultaneous"}, "default") rt <- regressionTable(object, confint.method=confint.method, pvalue.method=pvalue.method, factor.reference=factor.reference, intercept=intercept, units=units) srt <- summary.regressionTable(rt, digits=digits, print=FALSE,...) if (print==TRUE) publish(srt$regressionTable,...) invisible(srt) } ##' @export publish.lm <- publish.glm ##' @export publish.gls <- publish.glm ##' @export publish.lme <- publish.glm ##' @export publish.geeglm <- publish.glm Publish/R/publish.survdiff.R0000755000176200001440000000502514142666146015520 0ustar liggesusers## based on a copy from print.survdiff, tag, 07 Aug 2009 (11:19) #' Alternative summary of survdiff results #' #' @title Alternative summary of survdiff results ##' @param object Object obtained with \code{survival::survdiff}. ##' @param digits Vector with digits for rounding numbers: the second for pvalues, the first for all other numbers. ##' @param print If \code{FALSE} do not print results. ##' @param ... Not (yet) used. ##' @examples ##' library(survival) ##' data(pbc) ##' sd <- survdiff(Surv(time,status!=0)~sex,data=pbc) ##' publish(sd) ##' publish(sd,digits=c(3,2)) ##' ##' @author Thomas A. Gerds ##' @export publish.survdiff <- function (object, digits = c(2,4),print=TRUE,...) { if (length(digits)==1) digits <- rep(digits,2) saveopt <- options(digits = digits) on.exit(options(saveopt)) if (!inherits(object, "survdiff")) stop("Object is not the result of survdiff") ## if (!is.null(cl <- object$call)) { ## cat("Call:\n") ## dput(cl) ## cat("\n") ## } omit <- object$na.action if (length(omit)) cat("n=", sum(object$n), ", ", naprint(omit), ".\n\n", sep = "") if (length(object$n) == 1) { z <- sign(object$exp - object$obs) * sqrt(object$chisq) temp <- c(object$obs, object$exp, z, format.pval(1 - pchisq(object$chisq,1),digits=digits,eps=10^{-digits[[2]]})) names(temp) <- c("Observed", "Expected", "Z", "p") if (print==TRUE) print(temp) } else { if (is.matrix(object$obs)) { otmp <- apply(object$obs, 1, sum) etmp <- apply(object$exp, 1, sum) } else { otmp <- object$obs etmp <- object$exp } df <- (sum(1 * (etmp > 0))) - 1 temp <- cbind(object$n, otmp, etmp, ((otmp - etmp)^2)/etmp, ((otmp - etmp)^2)/diag(object$var)) dimnames(temp) <- list(names(object$n), c("N", "Observed", "Expected", "squared(O-E)/E", "squared(O-E)/V")) if (print==TRUE){ publish(temp,digits=digits[[1]],col1name="Log-rank test") cat("\n Chisq=", format(object$chisq, digits=digits[[1]]), " on", df, "degrees of freedom, p=", format.pval(1 - pchisq(object$chisq,df),digits=digits[[2]],eps=10^{-digits[[2]]}), "\n") } } attr(temp,"p-value") <- 1 - pchisq(object$chisq,df) invisible(temp) } Publish/R/followupTable.R0000644000176200001440000001176215040352563015035 0ustar liggesusers### followupTable.R --- #---------------------------------------------------------------------- ## author: Thomas Alexander Gerds ## created: Nov 28 2015 (08:23) ## Version: ## last-updated: Jul 24 2025 (08:40) ## By: Thomas Alexander Gerds ## Update #: 53 #---------------------------------------------------------------------- ## ### Commentary: ## ### Change Log: #---------------------------------------------------------------------- ## ### Code: ##' Summarize baseline variables in groups defined by outcome ##' at a given followup time point ##' ##' If \code{compare.groups!=FALSE}, p-values are obtained from stopped Cox regression, i.e., all events are censored at follow-up time. ##' A univariate Cox regression model is fitted to assess the effect of each variable on the right hand side of the formula on the event ##' hazard and shown is the p-value of \code{anova(fit)}. ## With competing risks the same is done for the hazard of being event-free (combined end-point analysis). ##' @title Summary tables for a given followup time point. ##' @param formula Formula A formula whose left hand side is a ##' \code{Hist} object. In some special cases it can also be a ##' \code{Surv} response object. The right hand side is as in ##' \link{utable}. ##' @param data A data.frame in which all the variables of ##' \code{formula} can be interpreted. ##' @param followup.time Time point at which to evaluate outcome ##' status. ##' @param compare.groups Method for comparing groups. ##' @param ... Passed to \code{utable}. All arguments of \code{utable} ##' can be controlled in this way except for \code{compare.groups} ##' which is set to \code{"Cox"}. See details. ##' @return ##' Summary table. ##' @seealso univariateTable ##' @examples ##' library(survival) ##' data(pbc) ##' pbc$edema <- factor(pbc$edema,levels=c("0","0.5","1"),labels=c("0","0.5","1")) ##' pbc$sex <- factor(pbc$sex,levels=c("m","f"),labels=c("m","f")) ##' followupTable(Hist(time,status)~age+edema+sex,data=pbc,followup.time=1000) ##' ##' @export ##' @author Thomas A. Gerds followupTable <- function(formula,data,followup.time,compare.groups,...){ event.history <- prodlim::EventHistory.frame(update(formula,".~1"), data=data, check.formula=TRUE, specials=NULL)$event.history # {{{ Fix for those who use `Surv' instead of `Hist' if (match("Surv",class(event.history),nomatch=0)!=0){ attr(event.history,"model") <- "survival" attr(event.history,"cens.type") <- "rightCensored" attr(event.history,"entry.type") <- ifelse(ncol(event.history)==2,"","leftTruncated") if (attr(event.history,"entry.type")=="leftTruncated") colnames(event.history) <- c("entry","time","status") } # }}} if (length(attr(event.history,"entry.type"))>1) stop("Cannot handle delayed entry.") if (missing(followup.time)) followup.time <- NULL else{ time <- event.history[,"time",drop=TRUE] } model <- attr(event.history,"model") if (model=="survival"){ status <- event.history[,"status",drop=TRUE] status <- as.character(factor(status,levels=c(0,1),labels=c("Lost","Event"))) status[event.history[,"time"]>followup.time] <- "Event-free" ## ehs <- prodlim::stopTime(event.history) }else{ if (model!="competing.risks") stop("Can only handle survival and competing risks outcome.") ## status <- getEvent(event.history,mode="numeric") status <- getEvent(event.history,mode="factor") ## status <- getEvent(event.history,mode="character") slevs <- unique(c(levels(status),"Event-free")) levels(status) <- slevs ## status[event.history[,"time"]>followup.time] <- length(attr(event.history,"states"))+1 status[event.history[,"time"]>followup.time] <- "Event-free" } if (length(followup.time)==0) stop("Need a followup time.") ## FIXME: need a time otherwise all are unknown. uformula <- update(formula,"fstatus~.") ## groupname <- "status" data$fstatus <- status if (missing(compare.groups)){ dots <- match.call(expand.dots=TRUE) compare.groups <- dots$compare.groups if (length(compare.groups)==0) compare.groups <- "Cox" else compare.groups <- NULL } if (length(compare.groups)>0 && compare.groups!=FALSE){ outcome <- unclass(prodlim::stopTime(event.history,stop.time=followup.time)) ## for now: effect on event-free survival if (model=="competing.risks"){ outcome[,"status"] <- outcome[,"status"]!=0 } } else{ compare.groups <- FALSE outcome <- NULL } utable(formula=uformula, data=data, outcome=outcome, compare.groups=compare.groups, ...) } #---------------------------------------------------------------------- ### followupTable.R ends here Publish/R/summary.ci.R0000644000176200001440000000523115040352070014270 0ustar liggesusers##' Summarize confidence intervals ##' ##' This format of the confidence intervals is user-manipulable. ##' @title Summarize confidence intervals ##' @param object Object of class ci containing point estimates and the ##' corresponding confidence intervals ##' @param format A string which indicates the format used for ##' confidence intervals. The string is passed to ##' \link{formatCI} with two arguments: the lower and the upper ##' limit. For example \code{'(l;u)'} yields confidence intervals with ##' round parenthesis in which the upper and the lower limits are ##' separated by semicolon. ##' @param se If \code{TRUE} add standard error. ##' @param print Logical: if \code{FALSE} do not actually print ##' confidence intervals but just return them invisibly. ##' @param ... used to control formatting of numbers ##' @return Formatted confidence intervals ##' @seealso ci plot.ci format.ci ##' @examples ##' library(lava) ##' m <- lvm(Y~X) ##' m <- categorical(m,Y~X,K=4) ##' set.seed(4) ##' d <- sim(m,24) ##' ci.mean(Y~X,data=d) ##' x <- summary(ci.mean(Y~X,data=d),digits=2) ##' x ##' x <- summary(ci.mean(Y~X,data=d),format="(u,l)",digits=2) ##' x <- summary(ci.mean(Y~X,data=d),format="(u,l)",digits=1,se=TRUE) ##' x <- summary(ci.mean(Y~X,data=d),format="(u,l)",digits=1,handler="format") ##' x <- summary(ci.mean(Y~X,data=d),format="(u,l)",digits=1,handler="prettyNum") #' @export ##' @author Thomas A. Gerds summary.ci <- function(object,format="[u;l]",se=FALSE,print=TRUE,...){ pynt <- getPyntDefaults(list(...),names=list("digits"=c(2,3),"handler"="sprintf",nsmall=NULL)) digits <- pynt$digits handler <- pynt$handler if (length(digits)==1) digits <- rep(digits,2) if (length(pynt$nsmall)>0) nsmall <- pynt$nsmall else nsmall <- pynt$digits if (missing(format) || is.null(format)) format <- "[u;l]" if (is.null(object$level)) level <- 0.05 else level <- object$level parm <- pubformat(object[[1]],handler=handler,digits=digits,nsmall=nsmall) ci <- formatCI(lower=object[["lower"]],upper=object[["upper"]],format=format,handler=handler,digits=digits,nsmall=nsmall) if (match("se",names(object)) && se==TRUE){ se <- pubformat(object[[2]],handler=handler,digits=digits,nsmall=nsmall) pci <- cbind(parm,se,ci) colnames(pci) <- c(names(object)[1:2],paste("CI-",as.character(100*(1-level)),"%",sep="")) }else{ pci <- cbind(parm,ci) colnames(pci) <- c(names(object)[1],paste("CI-",as.character(100*(1-level)),"%",sep="")) } pci <- cbind(object$labels,pci) rownames(pci) <- rep("",nrow(pci)) if (print==TRUE) print(pci,right=FALSE,quote=FALSE,...) invisible(pci) } Publish/R/publish.R0000755000176200001440000000176714142666146013702 0ustar liggesusers##' Publish provides summary functions for data ##' and results of statistical analysis in ready-for-publication ##' design ##' ##' Some warnings are currently suppressed. ##' @title Publishing tables and figures ##' @param object object to be published ##' @param ... Passed to method. #' @importFrom survival Surv coxph #' @importFrom prodlim Hist getEvent #' @importFrom data.table set #' @importFrom grDevices dev.size #' @importFrom graphics abline par plot polygon rect segments strwidth #' @importFrom stats anova binom.test binomial chisq.test coef confint delete.response fisher.test get_all_vars glm kruskal.test model.frame model.response na.omit na.pass naprint pchisq pt qnorm qt quantile symnum terms update update.formula var ##' @seealso publish.CauseSpecificCox publish.ci publish.coxph publish.glm publish.riskRegression publish.survdiff ##' @return Tables and figures ##' @author Thomas A. Gerds ##' @export publish <- function (object, ...) { UseMethod("publish") } Publish/R/parseSummaryFormat.R0000744000176200001440000000301614142666146016060 0ustar liggesusersparseSummaryFormat <- function(format,digits){ S <- function(x,format,digits,nsmall){x} F <- function(x,ref,digits,nsmall){x} iqr <- function(x)quantile(x,c(0.25,0.75)) minmax <- function(x)quantile(x,c(0,1)) CI.95 <- function(x,sep=",",...){ m <- ci.mean.default(x,...) paste(format(m$lower,digits=digits,nsmall=digits), sep," ", format(m$upper,digits=digits,nsmall=digits)) } ## format.numeric <- paste("%1.",digits,"f",sep="") tmp <- strsplit(format,"[ \t]+|\\(|\\{|\\[|\\)",perl=TRUE)[[1]] stats <- tmp[grep("^x$",tmp)-1] outclass <- sapply(stats,function(s)class(do.call(s,list(1:2)))) outlen <- sapply(stats,function(s)length(do.call(s,list(1:2)))) for(s in 1:length(stats)){ subs <- "%s" if(!(outlen[s]%in%c(1,2))) stop(paste("The function",stats[s],"returns",outlen[s],"values (can be 1 or 2)")) subs <- switch(as.character(outlen[s]), "1"={switch(outclass[s], "numeric"="%s", "integer"="%s", "%s")}, "2"={switch(outclass[s], "numeric"=paste("%s",", ","%s",sep=""), "integer"=paste("%s",", ","%s",sep=""), paste("%s",", ","%s",sep=""))}) format <- gsub(paste(stats[s],"(x)",sep=""),subs,format,fixed=TRUE) } list(format=format,stats=stats) } Publish/R/publish.htest.R0000755000176200001440000001736614142666146015032 0ustar liggesusers##' Pretty printing of test results. ##' ##' @title Pretty printing of test results. ##' @export ##' @param object Result of \code{t.test} or \code{wilcox.test} ##' @param title Decoration also used to name output ##' @param ... Used to transport arguments \code{ci.arg} and \code{pvalue.arg} to subroutines \code{format.pval} and \code{formatCI}. See also \code{prodlim::SmartControl}. ##' @author Thomas A. Gerds ##' @examples ##' data(Diabetes) ##' publish(t.test(bp.2s~gender,data=Diabetes)) ##' publish(wilcox.test(bp.2s~gender,data=Diabetes)) ##' publish(with(Diabetes,t.test(bp.2s,bp.1s,paired=TRUE))) ##' publish(with(Diabetes,wilcox.test(bp.2s,bp.1s,paired=TRUE))) ##' publish.htest <- function(object, title, ...){ pynt <- getPyntDefaults(list(...),names=list("digits"=c(2,3),"handler"="sprintf",nsmall=NULL)) digits <- pynt$digits if (length(digits)==1) digits <- rep(digits,2) handler <- pynt$handler if (length(pynt$nsmall)>0) nsmall <- pynt$nsmall else nsmall <- pynt$digits Lower <- object$conf.int[[1]] Upper <- object$conf.int[[2]] ci.defaults <- list(format="[l;u]", digits=digits[[1]], nsmall=digits[[1]], degenerated="asis") pvalue.defaults <- list(digits=digits[[2]], eps=10^{-digits[[2]]}, stars=FALSE) smartF <- prodlim::SmartControl(call=list(...), keys=c("ci","pvalue"), ignore=c("x","print","handler","digits","nsmall"), defaults=list("ci"=ci.defaults,"pvalue"=pvalue.defaults), forced=list("ci"=list(lower=Lower,upper=Upper,handler=handler,digits=digits[[1]],nsmall=nsmall[[1]]), "pvalue"=list(object$p.value)), verbose=FALSE) printmethod=object$method printmethod[grep("Wilcoxon rank sum test",printmethod)]="Wilcoxon rank sum test" printmethod[grep("Wilcoxon signed rank test",printmethod)]="Wilcoxon signed rank test" printmethod[grep("Two Sample t-test",printmethod)]="Two Sample t-test" if (!is.null(object$conf.int)){ if (printmethod=="Exact binomial test"){ cistring=paste(" (CI-", 100*attr(object$conf.int,"conf.level"), "% = ", do.call("formatCI",smartF$ci), ").",sep="") }else{ cistring=paste(" (CI-", 100*attr(object$conf.int,"conf.level"), "% = ", do.call("formatCI",smartF$ci), "; ", "p-value = ", do.call("format.pval",smartF$pvalue), ").",sep="") } } else{ cistring="" } switch(printmethod, "Exact binomial test"={ outstring <- paste("The ", object$method, " to estimate the ", names(object$null.value), " based on ", object$statistic, " events ", " in ", object$parameter, " trials yields a probability estimate of ", pubformat(object$estimate,handler=handler, digits=digits[[1]], nsmall=nsmall[[1]]), cistring, sep="") }, "Two Sample t-test"={ outstring <- paste("The ", object$method, " to compare the ", names(object$null.value), " for ", object$data.name, " yields a mean difference of ", pubformat(diff(object$estimate),handler=handler, digits=digits[[1]], nsmall=nsmall[[1]]), cistring, sep="") }, "Wilcoxon rank sum test"={ if (is.null(object$conf.int)) outstring <- paste("The ", object$method, " to compare the ", names(object$null.value), " for ", object$data.name, " yields a p-value of ", do.call("format.pval",smartF$pvalue), ".", sep="") else outstring <- paste("The ", object$method, " to compare the ", names(object$null.value), " for ", object$data.name, " yields a ", names(object$estimate), " of ", pubformat(object$estimate,handler=handler, digits=digits[[1]], nsmall=nsmall[[1]]), cistring, sep="") }, "Paired t-test"={ outstring <- paste("The ", object$method, " to compare the ", names(object$null.value), " for ", object$data.name, " yields a mean of the differences of ", pubformat(object$estimate,handler=handler, digits=digits[[1]], nsmall=nsmall[[1]]), cistring, sep="") }, "Wilcoxon signed rank test"={ if (is.null(object$conf.int)) outstring <- paste("The ", object$method, " to compare the ", names(object$null.value), " for ", object$data.name, " yields a p-value of ", do.call("format.pval",smartF$pvalue), ".", sep="") else outstring <- paste("The ", object$method, " to compare the ", names(object$null.value), " for ", object$data.name, " yields a ", names(object$estimate), " of ", pubformat(object$estimate,handler=handler, digits=digits[[1]], nsmall=nsmall[[1]]), cistring, sep="") }) outstring=gsub('[[:space:]]+',' ',gsub('[[:space:]]$','',outstring)) if (missing(title)) cat("\n",outstring,"\n") else{ names(outstring) <- title print(outstring,quote=F) } } Publish/R/publish.ci.R0000644000176200001440000000316215040352720014244 0ustar liggesusers### publish.ci.R --- #---------------------------------------------------------------------- ## author: Thomas Alexander Gerds ## created: Oct 29 2015 (06:41) ## Version: ## last-updated: Jul 24 2025 (08:42) ## By: Thomas Alexander Gerds ## Update #: 7 #---------------------------------------------------------------------- ## ### Commentary: ## ### Change Log: #---------------------------------------------------------------------- ## ### Code: ##' Publish tables with confidence intervals ##' ##' This function calls summary.ci with print=FALSE and then publish ##' @title Publish tables with confidence intervals ##' @param object Object of class ci containing point estimates and the ##' corresponding confidence intervals ##' @param format A string which indicates the format used for ##' confidence intervals. The string is passed to ##' \link{formatCI} with two arguments: the lower and the upper ##' limit. For example \code{'(l;u)'} yields confidence intervals with ##' round parenthesis in which the upper and the lower limits are ##' separated by semicolon. ##' @param se If \code{TRUE} add standard error. ##' @param ... passed to \code{publish} ##' @return table with confidence intervals ##' @seealso summary.ci ##' @examples ##' ##' data(Diabetes) ##' publish(ci.mean(chol~location+gender,data=Diabetes),org=TRUE) ##' ##' @export ##' @author Thomas A. Gerds publish.ci <- function(object,format="[u;l]",se=FALSE,...){ publish(summary(object,se=se,format=format,print=FALSE),...) } #---------------------------------------------------------------------- ### publish.ci.R ends here Publish/R/lazyDateCoding.R0000644000176200001440000001007714142666146015124 0ustar liggesusers##' This function eases the process of generating date variables. ##' All variables in a data.frame which match a regular expression ##' are included ##' ##' The code needs to be copy-and-pasted from the R-output ##' buffer into the R-code buffer. This can be customized ##' for the really efficiently working people, e.g., in emacs. ##' @title Efficient coding of date variables ##' @param data Data frame in which to search for date variables. ##' @param format passed to as.Date ##' @param pattern match date variables ##' @param varnames variable names ##' @param testlength how many rows of data should be evaluated to guess the format. ##' @return R-code one line for each variable. ##' @author Thomas Alexander Gerds ##' @examples ##' d <- data.frame(x0="190101",x1=c("12/8/2019"),x2="12-8-2019",x3="20190812",stringsAsFactors=FALSE) ##' lazyDateCoding(d,pattern="x") ##' lazyDateCoding(d,pattern="3") ##' ##' @export lazyDateCoding <- function(data,format,pattern,varnames,testlength=10){ if (!is.character(data)) data <- as.character(substitute(data)) d <- get(data, envir=parent.frame()) isdt <- match("data.table",class(d),nomatch=FALSE) datevars <- grep(pattern,names(d),value=TRUE) out <- lapply(datevars,function(x){ dx <- d[[x]] if (is.character(dx)){ test.x <- dx[!is.na(dx)] test.x <- test.x[1:(min(length(test.x),testlength))] ## separator separators <- c("-","/","\\|"," ") sep <- sapply(separators,grep,test.x,value=TRUE) lsep <- sapply(sep,length) if (all(lsep==0)) sep <- "" else sep <- names(sep)[lsep==max(lsep)] ## day day <- "%d" ## month m or b if (any(grepl("[:alpha:]",test.x))) month <- "%b" else month <- "%m" ## year 07 or 2007 l.x <- nchar(test.x) if (any((l.x-2*nchar(sep))<=6)) year <- "%y" else year <- "%Y" ## order test.formats <- c(paste0(day,sep,month,sep,year), paste0(day,sep,year,sep,month), paste0(year,sep,month,sep,day), paste0(year,sep,day,sep,month), paste0(month,sep,year,sep,day), paste0(month,sep,day,sep,year)) if (sep!=""){ list.x <- strsplit(test.x,sep) Y <- match(4,nchar(list.x[[1]]),nomatch=0) if (Y>0) year <- "%Y" test.formats <- switch(as.character(Y), "3"={c(paste0(day,sep,month,sep,year), paste0(month,sep,day,sep,year))}, "1"={c(paste0(year,sep,month,sep,day), paste0(year,sep,day,sep,month))}, "2"={c(paste0(month,sep,year,sep,day), paste0(day,sep,year,sep,month))}, {test.formats}) } ## print(test.formats) nix <- try(this.x <- as.Date(test.x[[1]],format=test.formats)) if ((class(nix)[[1]]=="try-error") || all(is.na(this.x))){ format.x <- "dontknow" }else{ format.x <- test.formats[!is.na(this.x)] if (length(format.x)>1){ # multiple matches winner <- sapply(format.x,function(fx){sum(!is.na(as.Date(test.x,format=fx)))}) format.x <- format.x[winner==max(winner)][1] } } if (isdt){ paste0(data,"[",",",x,":=as.Date(",x,",format=\"",format.x,"\")]\n") }else{ obj.x <- paste(data,"$",x,sep="") paste(obj.x," <- as.Date(",obj.x,",format=c(\"",format.x,"\")\n",sep="") } }else{ NULL }}) out <- out[!sapply(out,is.null)] sapply(unlist(out),cat) invisible(out) } Publish/R/acut.R0000644000176200001440000002141614142666146013156 0ustar liggesusers##' A version of \code{cut} that easily formats the labels and places breaks by default. ##' ##' The formats are supplied by specifiyng the text around the lower (\%l) and upper (\%l) value (see examples). ##' If user specified breaks are supplied, the default labels from \code{cut} are used. ##' If automatic breaks are used, the default labels are a slight modification at the end point of the default from \code{cut} ##' All this can of course be adjusted manually through the format functionality (see below). ##' ##' By default, 5 breaks are constructed according to the quantiles with of the input \code{x}. ##' The number of breaks can be adjusted, and default specifying breaks (as in \code{cut}) can be supplied instead. ##' ##' If \code{type} is changed from "\code{default}" to another option, a different formatting template is used. ##' For now the only other option is "\code{age}", which is designed to be well suited to easily group age variables. ##' When \code{type}="\code{age}" only the \code{breaks} argument is used, and it behaves different from otherwise. ##' If a single number is supplied, intervals of length \code{breaks} will automatically be constructed (starting from 0). ##' If a vector is supplied, the intervals are used as in \code{cut} but formatted differently, see examples. ##' @title Automatic selection and formatting of breaks in \code{cut} ##' @param x a numeric vector which is to be converted to a factor by cutting (passed directly to \code{cut}). ##' @param n number of bins to create based on the empirical quantiles of x. This will be overruled if \code{breaks} is supplied. ##' @param type a high-level formatting option. For now, the only other option than the default setting is "\code{age}". See details and examples. ##' @param format string used to make labels. \%l and \%u identifies the lower and upper value of the breaks respectively. See examples. ##' @param format.low string used specifically on the lowest label. ##' @param format.high string used specifically on the highest label. ##' @param dig.lab integer which is used when labels are not given. It determines the number of digits used in formatting the break numbers. (Passed directly to \code{cut}.) ##' @param right logical, indicating if the intervals should be closed on the right (and open on the left) or vice versa (passed directly to \code{cut}). ##' @param breaks specify breaks manually as in \code{cut}. ##' @param labels logical, indicating whether or not to make labels or simply use ordered numbers. If TRUE, the labels are constructed as discribed above. ##' @param ... further arguments passed to \code{cut}. ##' @return same as for cut. A vector of 'factors' is created, unless 'labels=FALSE'. ##' @examples ##' data(Diabetes) # load dataset ##' ##' ## The default uses format similar to cut ##' chol.groups <- acut(Diabetes$chol) ##' table(chol.groups) ##' ##' ## The formatting can easily be changed ##' chol.groups <- acut(Diabetes$chol,format="%l-%u",n=5) ##' table(chol.groups) ##' ##' ## The default is to automatic place the breaks, so the number of this can easily be changed. ##' chol.groups <- acut(Diabetes$chol,n=7) ##' table(chol.groups) ##' ##' ## Manually setting format and breaks ##' age.groups <- acut(Diabetes$age,format="%l-%u",breaks=seq(0,100,by=10)) ##' table(age.groups) ##' ##' ## Other variations ##' age.groups <- acut(Diabetes$age, ##' format="%l-%u", ##' format.low="below %u", ##' format.high="above %l", ##' breaks=c(0, seq(20,80,by=10), Inf)) ##' table(age.groups) ##' ##' BMI.groups <- acut(Diabetes$BMI, ##' format="BMI between %l and %u", ##' format.low="BMI below %u", ##' format.high="BMI above %l") ##' table(BMI.groups) ##' org(as.data.frame(table(BMI=BMI.groups))) ##' ##' ## Instead of using the quantiles, we can specify equally spaced breaks, ##' ## but still get the same formatting ##' BMI.grouping <- ##' seq(min(Diabetes$BMI,na.rm=TRUE), max(Diabetes$BMI,na.rm=TRUE), length.out=6) ##' BMI.grouping[1] <- -Inf # To get all included ##' BMI.groups <- acut(Diabetes$BMI, ##' breaks=BMI.grouping, ##' format="BMI between %l and %u", ##' format.low="BMI below %u", ##' format.high="BMI above %l") ##' table(BMI.groups) ##' org(as.data.frame(table(BMI=BMI.groups))) ##' ##' ## Using type="age" ##' ## When using type="age", categories of 10 years are constructed by default. ##' ## The are formatted to be easier to read when the values are ages. ##' table(acut(Diabetes$age, type="age")) ##' ##' ## This can be changes with the breaks argument. ##' ## Note that this is diffent from cut when breaks is a single number. ##' table(acut(Diabetes$age, type="age", breaks=20)) ##' ##' ## Of course We can also supply the breaks manually. ##' ## The formatting depends on whether or not all the values fall within the breaks: ##' ## All values within the breaks ##' table(acut(Diabetes$age, type="age", breaks=c(0, 30, 50, 80, 100))) ##' ## Some values below and above the breaks ##' table(acut(Diabetes$age, type="age", breaks=c(30, 50, 80))) ##' ##' @author Anders Munch ##' @export acut <- function(x,n=5,type="default", format=NULL,format.low=NULL,format.high=NULL,dig.lab=3,right=TRUE,breaks,labels=TRUE,...){ stopifnot(n>1) update.label <- function(str,low=NULL,upper=NULL,low.str="%l",upper.str="%u"){ if(is.null(low)) low <- low.str if(is.null(upper)) upper <- upper.str new.label <- str new.label <- sub(low.str, low, new.label) new.label <- sub(upper.str, upper, new.label) return(new.label) } if(type=="age"){ min.x <- min(x, na.rm=TRUE) max.x <- max(x, na.rm=TRUE) if(missing(breaks)) breaks <- 10 if(length(breaks)==1){ if(as.integer(breaks)!=breaks) warning("When using type=\"age\", it makes most sense with intervals with integer length.") breaks <- seq(floor(min.x/breaks)*breaks, ceiling(max.x/breaks)*breaks, by=breaks) } if(any(!(as.integer(breaks) == breaks))) warning("When using type=\"age\", it makes most sense with integer-valued breaks points.") breaks <- sort(breaks) if(min.xbreaks[length(breaks)]) breaks <- c(breaks, Inf) ## Find way to handle right=FALSE -- maybe not relevant for the type? pre.cut <- acut(x=x, breaks=breaks, right=FALSE) age.labels <- paste0(breaks[-length(breaks)], "-", (breaks[-1]-1)) if(breaks[1] == -Inf) age.labels[1] <- paste("younger than", breaks[2]) if(breaks[length(breaks)] == Inf) age.labels[length(age.labels)] <- paste(breaks[length(breaks)-1], "or older") pre.cut <- factor(pre.cut, levels=levels(pre.cut), labels=age.labels) return(pre.cut) } if(missing(breaks)){ breaks <- as.numeric(quantile(x, seq(0,1,length.out=n+1), na.rm=TRUE)) breaks[1] <- -Inf breaks[length(breaks)] <- Inf if(is.null(format.low)){ if(right) format.low <- "<= %u" else format.low <- "< %u" } if(is.null(format.high)){ if(right) format.high <- "> %l" else format.high <- ">= %l" } } if(labels) labels <- NULL out <- cut(x,breaks=breaks,right=right,labels=labels,dig.lab=dig.lab) if(!is.null(c(format,format.low,format.high)) & is.null(labels)){ ## To keep consistency with labels from cut ## and because dig.lab in cut is quite clever, extract the breaks from here. default.labels <- levels(out) breaks <- unlist(strsplit(gsub(" ", "", paste(chartr("(]"," ",default.labels),collapse=",")), ",")) breaks <- breaks[c(seq(1,length(breaks)-1,by=2),length(breaks))] out.labels <- levels(out) if(!is.null(format)) out.labels <- mapply( function(a,b) update.label(format,low=a,upper=b), breaks[1:(length(breaks)-1)], breaks[2:(length(breaks))] ) if(!is.null(format.low)) out.labels[1] <- update.label(format.low,low=breaks[1],upper=breaks[2]) if(!is.null(format.high)) out.labels[length(out.labels)] <- update.label(format.high, low=breaks[length(breaks)-1], upper=breaks[length(breaks)]) levels(out) <- out.labels } return(out) } Publish/R/labelUnits.R0000744000176200001440000000466714142666146014336 0ustar liggesusers##' Label output tables ##' ##' Modify labels and values of variables in summary tables ##' @title labelUnits ##' @param x A matrix obtained with \code{univariateTable}. ##' @param ... not used ##' @return The re-labeled matrix ##' @seealso univariateTable ##' @examples ##' ##' data(Diabetes) ##' tab <- summary(univariateTable(gender~AgeGroups+chol+waist,data=Diabetes)) ##' publish(tab) ##' ltab <- labelUnits(tab,"chol"="Cholesterol (mg/dL)","<40"="younger than 40") ##' publish(ltab) ##' ##' ## pass labels immediately to utable ##' utable(gender~AgeGroups+chol+waist,data=Diabetes, ##' "chol"="Cholesterol (mg/dL)","<40"="younger than 40") ##' ##' ## sometimes useful to state explicitly which variables value ##' ## should be re-labelled ##' utable(gender~AgeGroups+chol+waist,data=Diabetes, ##' "chol"="Cholesterol (mg/dL)","AgeGroups.<40"="younger than 40") ##' @export ##' @author Thomas A. Gerds labelUnits <- function(x,...){ ## stopifnot(match("summary.univariateTable",class(x),nomatch=0)>0) x units <- prodlim::SmartControl(list(...), keys=c("units",unique(x$Variable[x$Variable!=""])), defaults=NULL, ignore.case=TRUE, replaceDefaults=TRUE, verbose=FALSE) lunits <- sapply(units,length) units <- units[lunits>0] ulvar <- grep("Level|Unit",names(x),value=TRUE) ## factor specific units if (length(units)>0){ for (i in 1:length(units)){ uat <- grep(names(units)[i],x$Variable) lat <- match(names(units[[i]]),x[[ulvar]][uat:length(x$Variable)],nomatch=FALSE) lat <- lat[lat!=0] vals <- unlist(units[[i]]) vals <- vals[lat!=0] x[[ulvar]][uat -1 + lat] <- vals } } ## labels for variables labels <- list(...) if (length(labels)>0){ keys <- names(labels) Flabels <- labels[match(keys,x$Variable,nomatch=0)!=0] x$Variable[match(keys,x$Variable,nomatch=0)] <- unlist(Flabels) Funits <- labels[match(keys,x[[ulvar]],nomatch=0)!=0] for (f in names(Funits)){ x[[ulvar]][x[[ulvar]]%in%f] <- Funits[[f]] } ## now flatten lists. otherwise ## write.csv will complain x$Variable <- unlist(x$Variable) x[[ulvar]] <- unlist(x[[ulvar]]) } x } Publish/R/coxphSeries.R0000744000176200001440000000441614142666146014520 0ustar liggesusers##' Run a series of Cox regression analyses for a list of predictor variables ##' and summarize the results in a table. ##' The Cox models can be adjusted for a fixed set of covariates ##' ##' This function runs on \code{coxph} from the survival package. ##' @title Run a series of Cox regression models ##' @param formula The fixed part of the regression formula. For ##' univariate analyses this is simply \code{Surv(time,status)~1} ##' where \code{Surv(time,status)} is the outcome variable. When the ##' aim is to control the effect of \code{vars} in each element of the ##' series by a fixed set of variables it is ##' \code{Surv(time,status)~x1+x2} where again Surv(time,status) is ##' the outcome and x1 and x2 are confounders. ##' @param data A \code{data.frame} in which the \code{formula} gets ##' evaluated. ##' @param vars A list of variable names, the changing part of the ##' regression formula. ##' @param ... passed to publish.coxph ##' @return matrix with results ##' @author Thomas Alexander Gerds ##' @examples ##' library(survival) ##' data(pbc) ##' ## collect hazard ratios from three univariate Cox regression analyses ##' pbc$edema <- factor(pbc$edema,levels=c("0","0.5","1"),labels=c("0","0.5","1")) ##' uni.hr <- coxphSeries(Surv(time,status==2)~1,vars=c("edema","bili","protime"),data=pbc) ##' uni.hr ##' ##' ## control the logistic regression analyses for age and gender ##' ## but collect only information on the variables in `vars'. ##' controlled.hr <- coxphSeries(Surv(time,status==2)~age+sex,vars=c("edema","bili","protime"),data=pbc) ##' controlled.hr ##' ##' @export coxphSeries <- function(formula,data,vars,...){ ## ref <- glm(formula,data=data,...) Missing=NULL data.table::setDT(data) data <- data[,c(all.vars(formula),vars),with=FALSE] clist <- lapply(vars,function(v){ form.v <- update.formula(formula,paste(".~.+",v)) if (is.logical(data[[v]])) data[[v]] <- factor(data[[v]],levels=c("FALSE","TRUE")) cf <- survival::coxph(form.v,data=data,...) cf$call$data <- data cf$model <- data nv <- length(cf$xlevels[[v]]) rtab <- regressionTable(cf) rtab[[v]] }) out <- data.table::rbindlist(clist) if (all(out$Missing%in%c("","0"))) out[,Missing:=NULL] out[] } Publish/R/plot.ci.R0000644000176200001440000000543414142666146013574 0ustar liggesusers## ------------------------------------------------------------------ ## _____ _____ ## |_ _|_ _ __ |_ _|__ __ _ _ __ ___ ## | |/ _` |/ _` || |/ _ \/ _` | '_ ` _ \ ## | | (_| | (_| || | __/ (_| | | | | | | ## |_|\__,_|\__, ||_|\___|\__,_|_| |_| |_| ## |___/ ## ------------------------------------------------------------------ ##' Function to plot confidence intervals ##' ##' Function to plot means and other point estimates with confidence ##' intervals ##' @title Plot confidence intervals ##' @param x List, data.frame or other object of this form containing point estimates (first element) and the corresponding confidence intervals as elements lower and upper. ##' @param xlim Limit of the x-axis ##' @param xlab Label for the y-axis ##' @param labels labels ##' @param ... Used to transport arguments to \code{plotConfidence}. ##' @examples ##' ##' data(Diabetes) ##' x=ci.mean(bp.2s~AgeGroups,data=Diabetes) ##' plot(x,title.labels="Age groups",xratio=c(0.4,0.3)) ##' x=ci.mean(bp.2s/500~AgeGroups+gender,data=Diabetes) ##' plot(x,xratio=c(0.4,0.2)) ##' plot(x,xratio=c(0.4,0.2), ##' labels=split(x$labels[,"AgeGroups"],x$labels[,"gender"]), ##' title.labels="Age groups") ##' \dontrun{ ##' plot(x, leftmargin=0, rightmargin=0) ##' plotConfidence(x, leftmargin=0, rightmargin=0) ##' ##' data(CiTable) ##' with(CiTable,plotConfidence(x=list(HazardRatio), ##' lower=lower, ##' upper=upper, ##' labels=CiTable[,2:6], ##' factor.reference.pos=c(1,10,19), ##' format="(u-l)", ##' points.col="blue", ##' digits=2)) ##' ##' with(CiTable,Publish::plot.ci(x=list(HazardRatio), ##' lower=lower, ##' upper=upper, ##' labels=CiTable[,2:6], ##' factor.reference.pos=c(1,10,19), ##' format="(u-l)", ##' points.col="blue", ##' digits=2, ##' leftmargin=-2, ##' title.labels.cex=1.1, ##' labels.cex=0.8,values.cex=0.8)) ##' } ##' @author Thomas A. Gerds ##' @export plot.ci <- function(x,xlim,xlab="",labels,...){ M <- x[[1]] Lower <- x$lower Upper <- x$upper if (missing(xlim)) xlim <- c(min(Lower),max(Upper)) if (missing(labels)) labels <- x$labels plotConfidence(list(x=M,lower=Lower,upper=Upper), xlim=xlim, labels=labels, xlab=xlab, ...) } Publish/R/summary.regressionTable.R0000644000176200001440000001347414142666146017053 0ustar liggesusers##' Preparing regression results for publication ##' ##' @title Formatting regression tables ##' @aliases summary.regressionTable print.summary.regressionTable ##' @param object object obtained with \code{regressionTable} or \code{summary.regressionTable}. ##' @param show.missing Decide if number of missing values are shown. ##' Either logical or character. If \code{'ifany'} then number missing values are ##' shown if there are some. ##' @param print If \code{TRUE} print results. ##' @param ... Used to control formatting of parameter estimates, ##' confidence intervals and p-values. See examples. ##' @return List with two elements: ##' \itemize{ ##' \item regressionTable: the formatted regression table (a data.frame) ##' \item rawTable: table with the unformatted values (a data.frame) ##' } ##' @seealso publish.glm publish.coxph ##' @examples ##' library(survival) ##' data(pbc) ##' pbc$edema <- factor(pbc$edema,levels=c("0","0.5","1"),labels=c("0","0.5","1")) ##' fit = coxph(Surv(time,status!=0)~age+sex+edema+log(bili)+log(albumin)+log(protime), ##' data=pbc) ##' u=summary(regressionTable(fit)) ##' u$regressionTable ##' u$rawTable ##' summary(regressionTable(fit),handler="prettyNum") ##' summary(regressionTable(fit),handler="format") ##' summary(regressionTable(fit),handler="sprintf",digits=c(2,2),pValue.stars=TRUE) ##' summary(regressionTable(fit),handler="sprintf",digits=c(2,2),pValue.stars=TRUE,ci.format="(l,u)") #' @export ##' @author Thomas A. Gerds summary.regressionTable <- function(object, show.missing="ifany", print=TRUE, ...){ pynt <- getPyntDefaults(list(...),names=list("digits"=c(2,3),"handler"="sprintf",nsmall=NULL)) digits <- pynt$digits handler <- pynt$handler if (length(digits)==1) digits <- rep(digits,2) if (length(pynt$nsmall)>0) nsmall <- pynt$nsmall else nsmall <- pynt$digits rawtab <- do.call("rbind",object) Rtab <- rawtab[,-match(c("Lower","Upper","Pvalue"),colnames(rawtab)),drop=FALSE] pvalue.defaults <- list(digits=digits[[2]], eps=10^{-digits[[2]]}, stars=FALSE) ci.defaults <- list(format="[l;u]", digits=digits[[1]], nsmall=digits[[1]], degenerated="asis") smartF <- prodlim::SmartControl(call=list(...), keys=c("ci","pvalue"), ignore=c("object","print","handler","digits","nsmall"), defaults=list("ci"=ci.defaults,"pvalue"=pvalue.defaults), forced=list("ci"=list(lower=rawtab[,"Lower"], upper=rawtab[,"Upper"], handler=handler, digits=digits[[1]], nsmall=nsmall[[1]]), "pvalue"=list(rawtab[,"Pvalue"])), verbose=FALSE) if (attr(object,"model")%in%c("Cox regression","Poisson regression")){ model <- "Cox regression" if (match("ProbIndex",colnames(Rtab),nomatch=0)){ Rtab$ProbIndex <- pubformat(Rtab$ProbIndex,handler=handler,digits=digits[[1]],nsmall=nsmall[[1]]) } else{ Rtab$HazardRatio <- pubformat(Rtab$HazardRatio,handler=handler,digits=digits[[1]],nsmall=nsmall[[1]]) } }else{ if (attr(object,"model")=="Logistic regression"){ model <- "Logistic regression" Rtab$OddsRatio <- pubformat(Rtab$OddsRatio,handler=handler,digits=digits[[1]],nsmall=nsmall[[1]]) } else{ ## assume "Linear regression" model <- "Linear regression" Rtab$Coefficient <- pubformat(Rtab$Coefficient,handler=handler,digits=digits[[1]],nsmall=nsmall[[1]]) } } Rtab$CI.95 <- do.call("formatCI",smartF$ci) pp <- do.call("format.pval",smartF$pvalue) if (length(gpp <- grepl("<",pp))) pp[!gpp] <- paste0(" ",pp[!gpp]) Rtab$"p-value" <- pp if (length(smartF$pvalue$stars)>0 && smartF$pvalue$stars==TRUE) Rtab$signif <- symnum(rawtab[,"Pvalue"],corr = FALSE,na = FALSE,cutpoints = c(0, 0.001, 0.01, 0.05, 0.1, 1),symbols = c("***", "**", "*", ".", " ")) rownames(Rtab) <- NULL rownames(rawtab) <- NULL ## e.g., MIresults do not have a column Missing but use Imputed if (match("Missing",colnames(Rtab),nomatch=0)>0){ if (show.missing=="ifany") { show.missing <- any(!(Rtab[,"Missing"][!is.na(Rtab[,"Missing"])] %in% c("","0"))) } if (!show.missing){ Rtab <- Rtab[,-match("Missing",colnames(Rtab))] rawtab <- rawtab[,-match("Missing",colnames(rawtab))] } } ## reference lines nv <- length(Rtab$Variable) if (nv>1){ if (attr(object,"factor.reference")=="extraline"){ ppos <- match("p-value",names(Rtab)) for (r in 1:(nv-1)){ if (Rtab$Variable[r]!="" && Rtab$Variable[r+1]=="") Rtab[r,((ppos-2):ppos)] <- c("Ref","","") } } } ## cat("\nSignif. codes: 0 '***'0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1\n") ## FIXME: should filter the relevant of list(...) Rtab <- do.call(labelUnits,c(list(x=Rtab),list(...))) res <- list(regressionTable=Rtab, rawTable=rawtab, model=model, blocks=sapply(object,NROW)) class(res) <- c("summary.regressionTable") if (print) print(res) res } #' @export print.summary.regressionTable <- function(x,...){ print(x$regressionTable) invisible(x$regressionTable) } Publish/R/summary.univariateTable.R0000755000176200001440000002113714252330763017033 0ustar liggesusers##' Summary function for univariate table ##' ##' Collects results of univariate table in a matrix. ##' @title Preparing univariate tables for publication ##' @aliases summary.utable summary.univariateTable ##' @param object \code{univariateTable} object as obtained with ##' function \code{univariateTable}. ##' @param n If not missing, show the number of subjects in each ##' column. If equal to \code{"inNames"}, show the numbers in ##' parentheses in the column names. If missing the value ##' \code{object$n} is used. ##' @param drop.reference Logical or character (vector). Decide if line with reference ##' level should be suppressed for factors. If \code{TRUE} or \code{"all"} ##' suppress for all categorical factors. If \code{'binary'} suppress only for binary variables. ##' Can be character vector in which case reference lines are suppressed for variables ##' that are included in the vector. ##' @param pvalue.stars If TRUE use \code{symnum} to parse p-values ##' otherwise use \code{format.pval}. ##' @param pvalue.digits Passed to \code{format.pval}. ##' @param show.missing Decides if number of missing values are shown in table. ##' Defaults to \code{"ifany"}, and can also be set to \code{"always"} or \code{"never"}. ##' @param show.pvalues Logical. If set to \code{FALSE} the column ##' \code{p-values} is removed. If missing the value ##' \code{object$compare.groups[[1]]==TRUE} is used. ##' @param show.totals Logical. If set to \code{FALSE} the column ##' \code{Totals} is removed. If missing the value ##' \code{object$show.totals} is used. ##' @param ... passed on to \code{labelUnits}. This overwrites labels ##' stored in \code{object$labels} ##' @export summary.univariateTable ##' @export ##' @return Summary table ##' @author Thomas A. Gerds ##' @examples ##' data(Diabetes) ##' u <- univariateTable(gender~age+location+Q(BMI)+height+weight, ##' data=Diabetes) ##' summary(u) ##' summary(u,n=NULL) ##' summary(u,pvalue.digits=2,"age"="Age (years)","height"="Body height (cm)") ##' ##' u2 <- univariateTable(location~age+AgeGroups+gender+height+weight, ##' data=Diabetes) ##' summary(u2) ##' summary(u2,drop.reference=TRUE) ##' ## same but more flexible ##' summary(u2,drop.reference=c("binary")) ##' ## same but even more flexible ##' summary(u2,drop.reference=c("gender")) ##' ##' summary.univariateTable <- function(object, n="inNames", drop.reference=FALSE, pvalue.stars=FALSE, pvalue.digits=4, show.missing=c("ifany","always","never"), show.pvalues, show.totals, ...){ if (missing(show.totals)) show.totals <- object$show.totals if (missing(n)) n <- object$n if (missing(show.pvalues)) show.pvalues <- object$compare.groups[[1]]==TRUE # {{{missing and n if (!missing(show.missing)) if (is.logical(show.missing) || is.numeric(show.missing)) if (show.missing==1L) show.missing <- "always" else show.missing <- "never" show.missing <- match.arg(show.missing,c("ifany","always","never"),several.ok=FALSE) # }}} # {{{ pvalues if (show.pvalues && !is.null(object$p.values)){ if (pvalue.stars==TRUE) px <- symnum(object$p.values,corr = FALSE,na = FALSE,cutpoints = c(0, 0.001, 0.01, 0.05, 0.1, 1),symbols = c("***", "**", "*", ".", " ")) else px <- format.pval(object$p.values,eps=10^{-pvalue.digits},digits=pvalue.digits) names(px) <- names(object$p.values) } # }}} # {{{ order the table according to formula if (is.null(object$groups)){ XX <- all.vars(object$formula) } else{ XX <- all.vars(object$formula)[-1] } order <- match(XX,names(object$summary.groups)) ordered.summary <- object$summary.groups[order] # }}} XXtab <- NULL # {{{ loop across table elements for (s in names(ordered.summary)){ if (!is.null(object$groups)){ sum <- as.matrix(ordered.summary[[s]]) if (show.totals) sum <- cbind(sum,Total=object$summary.totals[[s]]) } else{ if (show.totals) sum <- data.frame(Total=object$summary.totals[[s]],stringsAsFactors = FALSE) } if ((show.missing!="never") && (show.missing=="always" || any(object$missing$totals[[s]]>0))){ if (!show.totals){ if (is.null(object$groups)){ miss <- object$missing$totals[[s]] }else{ miss <- unlist(object$missing$group[[s]]) } } else{ miss <- c(unlist(object$missing$group[[s]]),object$missing$totals[[s]]) } } else{ miss <- NULL } sum <- rbind(sum,miss) if (object$vartype[[s]]=="factor"){ lev <- object$xlevels[[s]] if ((is.logical(drop.reference) && drop.reference[1]==TRUE) || (is.character(drop.reference) && (s %in% drop.reference)) || (is.character(drop.reference) && drop.reference[1]=="binary" && length(lev)==2) || (is.character(drop.reference) && drop.reference[1]=="all")){ ## remove redundant line for reference level lev <- lev[-1] sum <- sum[-1,,drop=FALSE] } } else{ if (object$vartype[[s]]=="Q") lev <- gsub("\\(x\\)","",object$Q.format) else lev <- gsub("\\(x\\)","",object$summary.format) } if (!is.null(miss)) lev <- c(lev,"missing") if (show.pvalues && !is.null(object$p.values)){ p <- px[[s]] if (NROW(sum)>2 && NROW(p)==(NROW(sum)-1)){ sum <- cbind(sum,rbind(rep("",NROW(sum)-1),p=px[[s]])) colnames(sum)[NCOL(sum)] <- "p" } else{ if (is.null(miss)){ p <- c(rep("",NROW(sum)-1),px[[s]]) } else{ p <- c(rep("",NROW(sum)-2),px[[s]],"") } sum <- cbind(sum,p) } } ## fac <- c(s,rep("",NROW(sum)-1)) fac <- c(s,rep("",length(lev)-1)) sum <- cbind(unlist(fac),lev,sum) ## if (NROW(sum)>2) sumXX <- data.frame(sum,stringsAsFactors=FALSE,row.names=1:NROW(sum)) rownames(sumXX) <- NULL XXtab <- rbind(XXtab,sumXX) } # }}} # {{{ column names and n if (length(n)>0 && !(is.null(object$groups))){ if (n[[1]]=="inNames"){ if (object$big.mark!="") object$groups <- paste(object$groups," (n=",format(object$n.groups[-length(object$n.groups)],big.mark=object$big.mark,scientific=FALSE),")",sep="") else object$groups <- paste(object$groups," (n=",object$n.groups[-length(object$n.groups)],")",sep="") } else{ XXtab <- rbind(c("n","",object$n.groups,""),XXtab) } } if (is.null(object$groups)){ colnames(XXtab) <- c("Variable","Levels","Value") XXtab$Variable <- as.character(XXtab$Variable) XXtab$Levels <- as.character(XXtab$Levels) totalName <- "Total" pname <- NULL } else{ if ((show.pvalues==TRUE) && !is.null(object$p.values)){ if (tolower(as.character(object$compare.groups)) %in% c("cox","logistic")) pname <- paste("p-value ","(",object$compare.groups,")",sep="") else pname <- "p-value" }else pname <- NULL if (show.totals[[1]]==TRUE){ if (length(n)>0 && (n[[1]]=="inNames")) if (object$big.mark!="") totalName <- paste("Total"," (n=",format(object$n.groups[length(object$n.groups)],big.mark=object$big.mark,scientific=FALSE),")",sep="") else totalName <- paste("Total"," (n=",object$n.groups[length(object$n.groups)],")",sep="") else totalName <- "Total" } else totalName <- NULL } colnames(XXtab) <- c("Variable","Level",object$groups,totalName,pname) # }}} # {{{ labels & units class(XXtab) <- c("summary.univariateTable","data.frame") XXtab <- do.call(labelUnits,c(list(x=XXtab),list(...),object$labels)) # }}} rownames(XXtab) <- NULL XXtab } ## the name utable is more handy ##' @export summary.utable ##' @export summary.utable <- summary.univariateTable Publish/R/splinePlot.lrm.R0000644000176200001440000000641614142666146015147 0ustar liggesusers### splinePlot.lrm.R --- #---------------------------------------------------------------------- ## Author: Thomas Alexander Gerds ## Created: Dec 31 2017 (11:04) ## Version: 1 ## Last-Updated: Dec 1 2020 (16:52) ## By: Thomas Alexander Gerds ## Update #: 24 #---------------------------------------------------------------------- ## ### Commentary: ## ### Change Log: #---------------------------------------------------------------------- ## ### Code: ##' Plotting the prediction of a logistic regression model ##' with confidence bands against one continuous variable. ##' ##' Function which extracts from a logistic regression model ##' fitted with \code{rms::lrm} the predicted risks or odds. ##' @title Plot predictions of logistic regression ##' @author Thomas A. Gerds ##' @param object Logistic regression model fitted with \code{rms::lrm} ##' @param xvar Name of the variable to show on x-axis ##' @param xvalues Sequence of \code{xvar} values ##' @param xlim x-axis limits ##' @param ylim y-axis limits ##' @param xlab x-axis labels ##' @param ylab y-axis labels ##' @param col color of the line ##' @param lty line style ##' @param lwd line width ##' @param confint Logical. If \code{TRUE} show confidence shadows ##' @param newdata How to adjust ##' @param scale Character string that determines the outcome scale (y-axis). Choose between \code{"risk"} and \code{"odds"}. ##' @param add Logical. If \code{TRUE} add lines to an existing graph ##' @param ... Further arguments passed to \code{plot}. Only if \code{add} is \code{FALSE}. ##' @examples ##' data(Diabetes) ##' Diabetes$hypertension= 1*(Diabetes$bp.1s>140) ##' library(rms) ##' uu <- datadist(Diabetes) ##' options(datadist="uu") ##' fit=lrm(hypertension~rcs(age)+gender+hdl,data=Diabetes) ##' splinePlot.lrm(fit,xvar="age",xvalues=seq(30,50,1)) ##' @export splinePlot.lrm <- function(object, xvar, xvalues, xlim=range(xvalues), ylim, xlab=xvar, ylab=scale[[1]], col=1, lty=1, lwd=3, confint=TRUE, newdata=NULL, scale=c("risk","odds"), add=FALSE,...){ lower=upper=yhat=NULL expit <- function (x){exp(x)/(1 + exp(x))} input <- list(object=object,xvalues) if (!is.null(newdata) && is.list(newdata)){ input <- c(input,newdata) } names(input)[[2]] <- xvar if (scale[[1]]=="risk") input$fun <- expit else{ ## set reference level for odds input$fun <- exp } pframe <- do.call(rms::Predict,input) data.table::setDT(pframe) if (missing(ylim)) ylim <- pframe[,c(min(lower),max(upper))] if(!add){ plot(0,0,type="n",ylim=ylim,xlim=xlim,xlab=xlab,ylab=ylab,...) } pframe[,graphics::lines(xvalues,yhat,lwd=lwd,lty=lty,col=col,type="l",ylim=ylim)] if (confint==TRUE){ pframe[,polygon(x=c(xvalues,rev(xvalues)),y=c(lower,rev(upper)),col=prodlim::dimColor(col),border=NA)] } pframe } ###################################################################### ### splinePlot.lrm.R ends here Publish/R/glmSeries.R0000755000176200001440000000435314142666146014160 0ustar liggesusers##' Run a series of generalized linear regression analyses for a list of predictor variables ##' and summarize the results in a table. ##' The regression models can be adjusted for a fixed set of covariates. ##' ##' @title Run a series of generalized linear regression analyses ##' @param formula The fixed part of the regression formula. For ##' univariate analyses this is simply \code{y~1} where \code{y} is ##' the outcome variable. When the aim is to control the effect of ##' \code{vars} in each element of the series by a fixed set of ##' variables it is \code{y~x1+x2} where again y is the outcome and x1 ##' and x2 are confounders. ##' @param data A \code{data.frame} in which we evaluate the formula. ##' @param vars A list of variable names, the changing part of the ##' regression formula. ##' @param ... passed to glm ##' @return Matrix with regression coefficients, one for each element of \code{vars}. ##' @author Thomas Alexander Gerds ##' @examples ##' ##' data(Diabetes) ##' Diabetes$hyper1 <- factor(1*(Diabetes$bp.1s>140)) ##' ## collect odds ratios from three univariate logistic regression analyses ##' uni.odds <- glmSeries(hyper1~1,vars=c("chol","hdl","location"),data=Diabetes,family=binomial) ##' uni.odds ##' ## control the logistic regression analyses for age and gender ##' ## but collect only information on the variables in `vars'. ##' controlled.odds <- glmSeries(hyper1~age+gender, ##' vars=c("chol","hdl","location"), ##' data=Diabetes, family=binomial) ##' controlled.odds ##' @export glmSeries <- function(formula,data,vars,...){ ## ref <- glm(formula,data=data,...) Missing=NULL data.table::setDT(data) data <- data[,c(all.vars(formula),vars),with=FALSE] glist <- lapply(vars,function(v){ form.v <- update.formula(formula,paste(".~.+",v)) if (is.logical(data[[v]])) data[[v]] <- factor(data[[v]],levels=c("FALSE","TRUE")) gf <- glm(form.v,data=data,...) ## gf$call$data <- data gf$model <- data ## nv <- length(gf$xlevels[[v]]) rtab <- regressionTable(gf) rtab[[v]] }) out <- data.table::rbindlist(glist) if (all(out$Missing%in%c("","0"))) out[,Missing:=NULL] out[] } Publish/R/fixRegressionTable.R0000755000176200001440000001252514142666146016025 0ustar liggesusers##' Expand regression coefficient table ##' ##' This function expands results from "regressionTable" with ##' extralines and columns ##' ##' For factor variables the reference group is shown. ##' For continuous variables the units are shown and ##' for transformed continuous variables also the scale. ##' For all variables the numbers of missing values are added. ##' @title Expand regression coefficient table ##' @param x object resulting from \code{lm}, \code{glm} or \code{coxph}. ##' @param varnames Names of variables ##' @param reference.value Reference value for reference categories ##' @param reference.style Style for showing results for categorical ##' variables. If \code{"extraline"} show an additional line for the ##' reference category. ##' @param factorlevels Levels of the categorical variables. ##' @param scale Scale for some or all of the variables ##' @param nmiss Number of missing values ##' @param intercept Intercept ##' @return a table with regression coefficients ##' @author Thomas Alexander Gerds ##' @export fixRegressionTable <- function(x, varnames, reference.value, reference.style=NULL, factorlevels, scale=NULL, nmiss, intercept){ if (missing(nmiss)) nmiss <- NULL some.scaled <- sum(scale!="")>0 ## for some reason logical value variables, ie with levels ## TRUE, FALSE do not get xlevels in the output of glm loc <- grep("TRUE$",rownames(x),value=TRUE) if (length(loc)>0){ locvars <- lapply(loc,function(l){ substring(l,1,nchar(l)-4) }) names(locvars) <- locvars factorlevels <- c(factorlevels, lapply(locvars,function(l){c("FALSE","TRUE")})) } factornames <- names(factorlevels) ## for some reason ordinal variables get strange labels ord <- grep("\\.L$",rownames(x),value=TRUE) if (length(ord)>0){ orderednames <- unlist(strsplit(ord,"\\.L$")) }else{orderednames <- ""} blocks <- lapply(varnames,function(vn){ isfactor <- match(vn,factornames,nomatch=0) isordered <- match(vn,orderednames,nomatch=0) ## the regexp is supposed to catch the term `age' in ## age and I(age^2 and interaction(age,sex) and ## interaction(sex,age) and fun(age) if (isfactor){ if (isordered){ vn.regexp <- paste("^",vn,".[LCQ]$","|","",vn,"\\^[0-9]+$",sep="") }else{ levs.regexp <- paste("(",paste(factorlevels[[isfactor]],collapse="|"),")",sep="") vn.regexp <- paste("^",vn,levs.regexp,"$","|","I\\(",vn,".*",levs.regexp,"|",vn,"\\)",".*",levs.regexp,sep="") } } else{ vn.regexp <- paste("^",vn,"$",sep="") } parms <- grep(vn.regexp,rownames(x)) block <- x[parms,,drop=FALSE] Scale <- NULL Missing <- NULL # {{{ discrete variables if (isfactor){ if (reference.style=="inline"){ Variable <- c(vn,rep("",NROW(block)-1)) Units <- paste(factorlevels[[isfactor]][-1], "vs", factorlevels[[isfactor]][1]) if (some.scaled){ Scale <- rep("",NROW(block)) } if (!is.null(nmiss)){ Missing <- c(nmiss[vn],rep("",NROW(block)-1)) } } else { Variable <- c(vn,rep("",NROW(block))) Units <- factorlevels[[isfactor]] if (some.scaled){ Scale <- rep("",NROW(block)+1) } if (!is.null(nmiss)){ Missing <- c(nmiss[vn],rep("",NROW(block))) } block <- rbind(c(reference.value,rep("",NCOL(block)-1)),block) } } else{ # }}} # {{{numeric variables Variable <- vn Units <- "" if (!is.null(nmiss)){ Missing <- nmiss[vn] } if (some.scaled){ Scale <- scale[[vn]] } } if (some.scaled){ do.call("cbind",list(Variable=Variable, Scale=Scale, Units=Units, Missing=as.character(Missing), block)) }else{ do.call("cbind",list(Variable=Variable, Units=Units, Missing=as.character(Missing), block)) } # }}} }) out <- do.call("rbind",blocks) out$Variable <- as.character(out$Variable) out$Missing <- as.character(out$Missing) out$Units <- as.character(out$Units) rownames(out) <- 1:NROW(out) # {{{ add intercept if it is wanted if (intercept!=0 && (found <- match("(Intercept)",rownames(x),nomatch=0))){ inter <- x[found,,drop=FALSE] out <- rbind(unlist(c(Variable="Intercept", Units="", Missing="", inter))[colnames(out)], out) } rownames(out) <- 1:NROW(out) # }}} out } Publish/data/0000755000176200001440000000000014142666146012603 5ustar liggesusersPublish/data/Diabetes.rda0000744000176200001440000003770614142666146015031 0ustar liggesusers‹Õ½xÕÖ6¼Ÿ„ `( 5$¡…Pé½ì„$´@ ! -ô(%Ò‹`¨¢""‚( M‘¢¨ ˆG±€T@@š àQE¥ßÚÏÜkfØo²Ïû="²ÏûC"²Ë›ìò&»¼É.o²Ë›ìò&»¼‘MÞd“7ùÀ›lò&›¼É¦f5ˆÈ_Íüˆü‰óf„skò]kò]kò]kò](ñ %¾¡Ä/”ø…æaŸ‘̰ÃD$+ŒÚÃT;ù"Œp #™aÄ#ŒdE¾ä‡HÒ?r'Ñ."²#Žì#Lã “xÂ3žp‰§¶xÂ1žp‰_'DÂ""Â9á9"“@ø'¬'"Ì^!ÚHDØ%Î#z‚ˆðO$¼ ïDòK"ažHsŸ'ZAD²‰OâJ"’—HüINâV"Â<‘ðN$¼“ˆWñJz’ˆ|™Dz$QŽ$‘O“ˆWÍO"&‘þIˆ6‘ï’ÈwIÄ'é "ò_ñKRüÈî$ŠÉ$òYa‘´—ˆ|—D±™´ˆ|˜tˆâ8¹„h:ÑL¢YD³‰H´û…ÈèAT@Ô‹è>¢ÞD}ˆú L4„h(ÑDÉF#šH4èa¢D$#c.ÑcDdsÉÉ ˜Î ;3Ç Â1ƒpÌ 3È7ä› ²9ƒ|Avg¼FDöfÙCÙ”¯ÙCÙ”«Ù”§ÙmˆB‰Â‰"ˆ¢‰bˆ$Q*QQ:QQ&QG¢nDyD݉ÈÖìžDdo6ٛݗˆlÌ.""Û²G=H4–hÑd"²/›0Ì&Û²%"»²)'³É¶lòeN5"o"ª59õˆ¨ÞäPìçÎ9AD͈¨¾äî9¤{éCzçR½Ë¥z—Ku4—jS.Ù™Kvå’Þ¹í‰:‘þ¹ˆrˆHÿÜ|"Ò=—|”Û¨ˆü”;ˆü’Kú?Ÿ@”$ÄŠH¢("’UJ²K‰w)É.'J$"œJ §R’WÚŽ¨+É)%¼Js‰H^)áUJ²JIV)É(DDx•Qí,#Ÿ”µ""ye)DįŒt.#˲ˆ:eß2âQFqTFX—ÑzQ6^ˆ•„ÑJÂhÕŒU„Ûª"òù*ªÑ«¨}5ÕðÕ~Öš"¨î ŠAµ@t!ºBD눠ú%¨& Ša*.QÝ?QꎸID5HP ”?‚rI\0ø:ê‚/åø®þÝâ+(.•£Ø ¾Š­â´Sì ªk‚ê•£"dÒz'¨æÅ’jƒx²i=”Ÿ‚j¨ƒü/¨†‰}°ï'ƒƒpTÇT¯ÅBèJµCœo%—ê° Ü”O‚òHlŸ/€Ã"ª©âšqt´‚ŽTC噸Ôv}”[Åo#ø)ì%ºLDñ/¨. ª«b;ðX™TÛM 8š€÷ït^ßÀÛá[vßC·À̾ÜÜ•~T³Ä«hSºQMeD; ùŽd:î†ìéèSt>ø1qq°Á8wPþ;ª·mðãMè{¾ÿ7Ñ&ئÆÐú+(vÕ1~<0¸›Þ†O×C… ­%â00¤1Ž{ œ×sZÕr±zn„MŸÂ–ÃÐe?ÚÀ÷´îª˜rb»z}b`ãôÒá3`÷±‰“ž1ppä£o9äÓâŒ=ZSÄEè°8]4ä;ª{Z›Å|øl£áw3¯>ƒ};ÁŸâÉQþ»dĆø¤ü¶˜ü¼UŒ«Ø xs„Ñ‘Ög¾){®'Òñy`ȸ+]T^ªv¨Üy„è4tR2U<ÐZåŒámO'nOZ³¾ðÉëÆ|çµòñ*ØI1ãPùý íûœùût¦ÜuƉ’9 ¾T¸¬æ× Gésü”}—¡Ûqäë+ÐóàHk¦3ÏK9Žðû.à¶2æ@'5VÅűÃX](«l|¸Z/Äd´ÓúíÌÅÓÀs/ìý²È§ŽØö%t9ŠñGà5ö:ƨøÙ_qlªkU3r L¾Ž4ÔFŃkKkcŽCÝk‚Ö:Aë«è‹kZÇí‘DOŒ+A­i‚Ö7Aë¤s*&Ê6ŠíE-Áƒl]Á‡ÖFA{Aë» uTÐëèhýЇÊÉ0çS´¥CVäFÂg'0·#ôëa³…öâ~è¬ì¡uF &v?»CNgØ¥ü6>í ]2 7ŽˆöF‚öI¢zõ5xŠ¡Ýcß×Á³tVãÞ‡NS‰’1VÉ }¤Põ¸;ä)|gmÎz0 <•Ü¡ó``ÒztF{ì{Ŧ‹Ò™ö9btÞʪçÎõ}x FL€M#…‘*ÆB…#9À»:â\ÙGû6Aû)g ç¡ö*®œõv°½s•~*—&¡½xO‚>yŠ·‘ÆxÇt´)¨ýÏlàªpÞƒq>×=U;Ø7 ~!c Ï}Ða!lŠ9GWèÕ8ÐþÓYC8ŽUMSkU<ì‰F\Œ‡¬XØ”€ö\Ø[€ãrèZyÑðÑÛÐ?²•¿Òa_Gè1º÷ßAÛ ã2mØ+ÀAaµ ú+[ºÇmá_uT{‡|ðSÇ.Ð[éÑ ü:B‡Þà;úwA›Âsìëˆùl»òñè͵„óGUk€Æ:ZhÃîaÅóx›ŽðuOÈTý*&RakúÛ¥ß˰Eá< þàºÓ6%âz9ô l¿®hë›ó!ƒù+}g`\[Øš‹¹J'«”Ÿº¿púŸkL/ÃNgÝï^ «•àŸ¬$°ÍÃüî \ðè=XaÅd;ó^wNÓlz Ã1ÏàãxÐÀÕ¹7âúÆkŠŠqºwj/¡öGjíQ±¡lRë¹ÚÓ¨½½ŠmºßjŸ¬Ö5ºçt¯&‚`GÌ ‡Œ–¸ýþ%ÂùO­-0¾%x*Ù)ð•Â9P5\õG@^ ÈRº¨|¬½# G¼M^3è¡x&Ážx´'b¾òM›ÜîÂʋѰ7¶q®¨XŒ‚.‰°!8AHè«æ·Ç¼(ØÒ sÕ1òR — ¡MÿPP ôí‹yêºdwÖa F°7çÝløEb~<ú”1¾ø…@ÖpŒåqÍ¡[#ØÑ>U±W|:`l#ØTÏÆ#:5…eCúC5›ÙŽ!À?̆w涆þu # ó’¡ckÈS²Ã1×cå¶Ç+jù*ßz§’£òlƶ‡Á߯†} 0i ü9&€‘Š µ×г]G׺à1öÅA¾š‹c8æ$Bßð‹€½-1¯50l;GÚpÃø›­þÀ6sbmØ´J^ú¹&äßPŒÆ5c ;“¡_20j¾JÇtÌãšÐvÅ +ÿÃ¥²-ã›C§¶h ‰ÂŠ]«*£ kø*¹]À?rý ÇŒwxÅ£-MX5PÚì÷³Ù8‡Ø\‚ G*d7&œ# /×ðK$ÚÚ€oàÔãò`{Cð®¼{aLoaÕQöYøÛlh‹>µ¦pý ‡½ã…Uã‚0WíYª©5EzîÛ·«ÿÁ‡eýeËʲ—HYg߾ݞ¥H¥‰bÐ×<®fDDÊoý«H­½Þ!ý6í–Þ˜W㸽·C«§ññE?Ë©ŠëJè÷ÆxÖ×ÇàŸrcÈÂJn¥¿ÑÿðEÅýžU²æ­ãÌëà9Ü^Y“wOD„,m5]ÖævèÍó=Ø\³þ¬Ÿ/ø×€ü¦àÇíUÐÎÇ{Yú™oÈåvÖç¹cË©¥ÙËzGdó|pÍøòü à[ó+`œÀ‘ña9l¿>Çyk×ìg?ð3ñ‚]µ`/Ç çxáv–Ç8xiñ¢óá#û“õ®ý8^«£¿¾ÆýPCóÏ÷ÔôáüðÕüÅ|«i~c±|Ö¿š–W>îf|a<ÇóaÜùšÇ1¶Ïü½´ü`2nÜ_ílóç¼å:ÂãÜ4>Ž\s{à²e¥W6yÈ-¾8nØß¬7ãÊñÆùWO‹?¶»†¦e-™?ëÃ~¨§É7qÁ5ãÅùÊþ`ÿqq¢=@‹G¶ƒãÖW‹G¾æzÊ~©©µ{kõ•qf½¹°¿ô:Ë|Xß8²?ή§×ì_¶Ÿåëv0_öãè‡#_3?/-_//­ž{kùÂ~çøæq|¬ªÅç!ò3å/ÆK«×•5;ïZ}Ðã…qgÿÝ«ÕqŽ7ÖOÏCÆO_އœ•týpÍõíæ¼âºTK‹K½Îq¼p?¯ëu´uÑKË/–ÏþáxÔ×AO­þ1>|Íüy\e-L¿àXC«GzüsM­Îkq¦×ÿÚZÝ`;ªhuˆ¯ÍzñzÞÔÓòŒ¦ß5üiqà¡Õ=“×-ÎݵýI-Í¿Olçµ—–¿U˱×ü*hú0Þ 5¹úú\E‹G_­Ÿñd='îgyŒ Ï3÷~~š<ÇûCŽg?-N¸½Š–OUµúä«Õ!Ö¯ŽæÇ†C†ô¯˜}ÍÏö²]|ô×øÖÖò‚íáxåu–í®¯­wŒ»¾ïã~Ž?æÇãêêuKÛG óŸqâ•T\úyÊéµgAÿ6»ŸÞ z&öŸ)½gûïÚ²uµô?Õ®ôú¶²&ÆÕì|óàcù²úlÿÝý¦×3¯kûoïïÞñŒ¬é3ùÄEß Yó¼pôÆ8ï>%)†Ê{Ûm \ú¢ôÊùñáÝyˤ7æûâ4ù”ü«ö—²îå=ÿûã¶æ¼æh¯}¼‹WŸx¯tª¬±=ç¤ßcŸ›öz7ôñ¢yYúHŒg½ÚTIš~ÿ§d­Õ‡D«qëeÕÞÍÅÃùûe Ì÷(^}rÔ¿KÏɧRʦ“uU‘_m‘ï ý«ûoï×cÚpéeàfÞÕÆx/Œ¯|›òúëZí6œ*½8^8?ØÛh¯1®.篳?ά~áÙÒh7å7=fàîƒþV+ =«׿8/Æ òƒ¾øqÚ°·7˜qÈõ¢÷­ü¼ ?ëQø6À<_ŽƒàË»N¶è,«ÏúÀ…ãÇþ«Åz þ8jŸ¦u±î@kàèƒùzüÙß>˜ÏòÌõzàèƒüi‚û¸ˆ»È'_ØÅyÓø±¤’šQ;Mÿû`|-Ž#îLœ½5€ ¯Ævß×<ÏœÏqáÅq ~çŒ:UrS~V~ö[YñS£Š¡gµí9'Šßé)kr݇ÿü9_'Œ‹ðª‡ù55¹uà'ÎSŒ«Ïuƒ÷ lôiDyÖ¼x‘ô…¾5Xâª.äúBoðmŒqµxýd?b_7¿¸úTýØd-èÇu˜ëç7ÇYK®»ˆö“7ç/¯ÿ%oØkîq}/êbãÕ_ßüzÁHYó›µö™þLzw7Î+?àßp꯻èoÀû^àÂõŒýWü¹>ð|Æ“õâºÎúúíf\1ì'ŽCö‡üûMùð ×ç:8ÖävØËùËëï<¡oàÃü¸Ž7§<þdU ÜyÃüooÕ1àVãÌu‡íàz \8n|¡§Ç ÆqòEÜ×âu ã¼ ¯ä4lløëçiЇ’uæ:U“ó zT‡Þu¡w]èkÆ7Ç×;\s¾Õ`{8ÏyÁqÀ8ð>v7à:¾¬/ø4A™u÷¿¨#¬¯çp¬;y}¨Áy¹¼«nÌ·~Odý´xæ}«¹þ>ÜÎuúx±|øÁÔó‰ë:üëÃyÂõó8Ôܦœÿð×—ªÈûj|£­3ô87¹½¬^%éá¡E™&Ž1¾ÖŽƒJW òO¾¯®‹q“ŠË‚š¾*½ágŽÖ«6ìçú`Ú¯Éçø¨©ù7pœ‹1ÿ¶õ(ëóžæï,À¹)âˆýRqâÁøÃÕ¸îàÚóòž’¥KÞ2ëˆßÞìö'ì¨Åû2ð÷CÝa|½y]Â8ާ𼄼ú°¯®ƒs°/ÒÚ¹>†œjWöÒôŲ Æ5AݪŠý.ç5ã}yÌvqä:îÍþg;‘W¼ïc|xŸÅëœüÉû9ÎCÆÑ‹çóýÿn yÀÅõ«ÑN#Þ¸òúÆë¨Yçµõ…ñ õƒ½Ð¿eÚ‚~3¯%½n/„;ÿ?yÇ]’Û]ÐÂënÇþ¿@wƒÍÿÝIîÝèVžþ^ÿ 6ÿ fw‹óÿ4þwëãÿíØúߎ÷ÿVßÿ?óän}ýßâú¿­ÿÿ…tË;‡?x¸z¯†³×h­’6nàE#‡+Áã²F+S¨Íö8¼p O6Y)8vÔha¼XÀ ˜z8@=,¢PHa<Р~òV8¨/ÔC êAõz)€Hh(Œ |p­^PvðÃfiÂx‡üÆCj¾z B=Œª‹y¡?8R ãø!´öàÅÕC?~-:gB/¥“z"LstÖCJGõ †ä´ŸûÀ·6xC‡,èŠñü€V’°ȈŽ™*¬‡/$°h }qÍ$¥‚ãü §zxE=¼¡B Æ#M SÝš¤@§(Ìm]„õ°WmÈ­¹í WKa=蕈k57ø†wC´§oˆ ~°Ðòn𩲱ü€þfà§øæ“6hSµ€®è‹€¾áÀ4 í¡WmÌm ™©Âzx1IXÐ¥ßæÂz¨)[X=ŀꃯj낱À-<ýlÇØ|l“Õ ØúC&?xØ6E`l0l~áÂzOÍk¼3 GÅz]Ø+¬ÔÞêa¿@aÄG;´€lm]›@È v À® ° ±.aÂzH3XX-5Àœpôs¾òÑþMñÀv4†ìZè«™-¡¿x¤á:²“0¶#ðõ…m-0¶‘°¼ ýõ¡C*xr*Œbžp®g³S„Žì¿(ÈŒn\O¹ö„À¶pÈåm›Á_\G®1à‘(¬‡Ü•­]ÑÖ8·ÖCi;*¾â!+RXy›šÚìVlrmN€ÿ"`7×ÝžÐ/²‘?.oŠþi¡Õçéç®x;Ê«·•·y¹“ÿ¤çÿ—yåÍÑõ/oî"³¼ãÝl:ËÛì¹âõOú”ç«òúÊóëÝøûnurÅãnãëNrîÖ§ååÅbõ?‰Áÿ$Gþ)Vþɧw²ín0¾[»î&ö\ñ¾[îdÏ?ñ*Oæâù:—þI‡;ñº›þ;Õ‰òâøŸòª;Õm›zé­†³Ÿïd(>WœçΑî<òÎ÷—ïÁX¾ÖËg‰6ýÛa|èÑÁŽ#xÛå¦Ûø§cN ìa|¹-æƒ}|ëjoÓ1 :ðþ‘uÌÄÜöhϲùÇò}Ý}ÑÎ/±¥@öU[ÛüLØËþcÛ9VÒ!Ÿ1ä>¶å2^ü¢ëÚÖ6>ö¦ŽŽŸT›ÙFöÛš$lñŸ1$èÈrÓm:ÆØæ±_íyÒIXñlëKÁ5û:UXþe]x¬=>9ÖY㟠¬û<Æ;ÝÆÛîÇDq«¿íùÐÎ&»ƒ°âÊn—´Éa°¶›}ϲÒmüOþƒsƒ}Ïvò<~yud,ív1~‰†Û;ŠÛs•}*+ÛÊ~d›9¯ì˜².¬× ®-RX±Áxqj ]_Î#Ž;–‰ÂŠ nKÃ8~é†_6d?°|5.^X/ 1†lÇr¬¸µ·?޶Ý^»X.ç<¿œ¨Ç¯)êÅêoŒeËùR¬ú°Ä;Âøx‚ú€„ú¸‚ú ÁsÂøˆ„j[‹qÏã¨> 0M/…oÎM8…ñRýƒÂx™çº0^l[(Œ-l$zr6bÌ[àµãÔ‡+Ê s7ÑßD ãåýµ·UWxV­P/F¿(œzpx£ÿd+…ñâüTð™¾ê\½Dû0d_6Æ:Ôc‹ó…ñ¡5_½`|2•lõ…A Á!Øñ ô_ÛÔ r›ùÀà9C_ó£#Šï'Ð]}lbÚY_ÅïKa|8d ðS¾{ÕÀÞùa‹{ÀW½Pø2æP»óCëlöÿ.Œ—¼ç_™ŸCÅÊ$èO¶:?tòø,Bßzô+»Š„ñ12‡ÆGEVCÞÂø úøÐ®ÇY"œÿV Š0bAùð-´/4ìs¨ß/6ÀžÇàëÀçæìn §-è;Þ*~÷û§€™â·rfã#!×€·ÂDíÁ¾À|ÅoÆ-„<Õö$Ú¶Ao哹.×è¶ þRºÎ‡>#¡/Çñ;8Ÿ¾*Þ—ÏC¶Ãº®"zBñ©0ž•*÷ÔÇ^–C߃Âx Ÿø; ã£=jª>h£m¾*Œ¼WrÔ‡+6×Ëðñ‹ÆX§,寜«Õ«¾q4€meà£0_ »J`ÇTè¤rIåäaè§â°óƒ~-ÊîЦâVåä"Ø®bQ½ê°˜¯…«Á÷9´—ÁŸk€C)æ¯Þ[m>ÿ óßD»ª K s!|§ôY ?¼ÌŽAæ—†U`·§o„ù'ç]*ŸDÿ³ÀBéò1ôU8«ú°[XVz ~Ÿ›@…›ªÍÓáë3 ÇuÆ\çÇO¾)}N3Î×`ã"è¤âù%`ö Ú^„^Çl¿£•wj¿r®ïËîæžÏ ó]ñ)ï~¯¼û¾rïK„óŸ>Ç]”¯“}Žûx¹i¼ô{Jî³óÐõt¥“+[]ÙéJ7mýî.ø¸‹ÛuÓå;îÀÇÝ_Ý^WcLÜ]øÅ!\c©óÖ±u®õÕýìJ§òâL·A—í WWxÞæ'<]Ú§áSžoÊ‹EWqVŽ®|ë*–Ë‹GWqì*\ú×f§«9åÕƒ;áWÞ®|TžÿtÝR§ ó-¹6Wõ°¼ø¼Å>O»^:^v=þÉ®ÂãL]ؤct§¼S¹i¿£¹ócà GåŸÑ*Ž<¨h?Wà1fDáðáÿѯjj·Y,Œ•[íÀÔŽcÑJXV&ŒÏ•ÌÆÝÁ ´BÛ œ«¹›…±«» µZ®@ß“ÂØÅ©ÕWízÔNbæªÕzúÔ˜1àÿ櫤Úe<¶5Gõ‰ %; G5NÝÕ¨Õü Ø0¶•â|äð®`"ø” kç5 ¶Ï‡<ÞAmÆxµ#[ˆ±a³ÂTí¬·Ù; cÔ?ù4}Åà_>Lcl6/n3à£à«æ)?΄½ÃÎ%6âqAæHóS>™lãýt™=U˜³X³§‚æÙ0Sçj׽ņÅ3àÃqÆ>œ ^KÐ6@;â©wºÍ‡.£‹1žïžÕù‡à9<ç¢çnVüÌŸaàÉ2ÔÜwpÜŠ±eèSxíÖœ3ïÀVeãfðY"œÿ” Ú06óH»ÖõSû×ÚôRrÕ®y“¸Õ÷ŠÿXaø2ÆñãLà¯lŸ BÛa}b§º½jÃcEÉ¿²æ¸p,±ã…•CS5¼y¼ÒIýª0Íæ³ûa£Âï°Qz©ýè=²Š‰J0—sa2dñÝðdèÀ±¥è*Žcmzĸà÷ˆ°âïhÇy6š8ŽJ0g8üØËæ‹iÿÚ=,‡ufŒTûfŒQ¶?„>®‰\÷¸–*ÏAÿ2v}•/Öc<ß}³í\Ïfàº×üKÔ"aÝÕ´éø|ö°ò—k§Ò×õËžú…N=Á.Œ§Ôç Š• \·fj\W´§¡mŽYÂútjËŹú5°XŸxëŽke_Ûx%O=Q(¬_R%úÕõÄPOa=‘ÑMX¿üwuÖ'@ó1Vᑃþ^à3ÇÓ}™ŧÚ`La}ö²hÚ•ý‘Âú¿Rà§ìH†Ìî¸f<»ã|ðï »ú ósuN^½4ê€ã0èÚzØì(¬ÏjÁ¸t蚌¾,a}êt¤G{a=¥¥lÌ]À£ìè =Úƒ¾†SüÖ ×üÊöhg\3 Ëý8*}Æ +>& +Fò…õiÖ,Ûü!àÛצ'óï]ûƒºb|èÝUXŸqä_¯GBVú»à¨ô|ÆcÎ àÄýêWý¬áü'q ~ê¨~-ï ¬ÜébóÁ´çƒgÚ;ÚtW¶EÙìKV¨9ñ¶ù`O¼­Ÿcœc¾'äÏlaåU*Æeáz d2–I6Û1¶—°â%ýípÍq¸§ kOªæŽÖç59N9·{C R|V\¤ +.òÀ·@Xqž‡y‰Ð)ý}…õtcäªýT±0b6ã9¶ „õ¤!×ÎPèÈXtƒüޏþ]a+çÎ `e…¾Âòu/ðRsÃ…•Ÿ¶yìÇA6ê*¬øÎƒL),ÿr­ÌV ±Ëg[31·Ÿ°j6ÏeÙ] “sM)Æ"EÿÞäs\ó}J Ž3ìýh›è¢M­Oã¼L`¿¦Qkæã8W¿ümÕÇð|Ûù\WcÐç\wqþ´­}Yy<•ž.úÚúçÙÚgàø$ޝ—§ËH—IÿÆá¨öÎ{-MÞ4m¼·ÞvÍãW¹µ„¶ówÐíÀ]èÿœvýÒ]ÌQ{²Û|GÿuÑf÷÷3¶óqœ«_l;ÇÏmmsù(¬=î&ž+l>v¡Ëz×â¨î TœmeYúX݆"aìónñ“0ræIÛþ¿u‹ˆ6kóKïVÖtXj;WøÌÿ‡ñKlc§ÝaœK>ÂÀ±DkSÿ7‚ýwÀ.Ç6Æyïá‚ߦ»´sÆ?õÙu†}iãÔúõ„‹ù«Êá{[®â\ÕlÄùÓâV,øþX岺û׋4Ýô5¥·Ö_Œc>޽ìýhëï¢Í¹&âÜyŸâbL1QOœwuÅ[ç¯x¹ƒ>µN湘3ÈÅØ¡åñƒ.‰|nkï#ï=o['ñw“ì×é8ªýùaÝöÅ1O_`·‰þ ÇÑ•ßA<‡þu¼ƒnÿhýë¦]¸‹9ê¤|íÙ.ÚÆÚÎGÙÎ'â¨ãÑE×_ØbIaìa€Û!®ô²Íí…cËÖ¾r 66ßvÞ­<ž.dØ}ÓUXûÿ‘¶1yÐ5Kh~¶ýoIñ¶óåä¢mLw{éúhã\öAFG­Mùe4΋]Ùy·øíÝ¥wòu?3mmJÏžºMº^hï­·±]¶s»OÕ=‹Êeu¯2ZX÷Ìs…õ;Ê-þˆ/aÄ´?hž<¦¯°j × Ž7WÚÜ<Û¼Þ¶¾ñº/é*¬û3v0ŽûRO~´Æ[@ …õ––jkâOзÆ[>üIjþ<ºz{É_XŸåVãC…õùo?a¼Äo…éŸUW²q>Âzƒ)XXŸÖgÓ[ØÚY§–àqA8·¿ÚHXo"6†~~hç6þsMµ±,§µ°ÞN ÖÛjlëfÿ|wCØÜÄ&·ÍF¶©‘°þ$Ba}Ö¼±°þ4@3a½9Öø5ÖÛŽè Ö¨<Ž?©ß>b;ÛØl‰²ñliò!ÚÙ mvE€·:µÙß xµ‚ l“jS¿ú£­Î#ž¬"m7´aμB„õyû†×JóCsð ÖçëS~‹.ó¡ç¿5Ú@X¹Âo·5° Â<5¿ž 3û›~lG3`ÒHXŸZç>>6V¼±?ƒ…•g …õg ØÆ†ØüĹ€y1Âz#“ã–s¨±°â±æ…Û|û0DzøÍÛ aÅ~Kœs 5Ö¤!Ýý­l¶—P´q®°þÌ+ç\ÇïfÂz+—eC×­&˜Óz²ÝjN”Mf3aÅ€3VJ„ó_ Û\ƅLJB~aålsè×BXî‚ù¶´ñâ·Pí±Ëõ†s•ó˜c=PXñïoóÇc °ÞRåes>À†™ÓØ,¬¸åZȘ7 ëÏpl1Í„G!Âzƒœë3Ÿ³hSñ#¬Ø°cdãÛØÆ£‘°jN˜°þ¼¯¬S°°þôÿ9†H›Ü6âÖ7]› ëÏÌ„Øx† «F +Žì:²ß¢…W!6L«VÂúó5Œ ¿­ÛBXq Žþ6½›Ù(\Xo;óšÈqÉr‚5™ŒoK›ÎlŸ´aÌ>²¯Á\›`q럺IVÍ…m¬ç2×?^ÇÂÐ×ç<‡ßl·ïMBl>âu»°Ö[^‡Ø÷j ¿Ùϵ¢©°j}+Œgýø-î6»X×}^ZÙ0 ˜Paå*ùÀ¾^ñ8ÖqæÚÏû®UAèã½ǽ½Ö4·bÌú7V,Ùc"í̃ûxm,¬?d®ámàg5‡sHµE@ß6~,›åqLs½ –ßÕœD›,{.…ÙxrìGÛüÀ9̵™±Œ²ù—yD +—Ùþxqë>ƒ1áÊ~ã5”×;ŽcŽaÞÇ «.¶ÖŸ¢rÖúáüÇû-Þ7ñ^‰±äzÈqÉøG +Ï#…õ§fxÐBXñªæ† +C…G¬_”ï‘8Ÿ ëO ±®¡èã.n]œ¾ƒ ,“1`ü.XSÜ>§£ú½[éxRZô=£Ýý:®/âØËhwÆË)£]Íó(Îÿêæ‡9'1Gí•P›'¯!ºy{0ÖÓà£þÜ¥Sž'ø+¾T{ÝÛ×Î6K'-1ø8y3ä;eÒ¹zúÞÉ;ÑãüM6)Îãèü¹Ñï¾tÝÆkíœæUØ^ »œ˜‘,Q׉ƶéÿb£Ím3Í ~‰Æ÷YBT¬ƒ67s À3IJÃôÁEÅÛð³óÏ„&Ú°ñ7ÈiÓa>“áÔ}Ï… Up½×ÊŸó,~êèÞÃÀZáâüóv _§~þoŠ)·Ÿ1~–aC…X›‰ÀB=/RÝÀËôéè]”ˆë%Ð#º%óœþöîßZ±À1àŒ»÷0o‰¥£37T쎷bÀyÿpªû†Y9õ›hèlú@á¼EXϲ/'Úòb+“á#“p0sè¢åWžÏØ8u:`ãÉ>é [YrÌø…sð¼hÃ1ËcTN°^f> ƒý°‡±vÆw"d'1íÄê¤aŸ/§ü%ÈçÍ6¬'1ã^˜_40wúK'3vóñVÞ;õé?yØô)2ú+üÛˆ;§ÎÕQkXïÃ~ÕïôYuËf§ÕÁ{"ü{ã9Ÿ.bž-×99Ûцùðö³Íã8Tº¼½·µË™sÐŽz¢ÎOgídÕ1q¡ê­³VÌBíUþ¨`ùË©çVØv¾÷„ÞÈSµ8ëçuaÖ.3v®ŸˆAçúÐÑÒÃ9VÙ~ÓàyÛ›/ê æ ý©zûSÔ:¹ÙÎy¾›íú–'àµs]¦«>ýil[›ý qôW°Y›l§v»¸ÝCÜ®»›Ön×Ý7®æÛurågûÿö¾ .äÛí¶÷ë~²ãQAãÏmv~úÑî=Gx®C=¦X}ž›Fv=u›tÙåœÛõÕeê±ê^Î|7íèŠ<„k?ê:Øí¬àb¬«¢ûT¿ÖsÙîg=Îíz”WÛʳѮ«›(ßNW9bŸg㊗=O<Äíy£ë®ç‡Î³<;Ü4yîÚ7dßòæ‹Þ`qOŒ å7]"CC¢Ì‹¨Ðhó":4$†/Ü“éôn^‡QËçS)W ªÿMNÊU·qM3«¼ò×Ç=^œ³§YʵøE«=rƒR®­zn³ä¤\ÿæÍË=·|žr½Ê YmfNIùójÛ½~a^_yö®›.=”rõþiWŽ6ú"åÏEñÍ÷Nz1å¯üºîúmãyYë¡·óÑ”½Yß¿ÓÞûèçO®™úò‘Ç]½)ð_Ëm|ÑÃûИ:×»Zz˜ûiqüµÛŽÌ_ÇûYëycò©v},œØ.Ý–Çך?ÌkàYž¦?Y/ø…íÇ‘¿náþ&Ìcù|¼Í~¶‹ñ„ݬ§Ž?Ïgþ¯ß¿bæw|]N<šz—g¯‰‡¦¿‰äp?ûG_}Û«ãP3ÞoÅÝ<šñ¤áhÆ3p`ù·ù‘ý€k?ðåñ7Nÿè×¶ÕÚÛòí6¾à§Ç©žfœ0䙟à£ãÇøèy¥ÏcþlûWÏ?Ýïz]1ãößV´yºt{õøâ8×ãÆ´W«Wº~fœƒ¯Y'ô: Õn×óP÷£žgº_ͺâº~™y¦ëaÆ?ûG³×ô³†ã½ü^®æBž–¯å­'Œ·^L¿jóÌ#lj¾ÎàZÏ_—Ûð-§~êu]·Kö·éW–§Å·^Wô<ÖóѬ»åäw¹ëçŸf7ã­×«rý¥å‹§|Ôí¹-´¼×íº-n´zÌ~¹Üðfëö?¼h¶ë놞÷º?uy<žëžŽ£—åùë¶øàz¡íSx<Ëû§uUÏSÌ·âU󫞺Ÿõõª¼8Õq¹mýÔöú¾ÅŒ­nèñ¥ï‡Ìz\n«ëÚz¤×òâÒä§ÕÛâ—ë5ø™uœë ï×´uNßÇêyÃûgæÇ×zÞ¶ŸÐêò{‚JžïЭÜý°¹ofiuG÷{yû.Ý^}7óòîêߟÈN¦„>3¡Dl$2±Ý«²Ï=ëgî{émÙñïÀ9sÓ˼ݓ¿‹Éz^v|Ó_œMÝ_ÚÛýµ32·]í„Ù?xÊnþZ8~[‘ÌÿÁóñ›SËœM~èúú™ï÷õéAßͱÆm»xîÒ»M~9û·,úrædóºÛ={¾?æ·Of=õø‘ãëÈü¸oçýðZ™×&oÁšÎÝd/Ÿ3áE'–ÊþyÙûŸ—yW‹K>û‹ìPö¯¹½^¾,;¾çV²ažìù™¯üý癲ëƒ=¿ðã"Ù}äKgºÔY$sߎ:ût½WeöœÜ–)6{ÐÎ|º×^xfÏæ¥¦^=R?þØ™&¿‚ôa…ø’]M>^Ôïü8ÓÎîïï:}dé±é©Y©i»e¶wät/Ï¥²×WÃ.g,2q0í+øÝ†s«eÁWó¿ÝíS sÆ?÷T‡%2oÎ ÚlÉ’Ý#—ÍÏ|XÊnEÂÕÞ²àÒ’GÛž²øšó—?üèö)M;Ù.ßÔ‰g^o {½PyÎõoÏȬžÍÚvìSÆõåövꟺ§Ö8™µyë÷«™vß÷a~h£ãSL¾}~ùþÐÕ„ìZO>]öRÙ5¦}Ji7iÊÏ]Ñ:Á«KEÙ³Ã+s?˼fÚÉv綨¾Ð­þ@™¿åkþã8((,ŽÜtj›éœ€ÙOí|Ê3æÃ~k¼òÇütêbÇ3nXOŽŽ[Æ7?ÿ\Ìð©‡M=Xß>Ñ3;ì3qÏq›z>îÂqÙ8ñx_Ö¯ JϨ¦SÞ–=wî ÿvÒóæ|3þw¹‡“ž¬ó}÷9ÞN*èÚXö9p2dhj©o§˜6G|ÛFæNzò‰é}L9<¾ÛÒó‰£ü꘸èþ¿oC—Ù¥5Èž3wÿúd–ÌÞ= ¤Ùáy¦~ßFôÙ±®¨žY7ökßæ¶ºôb7™çu6°d©O×ùýRZl7ç™zb>û«ÝçN68]$ûu*ynô"S>ÇÁÖgÊ©…?f2¦}].=òàÄó²øèó9~z_Xu¤ý1oYhøÕü `ŒÏït¶Ï7/¬olÖÆëgþì¿~WüªÍƒßÊÜAþç*oÝfú';«í×uÖž7óšó•ã‡õ3å Ÿãͬ£Y½ãƒë^5çq}a½¹þæ?yyÞØÚÍ­¸ß0äüÆYg¬8ƒ~yÇgÌ»n¦iOç)…=ÚWvTqúU¹Zö?«MܺQf|sœtøæàñ™™²Ç–´¨g}w›òY¿öXW˜ãÄöñ¸®¨ë<Žã6ÿ“ §¦lšbâÍyÒåpÓV•ÇdšñÂó²F´ÙØÖªÇ¬?ãfÖ{äãjÖ-àÃuƒñÕë1¯‡ÜÎx°¾\ßsz.þáý®‡­õ!geìÇΛv÷éûîÌ‚jÛL\»õ=òýÐÈlÄY¿ÇœïŒ#ãÁë^—¾‡G.Ëœ§Ö$í»ÐÜŠ“Ÿr[ùª·ìˆzÂú÷g>Uï97­Ë[f^p}í\{s=ÃzÏöä­·åáË2÷rFüs[…¥âÝÌcø›ù²]œ_±ïàöLÔë¾°‡ó¦ð¿îïóÀ¿­|ÐÖ_Žs® ì/æÏþàúÇ8qýâõ¬`Ú„‘û˜ø™õuŠå±^œ÷Õ óôšcú…ýÍëãzËë$×Gö;×ÅÞˆçœÄ'’Sgµ±òƒëã{Y_^ÌñÀɬ‹È/޶‹ås=åøf9zž÷:YçX…‰Q–|àÏãyŸÀëÛÉqÂyÇøtýpäâðœyf>˜y†8ãõ™íäõ”ñèÓdsë®ãšõŒã‰÷·¦?á‡þîì‘dƯ\Ìý*ïW8.€ ï{ÍüD<óþ÷ƒ‡¬¯¹¿D¾s^³Ÿ_ÆÃ\/±oîœúæá/Ó<ͼæu‚ùð:kîàO–ÛgÛágƾ*{¶Zûm§ÉÝÌ£‰Ïm¹5më¶~ðúnú~eœ¸>s]á8ã} ãºÀxÁ¿æýItùÅ'{œ”iÛÖï}ªu‘lßfhXÅ–½eøêNMGô¸*E=6(LÆ?|hà¢ý21ò¹©iÜdj‹Kö–eìÌé]*oz_¦~×äÅÞcdÜåÕéY7{ÊôþË"½ô¶”Ë6Ì<è~ZÊu¯¶øóÅ£2¡bÈÀÞM”ñ‰?½·¶¾Ls¸ñç“»ËØïk]~ÿ­2ªì•Ÿveֲˌž$N~·(߯@¦¹ÿãF½k2£ígvé'嵎ŒÎ]Fõ«Ýo2îÐKoú†LÞ¼ìLÇW=eÒï÷6þh ™úòƒÁ?œ&ãÊFýÚoË×2ÅkÊ©7òÇÊÔõeý?›¾Y&®Ïò[åû©Ì˜²hýÒåKdú—+K¢×,“ }ûç'.¾)Û–ͯ|é#SÛïpÄ]È䃗®Tþ÷)£òGeU®+cê\tâÒT)þýѾ½×ÍýXÌË»¯n^YÑÄ=®Úkï\pZ&ÅMïõ[}‘ñAB ³eÌÍJÖøßI‡w î×îW™VÛ#2ôãF2aÕÚ^c‡î“éÞn…ýÊ”a»ÖnX÷Õk2á§0ðG)w¤§6MÆXþqÑ2¥^­!÷þQG&´{zÃÏ –‰ß½ºø£áeüÄÊçø[ÆøãÈÖÇS|…®é²nˆL¼ùìÜ¿[r˜z§íêºáÃÒê2aEÔ÷_÷ÿC&§Œ[턌Û5ñ£Kíeb‹\Ï_“…ŒüpÇÆ†“dr}÷EÕ‹—ËÄ+óW/Ý.ãš {¯¾w–L¬Y©î‘_‘íì8]¦u©øùµ˜<™üÍæÖç¦eÉÔ×?Yãÿ»ŒÞùÍKnbeÛ%O|÷€Œ«·¯êÔeÇeby?‰?$S*,躡z¬LévÍëÍ˸”àQk÷^1ñT´cÒ5)“š¶¢I¬Lþ¨{JËetÐêúÝw—IÇÏÜlõzCý×/OíÈ1µž¹1õLœLïçþFÊÀgeÂõ+WëHú}›¸­uËJ2êÝïî}Íÿs Å¦queüÅnû^•GdLµœ÷³ßéfŽøcXÕcŽßeb@ñ‰Ü¢?dÛ'iwÙ{Œn2mRú¹­2ã¹1)5<›É”‡keì=Ç79ç LýàýÙ‹U• ã·Æ×7E&|œ4oˆÿÙé»UnÌ“Q£êµ\Wg™ŒXûA1ó’L¿øçÞïÏ—ió6õëܼ…Lؾ/ó­Îudrƒ Ó}¶>+£Ãóô/#yny­¾?™þŠy!oé÷r°ŒqÜ{aã}2Üã\fÀàÚ²í‰Þ-¾=6G&µ}¾i`è(±>oÿ¯a½df×m…¹CeÒç>ßÅ~|SÆg»—¥ÕË–±¿_øóñaY²mç²Þ«û®Lù¹~õÌW¾”“Þkµsý³$)˜÷P³™¾¸ÍÒC÷ÊLïf\%øq¥Ï“GdꤊÓ×]}IFù}3ï¥Q ̺7¨wœÜÙ_Ƥ<º±Ûš&α +]8Iéæ3¬ÂѰe2Ó·pÍÍvÈ89gç©ÓŸÈ¸!y+«ü"£ÿøªçå/»á»äw+í–ÉÓ³ŸIÿ$Z¦/ûåp¥Î­ejÏý{¿ãgâÍý±E3ß=úÇ&™0®JÜăž2öÏÚÛ}}öÈä@¯Šc?Ø"ÓWWÎëùù72©ÃÏÕwFÌ‘ á}ª=?dL- ¨2sm¤LyWlð•Œñøíþ‰îÌ8KX¶°Y~é4)¾2ÿÒŒTûÎõÍllâ5rk½w«ÈôÔy1^ç¿”ig+­Èú⬌¬5.lÿ·¶~õáâúRö¹p¼^= ÷ä7—•ýýàÞxD³Y Éäè_ve>µCÆ ÍÍýù™üx¿ØžK¯È„˜1¯O¸:UÆÍ¨wþ‡+ÃdDø÷]ö—IUkŒøí&-èoæÞãSã3ïèß¿X½¿¬™Œ)¨ÖçÙ/°OÀ»æ¼¨?›>þ[¤w±3âÝ:^iâ–t!°(eÕ~™Påpý¬A2Õ‘7bþ4õŒ,­úÒ»2áƒâ}?‘aïÖsôjö‰¯¼çïûÎú>+ã¿üfÛ›…&>q_ö÷}íeÔOzFŒ’)Sjöéþö0™´¿E·9 ŸÉ„z‰K™{NÆiTgþ¼2¹ÇßçÄ?#Ój– ¯nÉÔ'CÞ|mÌR)Ÿ¯S2=IF/õ÷l’´^Æ}tÝwVŸcæúW½Mj᣻dÄ_÷Œz~ÓËf¼qÝÈÌ94oÃ7‘2¾Ï¤/úFô” cÞÕ½Ø!S¶µòzz¤L±jpÓí+eT¥¥—^mtT&¯_Ù¾Ù}¿Ê¯Žù;ûßßȘ‘žÏôbæErÆ·çËÜ¿–©AoUQë )»øåáÝ¥æzÏøÆŸìW²sV™’”¿·h›Œ=óTÞÚ´a2aÏéÃq¡q²mN(OÚ'¬Ë‹üé“o⺾ž…Á[dä„/‡;Vþ*£_~tˤw#Ìý@xýQ«Z^Ø!Ó²}1è/Z~ÿµGÆ3²C²oÖ§óê™ë^b— ÂJd̶Ýo ²\¦NN]4b\žŒØ1ó£{dûì•UŸX;KÆ:÷5÷Ë„kG½Îí=+£xßÑôˆŒ>óÒã­«OmÏ^:e^šµN^H9ûvq ‰_jê_­Ÿ@ëà䓵VH–Q—4«þõ»2:³r¯†W+šy>³Úò´^¤lØé)ÇL™Òþð˜†o8¤œ4|îé:­dÄÂþE/xÊÔz×£Îqyï~=ÃcŸŒ>~ÔÿXd™úøžGŸ–q«~¿¶ç™Ñþ“W< i_2óò¦ÉO)ãNûèyß 29ä­jÂ~¦ýÇÛ²Ò«[eôÛ çíyŸÖSÿ4ùH&Mzÿ½]³Ê讣GETЌ׷ïzNŒº"£V{×ùQœ’á 6ûàêu™äóñ“µ¯_cÝfÿ¢YO9¾¹þÈㇷ>äÙĬ3/OºÞé·Œõ®½æ‘+ eÌîå'¢O7‘‰a¾ÍŸxë7™±%àÃ÷f/£f°­÷"ÚOUŸ5Î-ò+íYqÚ}h?ô×§ëç-,”òFÊÌ_ßð•qC‡lÛQw‚”k*†ìüY&VûôÙÚ#öHé¿îìÒ½dºs=ïdÖùlõ.3¿X)¥ß+7/Ý.ÓwNïðæòý2¡åµv5o<$ãfŸ¯úFó™ê]Ö#…êöó¯%ÿ²C¶uú¡žÌÈý͵mÑ))Ûì›Ý}ÿu³žÇvZµvýì³2¹æŸ¿z¡TFý6ø¯Þ‡_‘ žóÙøÓlõÖ’×ï}ÜCÆÍk4+¶OsÿÇu!uôûú½¶U¦ZþýÅÀõ¿³<²pÄà1x¬6ÝŠñ_&8lÔpœW3¶p@ë¡ÃÇñódÃq—Çè±E£øbèðIÃð¤á£ª¾‘<©Ðú\óÐÁ# ÍWà 6–¯&د<†Œ&-ùb@që°1ö‹A¶‹p{O¸Ù3¡°hÌXSï¢bÖnlшÁ­‹‹Y»Ê©C·=j\1s©jhÕzð¸Ñ£ŠYƒª\4º§uîPÎÓuUŽ-lmØp+ú•GšÐš=PU!_Bÿ¹yóÆ<Šwãÿ ¨õl´Publish/data/traceR.rda0000644000176200001440000005263314142666146014524 0ustar liggesusers‹ͽ œ¥Wuø½Ú««»êµ‰qâÊLvcCl'cã…g#vUwõ¢jõ¦­–ÔjmHÀ‹»c †¸€^0ÆØï~^B&6fb‡h섊5&#ÇcpË6ø{½µAå?½½h׫Ô^ÙOí´{ÑnôR»¸5ô÷¥ö¥_ðÿÏ¿'Öÿ´kßö—ÓžàçÐ9€vÚ}€_ü¿Ý~ÞÑ»ã×îÚ*Çýƒh¯¸ç[ý§w]?¿íeäó—ËüMÄOþG}þúïH|ïÃø~À@ÿ ð¬ÿLâgúû{9ßa?Îc|ø¨/އ=Ðîy{âƒvßWåíÁGùOðµ3—wýÁ´>ðõó–|Ò¿¨òA9©—°ÏjÞߟàÃÏ®þ«Ñ®a=ý€üQÿ¤·¾ÑLðä›þM¿¡Þ©ÏäóWõóþ-Ä?Èñ²%Þk¥Ïù½hé—õs>È7ã†ò…~‰ãjW·+0N?¢ßï'Þ~>®ëI7ô©ü צ~Ø÷ Ì‡Ÿ£]“>øõ´óù¢¿Eþ#\?§~SåíÚ&øx¶´óùc|Ó¯©ç}7ÅWèp×aý‚~qE:€‹¼H¸^.ǃ_‘û*ôi/Í'”›ëI7ì»óöó;ïÀFGÿd\|]‚§|k«h)Æé/{¤ù }æýˆ3âÝJ-õK¿`Ÿpô7úñÕhiðŒGžêåüîùtÊ×gžY~Æ3ù&?±OPþ~ÎϵO½_%rÓØ'õO{Æ~‡Vã•û.ñÝ€þ Âç÷’.ùüD²¯Æ?éG>•yú5õCø«°ÏÓN±¯¡¥Ÿiœp¿|B·´ï1¿Ó.Üÿ(_Ä?ZµýþCÿ ;÷r~8N=ÓO"žSùth7î_”+üz#ä—þyÚuУ>èÿᧈWúѾMÐ!¾*ç—þªþN»Ñ^¤G}­¡½jÇŸaü´ôߨŸHgxÈáª\~êãZ_†Ÿõrúëhc"€£jû å!?Às)úô‹ˆÒÛÂ<úk"gÔ‘½œ/Æçƒ~?ïG}̶—¯‹¼‹~è­ŸËKÿ ü©ºŠ|Kùë5>¢éåüÝD~ÁWè‹|cU½ÆþõÔó…ŽG~üQrœòûlG¿e>‰: -óå£ÿjþ ¿«üQ·¢eþ‰ý„r ò¾Ú…rG º{(7ZžS"_’ï~NWë,ú奜Œ[Ú›ò¨¨Çç?Z­©×I—ù$èPÎA ·qž\Ôû‚7ì‰uÔÇ~œÿ`Ÿ¤©çƒhGôK®¿}æIê7ê´‘ùxnê7¯‹¸¦\¤C¹Ñ’ïkÿçÔ~çÈ/y(ö³ý‚ü£q"ü°Ù¿91¿ëtÿˆsÖ o)WÐ#¼´áW€£=èë_—ìÊ8$×ãôà =Ú7òU/ç#ää¼ôÕža…¾½h™gcý §ô1®òs?Š}pÿWÃï‰~z…ÈG=S_Á/çûÀU¨79?œsà çã¡ÿ½²îÀ3^Ôï5Nôœ~A¾ENæ9Ö}¬‡Ju)ý8΋hy^Œ{À]ýšï¾ë½ŸÙp´¯ÊüR®*§ó<á‹÷\7ösy˜_QŸ÷r|¬/õ~h -ý…u‘î_Z7~ðV÷eÖñ¤£çHއaý‡öâyPë‚Șü#rê=ÓõäsóOÿÑúL兩_Ä=ðÅ{º¨0ùûS}ÄñÈoUNÿÀè.öÕ¾èaý·çç5žOÈ'õ÷,ƒqN½Ð®ª¯ÈOýœ½¿!õ¯÷ÀäCóšæa­ã—¸^Æ×Ðg<é=ÝÔ_zÏ®~y÷ÔOÔéߑǽZ=ïÓ¿nä¼ððƒ>ž/O‘_ï+kç#¬; pŒîO¥º7ô!|„Ÿâ>3êð^¯õÇCŸoÁ= èë=Ay„ë9?ÈåQ¿T¾H÷RÂ?àõ¾€û\Äw/ÇI•ãÕç‰ÊOÄ5Ú«±ñu˜Òy>à¯G»üz¨ë´ŽÕ{ò£ueøU¯.îÛЮ“>àju,湟°þ©=ï!ÕÔÒÿ"_Š\‘/ѧ^ãÞWðëùŸõ\؇rõšépõ¤ç­C®Á|ÔMƒ\θ/%^ÀQñþ‰§—óÍý™-ëÊØ{y˼¼>Èéi<뾦Ïe(åˆûYikß º¬[õÜD{?« 3þ{ÂÛ Ì+ßë)Žõù_ø)àõ\u/ü]ÏsÔñÒÎq.¦Ð^B¹7ê¹*ïG\ ]¸8Onäpê7QǾֽ{QŸêy4ΉUÞg~ÛK¾¶rzzîïŸPà§”ê@¶á÷r~<ÿ>A<#ûÅ~.·Ö¥zŸõ=à÷c_¤žãù[Âkúˆï/½È˜ç>y´À?ùÒ}@÷ƒ8OÃ9¹ŸÏ—ΧÌç_äãRÐÑ{ ÞßÇsQ¶7ß“D~d_øÐç!?>â{èïÇó½7¦¾ôÜÁ|Á{?ݯ£.C_Ïׄ×óºî›Äß+ä|ïœ>¯Œý¿ŸÃÇ}…ÐcÜëþG½³î ýƒ®~ÿCå‹ýóqÞF?üGäÕçÊä‡~B}2þõ¾wÖíÁýËÞ­œ®îkU>}´7àCÏÌ¿qÏ!øuÞOÆyˆóèëy-îÏ^À‡_oærê9_ïñ"ÿðÓonÂ8ý?Öãù‚Þsïéåëã¾ ÷(ôk•3ê|Œ_‡z;ò&æ¯Áók½§Xç}ȯÏ=ãþ tÂÎhé_¼d¾Ñ{Ký~ åÞÿ»DÖq_ã¾Àçpÿ§Ïá˜g"þ0®ßW:ðÕyÓs.ÏYZ÷³Î¼”ô1ß˽u´‘·ÈÆK÷Îú|âyUöI½7f>â}Œž'ˆ¯VWCïú½湨ÿWÑŸÞƒPoŸ¤¸ø~é¢üL¹ù¸Þ‹PÝ£>£¼Bv <ƒ|]í< ú´7åÒïmj½¯þçrôu¿²—ÃÜB;:ýœOÊÁú‹úºVä#ÿÜ—ôþ]ï÷xÞˆïïbžuS|ÏŠm•¯×{T}þÇz–qq€÷›äŸëû9^}Îç¶BOOèȺÚ÷€¸Näû—ÍžpüÞëÀx^9GÌïA"¿q>­~ïx ü ]Ã:â¹ ùžzå÷†#nÀÏþ/æûB<§Ä~¤õ >W¸GËï¹Ä=‡ÐÓúñûµãUŸWès à«ø÷jG1~xŽ¡= <1öØfjïö“¼‘¯¹þàŽ®xodëzG*Á‹ù£[B—ëz²žëÈ7à£=.òc¿Êù>F¼˜?¾‘ÃS?¤O|äƒü§œ€§Ø’_ê=øb_ð<ùàø¦à_E»‘ÃQaÏJú›9c[ÍøÉב¼_³ûQÌ_ÍñÔè¯æãA¯Êû¢¯ G½ßº™ÓîÁ7[फ़Â_Göì5Þ¬¸¹?ðïÐK?‡?L¼[Íxc|µYÎðÛ­¼=¦ó  ?ê›|b>â˜ëØŠü¡×M‘+Ç<Ãxä:ò ¸£ zÃ|}ÀoÊú-á›ó«9¿‘'§z ?#”c5—“qñHú[ùúÈ;äƒôÙn#ǧùXóJŒs]%ãÚ>ÍGGÁ¿àeŸr„_žÈ3ýîÈ@àˆ—òŽôüÐO9¿‘Ëöy ùxéßêׇ·r¸Ð øS{«}Ž Üaà=¸ð+âÂï­Ä6챕÷9û!é­æòè~-çÁOìÓà7ü”ãÄ[åx^äÄ~7´#áAy‚xBŽ­œŸðŒîåò‡½8Nþz¹”ó¸ÈM~Âþ›£[æÚ7ôÎõUÞêþ+ûÅ0¿õrøÀO¼B|¨Ÿ<èGü x÷k~ÉVèÕò*×qœô(ç@Ú­œŽÖgÑç<ð O ýˆã„‘_·„ÇûùxÔe˜úfó²ž|òõµ8!Ž÷šùP¼º?}Á;õÄÇVèÜ ‡–ø8õô¿ðÇÕœßÛ˜G?âb#_Wãk t6s¹Jz ½ƒýFùc^¼UáIøûùºZ´%}âïå­î“ä[Ï/ª7ùuòÅù|^å«ÙŸó›¹ÜšOjþ„uÅz´ÊÛ˜µýIáÉ×V¾þ°¬‹ýëxÎ =KõÚØŸ üᇃoÔuôÃÂW_ääðQŽüp|Å~ÞÏדVë}øSmÿ ;öóõá”›p«ù¼Ö™qnÚÈùŒü§|¯æýÐ ÖóœN}kü‡=ÂOOÚ.ârÞÀ£ø°^ý©vžØÊæ‡û:Æ#’ïæuÃ:’ãhõœ çU•Ÿü2¯×êÂoøÞ¸¯YúäŸóÿ:—ë6ÀÇ~µšÏkÞÑsoÍ^[ÂñP>à9žÚú=ÖG½!mð±%ã”{3§¯|3NÙ?.ëkû*ùWy7ò~- >æ½ÃÌäû½aM¹O<ý|}ì_¤O<9>òÇxä½~ÈßÏñÅ~Múàï¸Â“‘OüzxÿÀyÊIù)ßjN¿vÏ„ušO´ŽŠ8~4_DÞÀzÚEÏÙº?¿›ù|ÄU•×êð+âQz«‚·Ÿ·Q/ü v_£÷hzÇz,ênòÏõ•¬~kç6ò‹uzNÓ}Kë—ˆ“Õ_-?V9|ÔѤ¿‘÷köèçãšr<šŸô¼øIWøÒû„°Œëþ¬ç³[‰—㤻™¯¯Ý—®V?TÒçüf¾>òˆð¥ñU¼çb ­àÑú5ìLø¾¬ÛyÉá6¥¿Ú,wøá m-ÏmäôkuÙf¾¾v?L¹Èàn\ÔÓ½NŸPï·ßè®'íVN_ëm­»4²= 8½w{qžt7óõz~¨ñ¹™Ë©÷Gµº’rnåëô¹Nä?ò³™Ï‡¾H¿Ÿë¾¥ç‚8Ç‹œ¯ç~Î:¼æä›ãXW»‡MpµçqQ·¾ŒÇ½ùȺ~6?ÄOþ>ô¶™ã+塈Ò!]Ê|Ô[<7!>Ê…ñâ½+å#½A>rÆgíÞ¶—ór¬ä~u©Õƒ¼½•rô…à‰}lCä!?[9_·Ï z/UË÷ zøî7µ}—rö…‘[Ïq¯“à†uåÍWª÷#ү݇p|5Çr­ }Ò!ð…½6s9jç–-¡CþÑ–ÎaµzJð×αç9IïÉjqAzU¾¾T¿G~ ½ È5È×מ¿’Žçøj÷ó¥ódÜç_/‡‹¼ÌqÊ3Èù =ôóu¥{ynWã7ê;‘»¶_¨áCÆõyH­^¡œÀ«çþÈ·›Bo#_Wº7Òz§vµ•Ë[;g¾VO ]­ˆO×ENé\©ûNíùÕV>_{Þ|µs¢ö9¿z®¾7RËsyÜ_ìc˜/=Q¼¸‡Žxuÿ¯Ù½—ó£÷Hä—õ€Æ—î‹zNWüµ{Œóï…BäWäbÿ0ùÚzà[ÏS—§ÞGk©y\ïP¯D>ˆ}‰xÁúKí|Êþ†ð¯ë)ß–¬GÏÙ ôjß_èKŸð«y_Ï›jG}^úÙùˆ3§õ]Õ<zäzâUúyÃï·dëçqoFz”g3_W»×âx•ã)åGÆ-ǿ֩Ñör¼a‡\ΰ×FŽï¶~ÎGì‹ärø*ßKýZ}Žõñ½-ÂƒßØç6súqO ¼z®¾U×QnòEºìpaÀQ‘/ˆp·öòu„g¤y,üt£žß”>àôû'zïYËS½|<èr¼Bû¬æu¥çÀµó ù>ý^Âmì®÷\¿•·qO®ò÷r<¥ç'µýgUú2/÷µï=è9Yï!c_Ý—µžªÅ1ÚÈ”x9\é^ Ö“>ø‹¼&ôô^·v/¸‘Ïǹëní˺žÀ“Ÿ­fºZ×èþÎõq?"ò…ßPNŽWù¼î»q.bŸx6òq½ßŒüÚü[ù8â`x.äøõ«æ¯hkß D«çHð7¤Gù×çëêÏ…ÐÆ÷0Ù*ÿi7r8­3åyCíy­žÓBŸ«9Ú¹‰üOØŸ|PòY‰¼ ÷oè‡~~â>o5o#_ŽrË:ò­÷«Zwi]ò‘n_ø©rú‡É?ç{"7ûƒ¼¯÷zÿ¥Ïç´^Ð{òZ|`½|¤~¿BºÄ·šÓÓ}Ÿþ®ç*½©ûeœüó9™îÏú£vÿL¸~¯ß/¨Õ§¹\Ä纜®ž¢.¸ؽoú!î]{ù<ïgÂΔý¨§•.èè=uí9 ÚÐèFÞéË8[ðyLú¬Ûb¿!^Ò#¾Má‹ã"ÄúÐo-ßê¾£ùGý(칚—ï{ÍtB^¡ûf/__ûÞ™ò“óYçg#§OzqŽ!” tÕô9Dížš-ÖEýµ™¯8¨ò6ô¼™Ó ¾(ÇÙR~¶Ä x}^D½ðù]-/låtã¹Þ YNÄA½¾c9\MÎøÞP‚¯ø÷j±î èî>þ}ÿ÷Ú[Àç~£ ŸóïÙ¬Žô@‡Ÿï#Ú}hù÷á ÿÞÀÍh÷¡åû8O:äŸ|Ä{Ô9ß䃷I8âã{èù÷„ü»\òË¿“¾eÓ¿Oõrs?—üO´"¼O¾ÊéÓŽü{Ô²žëhwŽ›à§Ê[â»tnîeó¡¿ø÷Ìdœú"ÿ{E^¶×ËðÄ:òËùANþI½Þà ßC‡–zãûXãï¶1ïíÁ<õ¨xù>Ì}˜¿yǼÀC>oáx•Ãäëøw猗À|×É:òIxúÕ‹÷‚q]‚«Ù÷fi™'(ù×|~„uŒÆ/íqqê3ÞƒB¾1Ž8$ŸÃ÷HϺ¬£ÕÿÔïâ=”£ÊÛ½ä‹ëÑòï¬#¿É<ñqžýx/ å'”}êƒþ~I¹0þŽqêOô6|ß)Zæ¹à-í¤ï¥ˆü!|é¿o¸í­U._è§'mOþ;&‘¿Ò|ÍîŠOói¼møÛ@Z¬_Lðªþ#o¡]CË|öïg|óåärÑîúþ yo}í=ª1Ï>ÖÓ¿7 õñ\åëé_ú~®W=ŽzŽ}Ÿó¤‹ñx?6é‘o‘ŸëµÎÐ÷ïE¾¬r<ä—ãÁo/ç—úb>Ó}ûFMÿÌÛŒ«à_ð’ëŽvÐü¥zÔý}} ðhã}+”»Êä 9‚æ÷Ë:òû æã½SèÇ>Ž–v"\ü;d<"òRž›ò¾ÆÑ0n¸-ýŒ~ź&êÌ*§u寭î×á7½Žô©òïsäãŒKåKó¬ÚWßKsƒÀIþÒ%€Ó÷ñD¾#Þ¾¬9kç Ê#ôéñ¾lÀGÜ€.ëOÚo£—óG~ô½Ã„'?Ìßš7ö Pà÷É:àò/rƾˆVòþðœÅug^¥¼ñ^Q´z¾ ÿ*àçz¾7Pêôa\÷s¾u ëçëØ†½û9?d<àÑgý«ç Ñsð§y&ÞßE¹8.pR'†<¬ ôœIy ÇÚù‚y…váþõùGçRòÅvSNàž£§û-ã›rÄ>Œqµ»æ¯ ´¨;‡çá~¾.Î-}-í¬v£üä+ô~ìCœïç­æõwäÇÚ¾K>tߎ<ÐËùy8–~B¹ãÊ‹u7H»Nx‘WóKœƒ /rÒ7 ߌKú½œ×kÿ®÷9¾ßJÏÔ—îä‡ëµîT»Ñ¾Œ_àúáOÏßûd>ò)ùéç}=¿è~¿·/òW9ÈG"íJ|¬Ó¢.&ž^އ~H»hÝEÿàý×ëû3‰'þ]IÀ1Þ4ßé{ߤÞî U.gäñA.íÈ~ì_"¯î7³VwhÜi?ìZåòi÷½ ï°žêåürŸyÖÑOâœ4>d=ù¢ÿ¯8ïô2¾kõŠžÿâ|)|ß¾"?örþãÜ~íNäÒ¸‹ûŸ~6?Œ»Au ðª_Pþxúj橃²NïâøÐRq¿Û¹ª\~ÍcÄG»é9t}î/ħzý•óÂ'ã›øôþ7î…ú9Äç¾´U.¯úCì—Ày[ðè}¶¾'VíÏ|§~~Mþ¹tüÁ Ð'=‘Sï9èëÒxå:Ê×ËñéùŠþ©õð7Èç_Àõä·'ò ‘û£åÔ¸¦^™ß9N? ~1O{D݇õ±PÒíåôé'¡ïA>ÏsŸž¯ã‘|`Ýùèç­ÖsŸ|pÚ›¥ó²ž|ž÷ <ý\ó€Þ¿D\ä!òÛËéÇyUèè½?ý¡”GkÏz"?ñ r>j÷sƒœ¯½Ä/rR.õÒÛ|¬KBnÒŸޫK=ÌU./é“?ý÷ã0¯÷$Œ‹¨ç«|}ü;=ý^[}¾rˆ\áϤƒ–q«ç =O—ä{¤Ô2U\Oüúü5þ}´ª·¨Ъ‰—ëâ\B¾…ÆKÜ×`>Îc„[Ýn‡ÿ®2å#_ƒ_í9uN§v?ï=ïåóqïB<䯗Ëõ»ðõò*ZâÛÊù‹|;ÈéS_ü÷åôÞþB~Ö¯÷E± Õóp<7!>à×ó&ñÃo†ùëÂÞ2¯ÏÇô^%øÊéÖðÇs%òÛÏéÆ>…VïEäþ½Æ¿ ÷@q®aKyØb\ïâ9Ö*æ ‡uê?¼_Ó{Y}n¦õlìW _{žˆyÆYÜÓV9|Ô#¤/óz?ÿîÚ¸¯%òÁy´ëóO?_§ÏânïË8û€º§ŸËòôr|ä;êrò]åý=½œ¯¨oH¯ÊéÆ÷nHWøÔó®<×*æŸ8Ty?ò$Z½— ýpzNà÷"".‰‡ðhc_4Ãé~JûÆ~8ÖýëÏøÖóœžô¹šÖCúý Âq_sÖÅsuY_{^ØËå&Ô{/?•õq4Èúµ{=ÇEž¤œ×çgz?¡unøñõsúkUŽ÷Â>Öüõ!æ¹ïE\õ2~‡û ïëó½×Õ¼¡ç0êòðû!qϾbŸþi'}þz%Àsh5µúïþèý…>w<‹qúq윹5¯éy4žËôsùäœR;è}qmŸîÏq¯)òê=cÜÏöszQ‡‰¼zo÷¥ƒœ¯ÐðG\ /Ïj÷&µ{fŒë=gé¹oøÚÈGÀ»|¬Ïâž§—¯|Äq‘SŸ³ÆþC9ªœO9ïÖîÛõþ\Ï«ñý'YOy˜˜gkþŽvôõÞðÐ Ÿ×¼¹Våø#/¢¯çýÞ%ÛC:>È[½oŽ|N¼=Ì÷2~‡zþ"N„Z¼S~Òã:§œ¡Ì3.÷’´ÔOܳŒ3_ñœßéeüÖò„ÞG]@¹ÑFüQ.¬ßXÍé_î»´ñÅý%ùúµ¼G¹¥õ=àõߪÕ9h£>¿zo²·ŸóSû¾*úú<)ö ‘'ò¹¬¯=$?h5ÿFþRÈÆ#Îø=¸OÍåÖI=éçxj÷ô7µí÷hmåzÐ瘵ûEôõß) x¬ïQŽïqÔïÞ°•ë=aÜ#è0Îu_Ö:]ÏY”o]ÖEÙËéê=NÜ›SNò–çbÉŸÃçwX_»7à<åïçó±/÷³õzŽ‹¸*ýG<@‹ú¥¶ŸkþÓçqÏ=ÈùÓ{}}.qSåòè}ÖÔkÜ÷’>á1ÿ~½ð³Ž~œã‰ëÉúq?<Èá#þ1®ß—‹7®—Ëû1åêçü@NûÙå¯fííöñ*Ò5òBû¼È>gìsŸ}\jÏäþׯÀïo²ÏCö9mŸ7Úçˆ}îÌÖßk§èèÿâ›Kÿ£¿;üK@Ó¹z%ø¸ ´ˆ÷û\ƒñÛìsðúúŸµÏ/¹Zìó޳x? ÞÞjŸËíóZû÷CÆýÀõrûüô~;ôòð¾Î>kö9nÿ—ö<+î…Ž@î#ÐÅÝÐÇQðþÃÐÇ€?uí`ìç±ÎuvswAÇ? {9ßoÆøaÀ¹<¿ÞQiTBwnËëë¥ù$h~Ø>¡“7¯Ëü>Èú à8 Y‡>>_%û>2Ðæ?S%ߺr¸Ü‡ìs%ôøuúTÉŸ\†cUòSÇñ.è××¹ýÃü`ƒ“˜Ëy–¬?€¹ÿ²Ü>üó Xë~þbðp æü÷•Ûò“Ðíзo«’½?ùï¿?þ_U%½<œÆÇéÝ^MûL=«J~pä<}„ÎŽC?ǰÖuç~tò>ú÷ÿ‹gtoŸïƒ|'€÷4tzzrÛ¾ <¿8^ü0~?ðùÎàþã¾ô#UÊ1NïÕUòݱÞuôè¼ø\/ŸîG Ó»ÁÏÃøÜ ¾Žæ&ÐÝÍ3€q]¼¶: Ø;Aûlsð‚^]¹­ÜÇ?ٜƯB×þûOöh5ôûÐ1uÔ÷Bg`·Û΢ë|ªÚöÃÎg¬=»¹½OaÞóÁðtÆÝ?®ž—B®;!Óí¹[:˪dûƒXÃ< `]¦7$>ª_‡_ý‡Ýî†ÌÞ÷è1é¶~#h¹mŽ‚ÿ‡°–zyä~è\ ¾OŸ¥;`ÃÃ~Në^л¼;®W€æÇ › Ìm@—ÿZô]_GÀ“ãtõýè_€—É}äèøßcüÝUŠÕCÕ0W¿ü>»ü!twºç^Ó¼Ó>ÚÎߣX7Öxlø¾æö<Š1Ÿ+躎Ÿ\º/…®>p–Lûî«?‹õÇ¡SÆò[ªä“§`#Ÿ{°ú“çÃeŸÏÙçËUŠ¿WÃüòCNônÇúãç­˜¿ örœ×Üo_¹Ó y/øò<¿V¥Øß_ }ËÇp2Û¶ñk`·ÿ=ÐÙ1ÈävûÈvÆ_úàq´ü`qö´*í‘ïí÷€þ]à—ûû•Ð÷~àÙ¬R ïMAžCæ™À«^}z~_5´óIÈt;øv¼ç^À:Î_†Ï­R¬ýb5Ü“~<ß yëÿ?íÇ ßk ‡+aÃGкýÝ?ßP íî<üN•rúõÀÿóÕpÿxºvùÝ®¿Q¥˜;ž|ž¹Êé¾0ñÒ¹ºtþ_ xçõ*ü~ðœmÿi5¬‚Çõhsoüq|˜?ߘ›Î‚ãžè6øôú}àç' k`_ã~á¾ýÖýV•ìùýU²ÿ{€ÃíôôÁœ·÷cË÷jðùÐx æn‚<ï>KþWbÍ&p¿ r»MN@'¬÷áwÖ¾wßýÕ0ïÞ8—é‡Ñ?V sªÓõ}Î÷7Ï-î“ÿ;xp_ñ8ñx;U }Ái{Îð8úièô>oÂÜûѧý\¿W@goŸ·ÀN¾þUÀ½^¹Wýlt;>G€ã§`+ìÃÙjX?1nÝ·bŽþêí `ƒ{{ôíý—WÃ}ýtÉýõÆjèWg°æ…˜wýܸû0÷ZèÎlâùà °Ù« ÓÕ ¹cNãÀY²ßÜ—A&E?+½ ¶|ºfÝ{3ør{\ƒöð½p·ž¥£Û ;æ‡ýgÐÝqØîÈp'lG[>\CÏ/©†ç’Û1v'ôºû¸üâóš³äÛ//ÆšG›g“h_ ÆœŸ-<úp=¹_¹¯Þ>9KïÎÓë]Pè†uò;«¡9¾•bÈñ]Ø“ø®†õ¯» 2¾ ´}ÞsÓ½ö¹ úpßpùiÀ‚ÜÇ@ÏóÁ ¯ÇÔ~|Žï®Ëª¡ï:ÜìlÛ÷ðè¸Öª¡oq£L·@7Ç!/Ï5^_ø>òŒ=úq;»}_žéÛŽïíàÅýåîj蓞뀿c›Ð—ëï ÆŽ‹ðÑ*ÅáF5¬G_}–¾@‡Þú~ç¾â{ˆûÄAÛ×½ kœî}Éõ»¸¹_»ÝÜï~¦ž­¹¯ž€÷%=v¾ :d}ï¾ü À}#ZøóúáÕ°æ>^ Ïb~p%h8ß—TÉ> Þ^öpŸ¿‡ÁãmÐãkñ;ëcÏíó‡Û‹¹—¹d?tv?ôso5¬un‡ÞÌVß«†>ïtxž½·ƒûý¢ÿo«?.#÷½5ðshý>ìqú,ÚÌ©wTÃúÚeäýkÜ—UCßp½¾6x9ø¤ûÚ¡Ÿ;¡÷·VC?b½ ú}c5ÜKyÆr›\Z ë–‡Áá?_ëõÔ‡ ·ûÁ›¯» ôŽ%óq\ƒõw`Ìùõüã¹í7ۇ̇ —Ñ÷ç·UÃÜà0žƒÞ\¼ÿq=xx]5¼{8œ^o‡.y7wöýuèk¼æóšçÑj#÷`þÕðNòøq½óÉyúNÌßt–^=÷ì=kÝ¥è¯Aßû΂g\¹Ý—ÝW¬.ŸçÆÆáj˜ëöàóX5¼C¼2?Þ_‹µ¯Î3è;Ý—@_¼Ot›xü¼ ü¹~ßz7c-ë‰ÃXÃ8yôž‡yÿ0>ObüîjxgøÐY:{´Ö?÷€ŸBv·ûölz¼< ]ý.äâ}ä=ë$ðßýyô³òÇ«áýÉ] Ëýç`5Ì-¬u¯‡^Ý¿®ýã€ÃÍ~Üç¹ >й#Ð'ÏØûa“—·ß•¸_|¬æî{«aMærýÑY¶ryß‚ßï…ì/€Œ/„ŽÞzôãSà÷€Î÷Æï†®.l¿=ýdÀÓ¢í57TÃXtð2ðÍ<óJ¬w¾^^®ç×B—C¾büÍÐï)ðN[ŸBkºêüÍ*ù ïGÏàwÿü$xt»ü ðõ±ö]ýí Ïût·³çÀk`Ÿ—‚ï~ ã¯nÏÿ­JñÀ»µWCN÷éÎ=ÿ倹­ÛÕ}í ôñ`5¬Y_ø»¡Æ¡ûßcøx<¾ó¼_¸¥úØqè´9œ·5À³ÖØœ÷ßaý› ÓAwøõýö#Àsèõ㺺xŽÞíÿ(hóÎÊ?|óšjxÎ=Äåð:ðãÐÓ~à~3tù!àpúqàqüÏŸÌ-̋Ο¡œ žŸïoΜï‡ñ»Óú¨ üx¢¶ïÃõ¥ÕpŸ}Ö¼ÇïgÙ/UÃ}ðЩç÷¿WaŸÓ=f?Z¼7<ŸÂï.ßf5ôqóƒÎWC¦[EÏûÁÇö» Ÿógo÷ŸwDû'ŸðŸßyΟëöOmþ Œsþ ‰hm} ÏçŽmÿÄ<×?Q §í“hKxKüp\ùV<ì³U¾8N¼ßºŠ§Ä×ã"[Ò¥\%{(~…W{´éí“BGùW9”®öµ-áQÿz²@Ÿp%¾”žÚ«Ä¿âc_ý¹¤G¥S’¿Rú ×f’žÛÖK§$ÿ¸|¨}ÕOKëÛúäCý÷Io³G)?”äxBðµéGé+êGªŸÔŽªwÎ?Qà·dõ{ÆÑ§…>ÇoÁ£y£Äד9ÔŽOÄß¶žü)¿*giŸy¢ ¶[ÒW×ïTOšGKv7Ÿ)¥üVâ¿ÍoUoôU²‡Îk¿->J~÷¤à×¥z TG•ä|²°Nùi³G¾ž6¹UOJ·^).Jú*ùQ[¼¨¿—êOÝÿKy¤¤•[ùR}”â¤-¾Kú*éAó_[]¶TwªÔ¿Jñ×—%}”üLí¥p%»–ü²-?(’=Jz.å§'DÝWJ| _ÒO›ß•â±m^õÞÿ¥ü\òïRÞh‹—¶ºm\?,ÑoãgÜ|Õ–·Jô”Ïþ?ê%~5¶ÉQZ¯}ÅK~J~N»µñM¸R*ÚðŽ»hÛ¯ãúƒÊW¢¯ú/Ù«/ºï¶Ñy\ð–ôD¾Kþôd¿â#œê¡d·’}Û茫ǒÿ•ìTÒWÉÎmtJù\õ©t”¿¶z¨­®U|JOã\õ¬tõ©xÛ↭ê±-~µ_Z_ªƒJú*Í?Y€S:mùKí^ÒWÉ>JOåÖ}IýFåÚ*Ä›^JúkósÕ£â+Ù[åj« Jöj«¿Ú꺶}Tí^Šƒ’ªÇ6?Ð<Ýæ?¥<ýiÀ?Þ"—ÊGa[Ê×%þJ~¦~ù¤Ì»_·åË6û«‰ï ‘Oû%ùÚüTë*ÅÃ~)·Å•¶mñTÊoªõ§Ò>VÊ› ßæ¥¼®þQÒc[üª=ŸzãÖsmöÓ¾ÊSÒG /[Õ»Ú[ýFáJþ¥xJöT¸¶sd[}N|ªµÚ¿MÏãÖó¥VzËzŧþÐ%;µÕ[ºÏÇU¯¥|©ò•üP妜J§$ŸöKëÚâb«àW¥¸S9Kó%úªµ¯Ê¡ð[‚G÷Íq÷å’|O ^…W>žz¥x(ñ§óê¿ WÊ3Ôãã"Gþ¶ú´TOµù©Â•ì¯ò=QÀ£ëKþ¡þ©z,ù©ÒmÓ_ÉJúübA^]§tKù¤ä·Oð–ü±d—’žKç/ͤ¯­ÆI›•ü¯my¨Ô'žR|•øR9JzlÛ/TmyLÛ6¹Æ×¸)Å})_”è”ðµù[É/JëÛüx\ýµÕm~U¯ýqõS’›ý'd¾M®IùW»·Õóê梁¹$—ÆÃ¸m[«r•äo«ã4NØ–ÎñZOhÜ”ìU¢ûxA¾¶ºŒ~Ò¶¯”ü†ëKû@Én¥¼ÚV—«—¶ó—Êÿda¾dÿ'd~«àçmþ¥|–ê°¶Úê÷’|OJŸpäWíX:§µå·sÝ7H¿4¯y¡$§ê¹­(í»lUo%û—ü½dß’|%{i>—ůzÐõª—O‹Ÿ´ù±ú••⸔•O壄¯4®ü»¿µÕ!*G½Ò¾7®ýýxþ7£Î›ÿíӒͺׯû²ûé]Öÿ9Ãi~Ô}©Ñû“äÓî› 9^ix÷¼û‘¿«êwmî5~ýïHýï…W¬‹}Ž$oÇËÃ6ü%?\þ6lë–ÁZóí9ƒï5™M7SS_Jz]ù%ëÿä»LÎÓÙ´É:ÿ&û‡¬ÿtã÷ƒÆ’ÛÈÿÖÙ|jåQÃg¾;m6êxl¾ÅÚWÙ‹¥…w%ý¬ôl쳆ÓüiÅ2ÁNãiê †Ãx¹x w×âlÅbi‡é—ÿ]ôרº¾}Æú/³ùÿÅÆÌ÷VÌgºç3ÖŸ…̆gé )Î:ÆÃŠùõò7ÀFæÛsþ7È–/fþµüTŠ9÷çÝÏ4\oN8æÞh¿/&zSγåÅ'ô+¾þ¶Î|u‡ùøœÿ ´Ùcþ²¿ÓtºbtŒ§åœr@çé)ö;k¶æÇíó}FßrÈŒÅt×âjù)Ç-ÿ`‚Ÿ}…ýþ¯o+ï7¼Ë¿•l¸ãS)gì6ÛvŸ‘|ªãï3ûì0ºËf“9ÿûç?2¸k4<ßÎå_Iþ9ç£ï[ý„Á›Îv»Ïš=×ÿÙdü¿mùbÇ„]ù˜Á›¦M±ï¹cÅì7õëöû?³9³Á‚Åî”៺Ï~·Ï´ùÎÓã®g¬éxÙròÊóÓ»«:ÆóÔ|Ùì3kvY~uŠ—åìcyqÁø[°uÓÉ”ùN×òè²õ»þ^ã£kþ¸øQûÝcÁóà;Œæ‹ΙKÞêëSŒU¦÷ióóîOûSÞì~‡Ñ5ÛÍì‚ùלÙbþí6fºîü…ÁYLy^4]wÍOæÿšÑ7}Í=–l?u«ñk8ºæë·¥XÚÖ•É8m9£k±²dðÓ.§ñÖÙŸxëü#›ÛJþ½dþ´àzü“dëí<|w²wÇs–ñ´Ótºòc‰§ió­ÊrÞ´óbq¾ltç-F¦-_ÏýEò›®áœ2î>dý?4’†§ãr}"ÑŸö¿Cÿ<ôb¶ÜùŸR~Ùaþ·Ãöÿ;úå÷o/O1°ÓâxÆÿ¦Ý>Ý$+þ÷ä–s—_™råvþ¿Ö~³á09flÏÚõåÄßܯ¼ù_×òòœåYËM O$¿ôwåL¿ó£Ú~GÃì%ˆïKÒÚYó£®åãeÛ—_–h9O ?Ÿbeûý–WŒ·%ËãÝ7¤ýÄóÄ.ßû?`°ßžbØ×;3í9˶7.Z¾œ2ÝÍýYÊ¡Sßbp–SÞ ß1?ñ|á±nýÝ6ÿSÜNÿŒÍÙúeã­ëï–@±¹Ú}Áßû4gù¼s<ñ½`¶Yúó´ùüò;S.\¶³Ãri×t¾buÇN‹½®ïÙVO,?-ÙbÊ÷3ÓËì׋ïÓMÇß_`>ºòÁó¾Ì[>X6ÿÜaþ2c1;ýª”§§ü½Dž‹|ïþ6Ä…áªvÚú{ Ör̔ɴðHÊÑî»+_Ÿìéï Ýõ«öû©T{tÍ÷gƼé~Öð.?‘øíšÞ— nÅåµèš\ ¶¾ë¿Ÿhó¶Ï~SŠFsÁbxÁl·bzíºÎ,¿í4Ÿ_|ÜômõÖ²Åù¢áéJþÖù'6nkgû¨[Œßó¡Ù?N6ò:gÚ|eÉ÷S³ÇnÛÓ–½f¼2ÕU_KvœþÃTwmûùîŠÕi³æ‡»­6™5»-Û>Û1?ž7ú³½´/u¬nZöÚä6ÿÁ䟯•Ň×csæ?Ëæ3sæ_KûSŽy2í)Ë;ÌOw;ÿ_â}ñŸ¬ñ°r$Õ°Ó'R›|aáê”ëwýŽáµzmÉjeÓO×p®˜>fŸ‰ü}0í/Û1á±h~éï1YöÈøßåïÝø1ߨi{Ù²édÉl°hz™¶ýgÅl¹ü«©&ßõ¥¤‡iÓWg=íù³ÑÔ΄Þêí%ÛŸæ,.vZß5v;Ës3œj´ißüœþ>Óùü/&ß\º/í¯¾ÎôSýâuîÂÓüÂc)nü=¾»Ì/Wæ‘ŸÌÆÕ· &sz]ezÞí¹Ôòëâÿcrû{Ígí÷i¯Ñ­®\6=¬`Ï_x0Õ‚‹ŸD®4{®X^öwÓ,¼&õgŸü»cuå®/TÛõåÌßLfŒ—™#Ø{¼^Iþ¼dzÝq:í=SOKòÏYv-Nv›];–Cg|ö:ý¯¥¶kx?‚šÃr“¿SyÅ÷R« –mÏY<œìÛ±mÁ||ig¢ëµä”í³æó~6ûTÚ+ý}23Ç+®¶ëç®Õ +ÆßËå]‹ë)³ýdîá;K^¯ûû{Øû~ ÉÓ1þž“j¸Ý;Õsþ^Õ)ßCìLá5Àò‡ ÿÿÎís?’pÌ[¬,›ÿï²¼»b>Þ±XÜýUé¬é¹ÛÏè‹FcÉt1ez_xeâÉÏ»Ìï^›j¦©“)/mïÓα˟Mñ8o¹rÞríÎg§½h›ß´Ï7¥úËãÈëL×ݼùÒ”ÏÚØÜã©Þö3‡ùaÇäŸ?“Î »üÝ;î+fÏYó¥æÇ‹¿’jשßJûЬÕ" ~¾7ì²s¸ïé; ±Ú5ÿ\@ xMäw¾V¶—Tƃ¿?ØëI/öÒž´wÍ}4åLçuÙòaÇÏ<#‹§Ë-K¦Ù>“IõøÌJ:78Ñ]f»¶/îžNùÝë-®å¿i;¬˜=V¼Þò:É~Ÿù6ä=÷µÒþ½byÏßÁ4õ×Ó½DÇÏ5V;Îú]ˆ¿3íÁ”Ï}ÝÒK’ÎWŒ¿îëÓž³ë ilþ¿¦œçô§LwK_‡{?O›¾fÌ/:G­5ùý^gÅäßeðS^Û›Ÿyí3eùn—׸&Û”íáÓ&Ï´wº¯Jgñ®¯µœâïó\=gûëŒåƒŽí ;mÏòx°Ú¬c¼ÍyL|2ÕjsF{‡Ñ™²|ë{ý´ß?Xý9÷ñ´GÍ>=í)·“ÕKÆO×ü~ÚïA.KçOßw–¬îéØ~4ï5¨ÅÇÔ5©Æò÷a¯|>Ÿ½Nõ:~î½È›ß”|Îóö´Ÿý ×ü7¦³äÌÝé.k·áéºÿ.&ŸØ®¡oKvsw™o̸Ϛt|{QªyÜó”ü¯úžTw­Øž¹b¾Ð±=bÖæ=™ÿOyœùû«,¶¦Œ·Îµ)Þwš-}ؓƦ¾;ÅÀŠÕ!Ë÷­Éóî~Oãïà3ßé~&É·óYyÜß[eõÂö»ÍwV¼ž°½»óìDkÙrúÌ›Ó^Rýeª­gÍŽ;Œ‡]v6ñ»5ß‹§,ž¿”îÅü~eÚòqÇåüÓtG²ËiÛÞ°dyµk1=ó™´?̿˦ƒŽ×“?s/J1Ø}mš«,·ÎL§øš¶œ;ïö5ߘ›I¼ÏZ>˜z5jj«óç̧,¿L™o¬Øùa÷×$Y]áÓ–—ºOOþ½GJ±äg“e‹áÝ~Þ²\¶Ëøó;Œ©O¦3ÅüÏ&™Ý·ïN~Ûè–îçÌÏ­~šs>—R\¯˜?í°œ¹Ãï]W’ÞýL¿l~¼lçše˯sW‘üÒk‡Y‹±Žû±¿[o7ö7Û–=˜>ýýx_Nñ³ýA¿ õ»Qó¿ÝÏÂyÎë̯Jg}çÅó´û×Ô¿Ið~è~®J?¾o›Otü¬i²îø”c]žùoHwŒžÓüÌëï¨ôóÅ‚ùó’ÕÊ]“£ûÉß+§õÁTÓùÙ®W§³Ùœß¿7ÕKKMwxËVÌþ@:{{î]6þWLKŸJ¾2k9uÑöÐé÷¤Z¦sŠ—…w¦8õÑs¡ç¿KóúÐíçç/÷î'ýì4_$ÕA;¯J>R=3éÕý|û.Ûb`Þt2íç§iùo‡×M›6î÷;_“jûy[¿ÓÚiÓç¢×±–“º~ò·Òvåᄾ—ê~‘óÓE§å>ŽóÕË‹Ké÷)óñ“‡É²â>à÷Óé>­kñ²Ãì5o¾Û]³5–O§^ŸÖ¹M;ïOùÞsðö¹z:åòí3Õªí{áåÿ”âÅï ÿFª¥üN~{ŸüÚtGÓ5ývMÖ•_MgâêYiðœ»t ísVëíøl¢ë÷ÛïA4øÅ—§=Ñ}®k²øpÎ}Åï$­VÜñLÔcVgÌX>˜ùîä#]Û—v½Åd³|¿òXÊ ‘üÃ÷$ÏIK&ó´ñØõxûL:kv½æõ;Ã5õÌt?¸dµ@÷ÇÓdÙôµüÇéb÷J ^?ùù}'ÎËé>¶ãñkuÇΔôëgðe¾ðP:ï-ÝŽœØÞ ~Áó°ÕHÓNq?kyiÎrñÎÿlô-/ïrýùÌó¡× ~'iŸåïÄžÿ¹”_ ×ü¯¡þ4Ùáw2¿›î0?‹¸4?žûõ´ÏvýÎï½fõûßç$?XÚ2ü9”ßu~mºgX4Ûï´sв×Ѩeg~9ÙfÉä[~6ÎÜ^Ë›Nw?+~·ýßÒ^½ëò”g§Jñçg-?_uß–öP~5gq?óDº‹÷»ç«‚L;ý,o>5ókÉ'Wþ,ùœïËÛï©üö¤›îw¥}iî÷z{úÛÇ¿/ÿ\´û“"âß9¼í˜_gÛKíÞA¿ÖËÛ«ª<ð\‰ö2´{d~ñ r~¯éç|í“õ„¿¦ÊáÉðÛÏáö =Êqæ Ý'òP¶”—tˆŸÌ‡>zÂ'à¯F»_ס¿óÔå!^ÎÓŽW¢=H~(w?‡#”çùh÷ƒþ:ù®rºW£½Bå¹h§àxê¼%ßÔ;é‡_o´Ï§\‚‡ã”û*éïÞ~Î×U2¯~sU_ÖÉz'Ú“úÔ¸ÿëç먮Û7ÈùÒø¤¾Ã„m×ÐÒþl)ýô™/ˆ—ú¦„ݪœŸà«$¯´ÁʃqÕƒú×åý¼_“»'-á{ÂÈGùéçOUÎ÷%èkü°¥¯!—Ì“¿ðC´— ?‘/ÐîAùˆòr|‘÷Ñ2ïQÞˆcÀ—ôx­¬S>Gü!'ø¡©¿} GùÈO¯ðW´ë‚Ÿð{eÝåh¹?j^§~”Ø„Ïãû¤%_jïà­êµ–_ÑÒÎWKy”| ÿôʯ~ymØø…ŸRÀ¸Šxäðê—„£¤Ïø~é+ßUN/⪾?íûY/‡ = ò±·ŸËAú”SíFøh{y«û<õAù/éç|(Ð×uÜ×9}úí}¥´¬ ´®zž¬/åwÕ[ø§´whiú™î×Ê:õ'­÷¸Žþ´Æõ€ÿ^ò)ô‹u0úÜ7Y§2žöÈ|i׺ ¶O£¥=X§j¥ù@÷¥ /ò¨~ÂŽU.—îµ}_à4ÏhüE ú´‹úSä§^ÎíOýrý¥è3nU¯ôÛÚ>^årÅ:Á¿Nþ¸~ m?okçáû{ѪÞ"TùºÈ"_Ôch¹o”êHGÒ‹sù!ÿ˜¯ÕIä§~A7Î!ÄÛËåÔ:MåÐó‹îcQG¿ð¯ùžy~òÔìÓÏÇiw¶ô¶‘wÐ׺–rhœ±Õóås(ù\Äñ±–ûƒÆ±Öz%žš~9<ã#Î*—ðÃyöµ"¼ú¿ÚWí¬z œìSz?QËCÄßÏåŒs¦Ðã8ù­Õ˃¼%}Æéðµ·ŸËM¾ôRªßÖ"ðÖö™^ŽŸyˆ÷3šwJçÉÒ~€t"ñv^'½^N¯´Oë¾uŒÈE:Qwa\ã;ü”rôrüZÇÕÎ-².ür¢y ý8?ôr8Ýÿ"_¤-Ð ½ òVõ|…ÀÅ>ÜÏéÊ;h¦K~´-Ýk¨¿•î 4è~´ë´¾&|Ü‹¿Ò!Ä+|ê9®vŽ4÷é—”ƒñužÊxê“ùzOOä|±î«r¸8Gb}œ£‰¿ß Gû«ÞÂ/¿WÆã<ÙËåZ#¼ÈCyÕ~ä'îi/åû\‘‡xku:áÉñ ^Íq×ÏדíçGÌë=§ÆõòE¼¤_åëÃùøéI»ôi7Ú½V§æk÷ Š—üW9_ëÀSËk\O¹Í|꽋®#z¿Y»G'<Æã¼Œ¾Þû©ÞKuõ¢uzí¹J•Ã×òÞ —›yXÏ/q.§\U.·êYóñ±N/å3âÕs½Æý¶T‡•êò«õžêCïkÔ.¥û öUšgÈWØ¿'t®¶_ôsøuò¥tÈ× ç/î¯õ¦®'\ìÇUÞê>§÷&ñœ ãá_˜×¸¡¿–îeãÞrÕžka>Îý¼-ݯÚCï?H_óñP¿zÏ÷"_íž}Í+zÿ[ÊO¥ºPŸ3­òõÜ/×DNc½ÿÓýøâ^•óýB+ë(7ñë}kéùùV¹tŸŠúíž^³Üqˆù½„'Ÿ”“rT9ZO.î5·V/Š<á/i…ïÐ×õsþ£NäëôS:ÏÕò&åñ¨¤½\úê÷äGëøÚ¹üRÞ~Ž_ïÏEû}Ä'ü3ŸÄyMðhÕçÅlã>œr`¼¶Ÿ‰|ê÷µsàôù©>‡Q=ŹžòŽvâ9àW¾‰·¿Š·%8ý>ˆæ-}î¤v¡kä‹ë…̓ZŸÔžUù¼î_z«÷Â¥üDá=ˆÚMÏ=qÏ,òiP«ïE>­{t_£¼q@ŸöÑ|÷ؘ¯=/zz?¥Ï+µî×ï q_ªÝ÷rùbŸ>t_¥õ¿—š§(?çõÜQ{Þ"øjÏ+ÉÚZþe+ü­_íûäGZ­_Õþµûˆ^Ž—r>—ürüq+òq¿£¾õ\N=Õîï0çpö±ž~y ëây^a}ÔŸýœ=ïG®„/Àk]ÄVŸ‡h®÷ìħ÷7ñ}‘ƒýšÛ*çSÏWÖÅ=-Z݊ߣ©šéÔê]ôõ¹fÔwl…Nè“òbžzŒïõs9J÷¥Ô'óWí¾}ÍKº/ÑNµûÁÇVÏ•z¾Ðû&Ý×´>¤Ü—ɺÚsÓ‘qûñ€OêQŸŸiý«÷‡±ýÒý‘Ò×ý2ê Jð÷sùˆ_Ÿ#Ò¯k÷5½œýÞǵÎ#_êñ}Tô5¿Ïà—ô9½ˆ#áGï瘗k÷šÄƒ¾>¯ªÕ¥ÂOÄs?—k}ó¡ù[¿o¨ßóÐ8×ûP¥Ë凌¾/§Ï-4¿GÐÏÛ’_F\ör|zŸ÷Èè—îÍô{3úýå³ôýÁ€ïåðñ|NæCÞ*o÷`¾ö=:¡[ûÞ奜 §ç´¸ÿ&~Òäí…>´NÓûuý…®c¾ˆç"hc \UÎ>¦|qÏq¬×ü |ë÷ßjß#ýA¾Ný¯tŸ¢v­íÓhùýõAó:Þ3Çs[‹ý™x('ù®r¹¸^ŸŸ(üšÂ£¯÷Áú¶vŽÅ|-¿®Êájßßäëô9Ê~g[åtõ{Tú¼LŸs©>kÁþ o÷b¼¨á+ž{“¯JðöD.YWÛ¯”¯^.‡>Ǻmißáþ­úÑú/ðo¡ùŠ|²­ òq¾—Ã~È©uùW;Çy¢'øÉ7Ö1¯k½ u4[ý~ŠžwôÜC=èó§Z]$pzÞs æÃ/Éß §O|ÜgÖ…nì[ýoíü!ô‰/žÏ÷òyÚ›÷¨|®§ßo.=Ÿˆû×Jæ±.ιyWðéùNîQ«xäöO§ð9û§i®#ó «?™oÂÕ6^ú}” ãÀŒâ¯D· ·Â’}ܱ’NtÍ(ÞÆ¯ZàªÂïçk‹QôK_›¨&…;ÇY£ôÎþ9W»—t;Jös•cΦñªÐŽkËqe%wqù:›œýS⽩¯?£æÛø%뤶lã}\?:›ß“ú긾Ó&Ó¤xGéd9T¥µ“ÂŒkgoƒ½viãe”ŽÏ…·Iלý3 /mò6á+áE»ÍGñ>Šg•{\™Kã“Ø¦ ^çÆÁYÂÓÆŸêA×âoÞ&™oâ·Ïqt[ÒCi¬ ¶ ›ÎÅJü·É}.þx.þÕ¤Ÿ’,çâ;MviÃ? ÿÊË$üLb‡Q2—úçËOžQ¸Ûdiš×ŸsñŸ&žGÉ2‰ïL3ì¸ü«Nô÷6[7ñÒÆg WÉ^ç«“qxžÄMxÇ¡¯0MkÇ¥? ß$z(ñ6ŽJ²W#æÎ‡ÿIý¢ U€‡óñÇ’Í'å÷|xPyÇÑMÞ¦u¥µ¥õ£øœÔ6M°Uaî\ù™Äߪ†¹ߣ|¢im½I|w[ž«ÞZ`¦ùlm ŸÆgê¬ß;2w6LG`:26-xt|ê,Zg¯×±©úmüÍ£Òž*À¨T¾³Ç§ª:oMë§„n&^§‡Â•dPœM4UÞlm¿ÚþiÒïÔzS2ßăúW§a¾#¸Úðt tK~3Õ@WשÜgÃ’­ÉvM1¢ºmòK•’þšü¬É¶:×$ƒòÒ”TgãøvI¦¶ø-鮉¯&žFáV?iòÒ§ÉÕ61Þ¯¶šô<ÊšlÚd#+Å@S.nŠñÒºR,4éTñ)í¦œÕ$wo¥¼WÒkþ&nÒ[ÓØT­Qq\Ê¿%¼%½ŽòËQùE}½ÉOšrlS¾(ÙîìO“Ÿ6É3ÊŸ›d+Ùg”ljÕ&ý”øn²cSLµÅ¢ò2Ê_uϵ'(ï%ßl’µ)§6é¸i?S|¥=¸ g)5ùà¨üQò&¹ÚrɨÜSʃ£ü¹©V•§Ûâ­äO%Ї¦œº=Ö¯¶FåäQ6nâ¡´?5Å©úɨ} É_Õ†¥ØoÂSÂÝd«©ZMú™–µŠ·É¯Ô·J24Ù«‰×³ÛRÞ,Ù I>õ½Q9IñWò¹Q~5j¿(Åj“ÎFígmq«úi²ï8ùPý£)®Jy¡46*žc¼_mÿŒŠá¦½IqŠãqct"¾[lÝd¯ŸÚ6áU”ìÕd÷Ò¾0Nì·í{M¹§Éo4'”|µ[Mûu[®nÚc›ü]s•æ²&|%?kÛ£Ú>Ûðýjû§I£|¬´WM5|Fé´¤¯¦\R’³Í~ê£ôQZ¯{\‰§¦ý¢´75ÅYißS½cë¶¼ ù¥[m4Jù¥-ÞT–R\ŸÅ÷LZ3ãÿî_5wòè}GOÞSmÿKt‘FgOÙèivî:}âNvæß{úôÑSgÍìᓇî!–À}ìÐá3¶²ªþªÂ¿îöœ/TÙûÚêOi¾m}i~\: ÿ…¢{®|<Õxu} _ܸxJzÕŸqé—Öµá)Í_hÿ¹Ð~t±ãkÒ8ÔŸIù>_þΕþW*Ž.v^kãc\>ÛøÑŸ‹•ׯåã\ñž/þIé_¬vR>J?çëç“â{ªã±„·mþBÅûSå?m?“úCiÝ…ÒßWþ|åÛÖM ¡óÁùÂOÊï¸x&åï\áÚàKóãÒ¹XvÔñó…»Pùá©jK|µñ«?K“Â_¨|s¡ãl\>.V¼](~Jx.¾ó?_>JëÏïÿ¨q~±õùTûÃÅʃ:_׿&]¡ô6.Ý ÍßSe¿6¾/ýÿQâ¸mþBç ý¹Ðqö•ÖãSÍ×…¶ÏÅòŸIñŒ‹÷\ãýbÅKÛüS忚IçÇÅ;iœ·Ñ—Þùê¥ÄǤþ\¿Øù@.Öz¿PtŸ*~ÏîBñy¾ôÎuýùÒ=_;*\ÛºÒϤüŒËßÅÒw‰¯ ¥ÿ§ÊÞãê¹D·mþBéá\éŸ+_“®kãcR=—~Æå³‹•&¥_‚›”ÞÅÊ¥õ%üÊÎÕ¿']ÿ•Χ“úätÚð]l?~ªò`›¾.:VÃ7Pê_¯6ýÅ©öÇùKÎÒXÛ_ºŽ‚m£YÂ3l‰V“>ÆiKëJúi“sZ%Ûµá/Á–h7ñ>Îï“ê¥Dg”Nšh–äjóÛIý¥Í¶m|7ÙaÞÇÁ;©=›üj~ÚdåÓ£üv\:ÿ”ÿqôÕËãÈ4.¾¶õm:m³K›?ŒC³Í_DZÿ8ñ=n̵­ÅÓ$>Ô&o‰ŸQv{“Ðj³Q›®Ç±×¨XÇO'•¡Ç¶˜ló›Q:%÷(Ÿ*Ù²Çqc¿MÞQñ0Îø$øJ6mãmœøj‹§Qñ2ÊGÛt0©l£üj¹FñÞæKmr¶ÅY [\´é» fR½ŽÒÙ¸±=ŽÝÚü©¿Qºg}ãâl‹¶˜n“}˜6GÎ’=GùÁ(¹J1ÕæŸm6ÅgÝ&½£ÓqìQŠÍIôr.q:‰¬ãÆFé÷Qv¦Ûç£b½MMxÆ¡×DsÔ|[L´É;iŽÛ¦¯Q¼Ž‚=—˜Åÿ81:Ž_²ÝùêeT ÒݨX™46DZC›_¶ÅÂ$0MvšTWçÃã8qÞF«Í7FÉ5ŽlãÊY’­ä£ãÄð$4'ÑG›.Gùà¸ö,ÅÍ8p%ûË÷¸~9ŽO¶é¼Í'Çñ•6}·érœ“ð1ÊFéyT kãIìZòÍQ¶¼Ð8Jº%Ó8:)ùÏ(}¢w¾~S°‰¿:rêËUz[äß,y×ÉC‡Þz'º;Ïœ>têÈ'ÝuúÄÉ´dšK_0™¿òÔ¡;Žò}”K¿ÿè‰ã·aï¶³{O?të‘;ï8qêÐÉçž8}øÞ;Ž=}ôÔá£d枣Ï=}ôЙ§NœâØÊý‡Nž¼úÎ3'îè鲉‡1ý`úÂôƒé‡øê‡X÷éÓñÖ±îÓ¦/â±/â¡?bÝñбîÓ¦/L_˜¾ˆÇ¾ˆµìãAþ±žñбîƒX÷CO—O•{¬eﲊG9œ¹„ý3Ø“G'LHÔñ›'Ê{[‡o"§\÷XbbÂØñtž:81a¨GK’ÿVö¡ÑÃ’TFNö#†=4þ‘ÄŽßZ±¿ ‡O¬có‰ýˆçO¬ûÆ|Ì8·O¬Çù˜ùOŸXó1s"Þ>±æcæD<~b=ÌÇ̉xûÄz,˜™ñò‰uÿ›OìÇ@Oÿĺÿ{ò'Ö}ÏŸX÷MŒ>‡¯5{²p“Ù[ÝdÞ0fØèºúÞzø÷PÌ>*f§wžørMûz+ôö8Þà34444ìþØ244444ŒäÍ>CCCCCC=o³ õlêy»ÏÐÐÐÐÐÐC†††††=™wX†††††=‰wÚ††††G¤¥þŽr‚þÇʱ~p„/>ùmŸK.ú>¨¾œTrÁoÉ›Nù%±êËSýoêKUç]ª/[uã[Aõ%­3ƃIP}«ä¢AG–‹ÃgŽÜžùSD{º™ïPŽ|ç²=3YÏÉo€cü ’ÓÛÌGÉ)Þ8{(8‹ý§¾„WÇé§²/ž >ÕÞhÁ_Ú Ç]pX7¼ÜÐ@Žk÷’¯ùÀ/Ã]ÓäÂBòZ°ú)ò,°ê×ä/É{ÀÊ·PN%åáÆŠ}`éUà:¶'ã1pA|ܧŒ#½GÇW™Ï‹¾øæDÖó1õ×u=?Ò:_îîFŽ?õeèŠéAò>0-ƒ¼©s¦~DÎ gÊÈKÿT_ÂÝU.¥¾˜Ïq8‹íO® ª/ý^Î/³V_bííS_v}Ôäx^Âz,^@jôø±rÑnpÁ'àÛƒÁÉ¿¯±ÂÛïÆœçËî—^ÝMrÑñY¶‡ãmÑA0b›ÀvjÖ1?í€YApåðh2xå°ù  Žõ´/6­ €OƒÈ¯"|c ™Dþˆ¼ùµV’9È·5é[OG¼–Íd%Â[VÑýÝ?ƒ»ù¯È§ùº_Axó¹`Óø7} l,FüÆi`p?Ê­¸ñsç Þ<Öÿ*ÊA}‰|Oáøq ²3jnëtÜ’ýšÜ¦!Û§Ö¿©'0ýù /ü_ò÷dÐRo¾ w îÀ’öAà@úõ‹¬ÎyX®{ Ìg½ò›\H;8ŸíÌ{’ æôSoÓ~šÇ s“};çÚ×ÉÁGfçyÎ~Ì~OÃä O³|Ñ1ýàrÊÙÑ—ì‡ûm0ÿϤNÞËI/ùÊ©–r ]§äžý-QÚñ™5®%¹¾ed“ãc:ã§S?¦ýCpønøÆà³ÉàîzrŒü¸k_¬ðƒoûÀW~¸“ý¿³ñwb#dï¼…î뇂Äk?ÿvοv?òihƒ½À¶Êm»î­H·ãp{þÛ/E½¶­D~Ûð½µÜt+â7|îÒçÁ”ÿ±àŠ¿ÒNZÊö9öMÔÙ'ìW×}*¹`;8ŸvHÔûÍyàœdÒ{d¾Mû&y+8qpxûßâ>NíïÞ`ý”}鯙”Wõú´ X¯¶îᔤ·sN ‚OzÀ‘¨Î¡jioÔ>í?ÖL&¹?¬9îê2+œóÉŸ ¼ê Éñäöjåÿ€MˆWN»¶ür¸Ëh_•ýþe´ÏJ9ÎJŸCxi"Ü%+ÀâFø÷‹h—hŸeÕË)¯iÔC|,‡ú¤4‰ùs|—R”ØÌ?…åÝÁrÞ$i§Fðë`á*Ä+|’¤Ýà>>Ð&H¹(WµžT‘´k ˜ZWõu I½žû%p5Û½àø;Ú c‡Rå$õxi3å¡ä¯˜ÿ’-$÷E%åtåôEÊaàD!7®3Ž]"ù߈ø ©ì¯&ŸõÏS.:gîy”ƒrxœÂñy=ýß¿åì¯l‡Ù!¾Wç*ØÞ—÷¾àÞyH·÷<¤Û“1 ÿ=g"Ýî‹á¿k99ñw¶#|çoé>;bû~ø·/F9íŸC=Ûªàß6ù·]ˆðÜWlÏAúí´Ã¶î‚{ÓP„×s>”xÁW€‰0•ý²†vÕ*ޝ•söÓ²¾<ßZ6˜õåúªöÁKü¢´³œuQíóÕ¾—òöÓÎÒ¯Fœ·’Úu‘ö¡³î±§süOeý~Ëú³Àæ_€MS| í‹ÆGáßÈñÕ$_ë©oêB ‚;˜ŠôÁ»È“íëð¼ö†bÄÛ@½[û"Ü5e<·*cº2ê“ÒD°äë1Žnæ[ÂõJ±˜ã¤ˆr,B†v:Æ.üÜ=pG¬#ù_ÏýR„^¤>WëI^˜Fûy¡&s=xÐ 6âÛnà¸iàyJ}%ÜÁ6Èz8¤\ë¸nÔÝ ÷öç†Óà®Ù w õ\5ý«Øo•Ü?VN+6ÿ|XÖ–r}VöBéyp—POáï¬ë`¿¿ÿ¸ÿÓ¡à^°OH0ö{σû>&‡€{Gü=[áÞ3ùì^ÿ]á¿ëJˆ;y?оÀ9ŸÚî…{Çeà6ÎÃm_€{ëiˆ·å>¸7Sn­7ÃäyX!÷·«N¦ýPÆqYº•¤|J ‚޼i×Ñ./¤ý1ž!^€ýà¹YAÜìuLïìkoó–¹Ô¯ÎþžãÛÙ¿SŽÙÜOfÒÞ_Íó‘EwÉ´C~1ý;ìM¶3ƒ÷@éÏ)Ôó)æÇs‹ˆsÚ~ ³~ø¹n9ëÉå`Ä~‹rpÎQ™Îuá:qŸÉògÐnÙŸþŒá¹ÏÞxCÈÃn¥¾o)%°›ÿ—ÿéop7]ðFž74ö»a>Âëy~Z7ÝÔÁ{à_W€üji'×0Ÿš³á_ÅzU.gçyù$Ä+á8)æº_ÄqQÈþ_Ïu9“ãz%Ϲ_§œ`}êä9pðpí¯Zž3Ô,%¹W퀻òUÐYg$9.+"^yÛqÜ¥a{¦‘W‚ÅSÙ.ÚUμ[ð÷ ë/×=:óÉæÐžN¡]4w)8q ¸…û›ÍC ‡MW!ÿì—VögK^ü›§!¼‰ç#^ã5ˆ×ÀýœCžë×O$G ~ðäïoëV]ܸ/«å¾¢ö¿ÀÚ7U‡È—‘®2îŠÙ”ç60Ÿçm©ÜΣr— ~Èuヤ¶ßçþgÿlÔï½ýàHoˆûf {?„ÿÞqˆ·ç¤ßÃýúîǾ눿s5Êiߎ|ÚÏbÛ鈷ýÏÈgÛ:pkÒmy ùmâøne»[¿Šð–>`3ËmZwã[ȧá*¸+ÎAøZ® ó©ßý`#혮÷ _ëyþ¤~~ùÖQNÊ.¨~îª/‚•_Ë9ÿÊúÁ]Âq[\A>ç|€ó»h<Ü…´wÔ¾¼ç3¾žvN×=e/­›æñþ3«\Áûúùlïäx7Y2Ò^>×­õÉúóY.øì|æ“O»DçIqžÃ~Ìù9˜ÍveþÌàyZzŠ ×yç^—v¸ºÏ]Ã÷8V±ýν+×—¥¼ß[B÷;ÉàË~0‰îÛmpÓ Ð/vë&¸[˜¾yRHPvS+ÜÛ¯‘ç) <ßhàzQßñ7ð\¦–v5Ç_÷/<·¨ ž)å9V Ï%Šëà_ü-°ˆzSS²Þu`í¨|Ž—Ü;Á꯬§)¿ åÂ{è)\W° tèÃ|Ô¿…z¿9lâû[Þ8l Þ¯çyxýu”Ãw.H}¸!á5ÓáゎöWÁ]~?åÀõ¾d.X´þ…WƒÚGŸù¼Èõ“ò>…ç 9¸ˆ³3y®°&œÏ}À+O€žúêK(oǽà6ž/n ÷žglæþbÓZ¸7Ò®håû-­½ànžtM|O¦qØPtõsÁ ëU÷&XK{ –ã¾:é*©ÊiÇ•Rþ%´ÿ‹²(¯ËÁuŸ…ÏY³½”Ã8pQ¨öW1ü£ÔÐ/öwûCÜÏüöe"|/÷{žwOF{w½44Ä»oç9Hß~!Ò·ñ}¶?†{Û,¤ßz!Òo~împ·Î€»åÛp75#}ã;Hß0 nCøew±žÕ<_«â~¶üAÄ/¢½“ÅøKh‡½äï"7qÝn­Gþ-Y>í‚Ú·AîßëÎBüZÎïš/ƒÕ©wÖï%¬,ûLý¸†öû»´'ýÔ÷S€x=¬£|Ö/ŸíÏãûkß'žÍ|äý`õyÚ9` íÌU\'VÒþÓžÃqÞ«ýÈBÞg9û î‡ÔþaÏfÑ_Ý›Lçº5¥ TïE=ÍvÝFwÓoB ·˜ý̓ßëp‘a×òý¸jÞóT±+_"iÇV|,ã:_J;°dXÌsÿBîG>°€÷›ùjßÈùžÃû‰lØçiªÕûQ,w ÷g«é¿ŒöÉ;êÜÍ>Áöc{Ú¡¿†£½A¸ÖÀ]–¤~©}‘í¥]_Îu©œç`eÜï–>ŒxÅÊîÃvÿíæ9æ:Ú±¹<ŸÉæ{aYº`?åò]0—ëJÎWÀL¼èm§ó>)•ëj Çë*ê<ß_ªÎ½¹NÌà×½7=‹õ×Ý_¿Ærä½õ$ú?嫃`åe`ïËi/ª~,e½J~wõx€û´æ›Ïóõ´ãs¸OÈâxN§~Oå¸[Éup1íµ…ƒêémüAƒýíò™´ƒÕ½2õã ì·÷Ùž²Áº^ yØAÎÏZ–S}&܆· @û©Wê9êxþSÃ}_%÷Ée§xþX|ÛÏý¹3¯yn•G;e-ílÊ-‹ó$ó'÷O)<^M=°œúl1Ï Õ9ëì Û­Þ;`û^æ8|žç¨Ï ±l>ÿD}ë  Ü‡ÔàÚÕÉ`%ÇUïKa@Ø%±˜v{!ÿ~aíüÜKÙ^ŽóÖ'“vXÏRx~¶šòvÞ‹b¿¾ë¡‚ ŸõUë¹¼_Í|fqœM§ÞŸÊ~ŸÜ.õþÁ–³ç«s¨Ç§•€J®¯p\)¹>•ªõ#‰ùÜÎü3•^£=¸‚úhõÀR?ÛÉz/V”÷è´£ðœsþŸÂå0ëÌ,¾?£Þ{rþ^#^ï‰\'uúðq+¼]Š£è¯ÆÍ•tñ^µ€÷y¯Ù<Jg¬f}Vr©ìE¼OrîQ¦ ŸO{Þç°ý÷íìç™\’Ïo×þðö(»Wµç.æà¹\.õNËK£^^¥Þã·Y¦Wú7â=4Ž£W¨¯Ÿ^á¬Wϵ²¸îePn©”ÃJê…%lßBîƒÐíç9æ ê»—ƒªß%'ùÂå#ßë–ĵþá'ôw”V7=?<Ð]9ßGÕÓ>5ºx'ê‘å¹¹OT=Ž5Þñzº«üX·ÃíQõëî~‘ãß™šruTñ£­—nþÉ|ºš¿Ì'Úùs¬ýïã§»»‹ñÝäíøÖ…ëês¼ûåD¯®–¯OWûûD•×]õP?&õ–Òsºz¨p;Ü[«¥[Æwò•õót.Ë×ÕW–ûÿmü™'º§ÛæC¿#çëfW¸=Ñ®vÓéâ­þ=ÚuíxÅë®út5ÝÅô:{ñhûõX×Ïc¶S.&9/tí‰X?úw^¾ÒçnzÚ)ÿ\‘ï©‚ý;Ï7"žf½Ð­/òÑí»uûÝs¼ú¯»Ó¹ùwW¾Ç+]Wó‹zÿÙ/<¾Ö>r)ß­lI9~£ÌOk·iì79t¬‡,O·O–ñåÓÕöD”+ü¥;Úþ·5þòÑ鳈xVçñlM<ùD;¾d¸Œw¼öcë„ÒËJ{„»Ÿ&¼ŸÆ­Þ“QåõáÂß‘¯Xä:±ŽˆuÁöjÊÑÍŸ 4þÖ‰yT9ݵu5?·õ0j=¥É¿«ùº=G+'W½00<ž3žtûTp‹uƶÂéf_FŒc—ý±.߈ù"òSVï©y%ý=×à ×ÔËUÏjê¥koDz—ð®®?N¾—hê#ôUD:—qàP³®»ö³§ó|,OŒ§~êûZRé}õÿ‹T=x³¡ßun•Ï"üM*?—~P³®Xá”nß¡Ûçèâ9ù ºéãcÕë¶Ý£ÓnzB–­ºjº=Ǽ¯ø6)õ¬ÐŸuvŽ —ùèüun¡ÿ#ê+í4¯¦žšzèûòÎË×í"ü5õuò'u뉴ó\×YEOçñd¹¶uäǾ‚TúD¦—zÆ#(åæÑ”ãrž£•·'Ü­[G¢=‡±D|'ÝM$×Í=ïå^$Ür½Pé’„¿ÊOÉW§ÿû‰p™N·QnyžåÖOß#uý-íÙÿç p{ÃÓGËhíÝùCD}­#?öe¤Ü‡¹0Z}.ã»Ûª'Zû(jM>NøH©äá O¯Ü²¼;HìW#Æ«%Üšp­ïárÝùÈG+õw„ªþò\AÅs9'ŽX?½"<ŸP”rP”í³DxçÍqµË´éðÚó?Ï_äy‡œÿ^²Ÿ Š/íq©GTz+<¾S\丳„[ž¿X·Õùã|Ïû•‚JÏ+»BÕïÒðú;íÒ­ D|9ç‹p9¾)Ç«Š®öØd„þÀ¿O‹œßjí/üeù"߈þò¸Äõu»7qݯêÎÙ:ÏöŸá4ùi‘^£GÜæ£®~n÷LÊ­ÝO­ ^RÚÍÒ~ÑÙ {Z†GŒhó“ù†7#ê}©Lç¤ÿ‘/<¹ßWþ‡‡KûßÉÏ#ÒyD|®[ä:¢‘§z¢µ;"âßL*ý¦Úy¾†R>^á/íF©•¿%âËq'õˆ¤G´ÃE.®ç¯êÿ‚+9xIiß+ÿÂÍúDì7ä9“W¸e:Í:«Ûoêö‘N¸þH·ã‹Tz_µW®cŠr½é¯‰§±§´þšöiõ¼æ~Õí}/õDèÅA"½ª—ˆïä+ýuv½'<\w.îÄétϱ¾ßïÔ[í5çBÚý¢Üïêì±hÏ‘4ë‚Ûy¾-èöD¤¿ÎºÙa:{UÚËžÎË‹G¸-Ï%¾nçš²>êq¾wH7ßÝô½ò÷Z"ž§ózj繤˾L'ùØ7ú@Õ.qß±{…¿ÊGީפ%Ó‹ùævÎ!ãIù¸Þ €ê®õwÙ_D{á®7j½Ð Hý`uîÖ•ÓU9éîµÜäà¤Wë¾—”íÒÝkkÜsð—zC¤Óͳ®ö³¬—>~ßÃÿ@¨—Õ×:üN;lLÂáÿp¸Ú'Ó³ï£Æ$ð÷S’Æ<òëQcGÒÙ')á õë°‘N¤Ÿ>˜ô/iúO6\tZâ#_ª ;³ãÓÛ×ñãСO6"bŸC¬„Jpúðaã‡]:"±#I‡ëð?;øéôƒ! Publish/data/SpaceT.csv0000644000176200001440000000140014142666146014472 0ustar liggesusers"Status";"HR";"Treatment";"ID" "Post";61;1;1 "Post";59;1;2 "Post";47;1;3 "Post";65;1;4 "Post";69;1;5 "Post";50;1;6 "Post";51;1;7 "Post";60;1;8 "Post";57;1;9 "Post";64;1;10 "Post";67;1;11 "Post";69;1;12 "Post";72;1;13 "Post";69;1;14 "Post";72;1;15 "Post";75;1;16 "Post";77;1;17 "Post";61;0;18 "Post";66;0;19 "Post";61;0;20 "Post";68;0;21 "Post";77;0;22 "Post";103;0;23 "Post";77;0;24 "Post";80;0;25 "Post";79;0;26 "Pre";71;1;1 "Pre";65;1;2 "Pre";52;1;3 "Pre";68;1;4 "Pre";69;1;5 "Pre";49;1;6 "Pre";49;1;7 "Pre";57;1;8 "Pre";51;1;9 "Pre";55;1;10 "Pre";58;1;11 "Pre";57;1;12 "Pre";59;1;13 "Pre";53;1;14 "Pre";53;1;15 "Pre";53;1;16 "Pre";48;1;17 "Pre";61;0;18 "Pre";59;0;19 "Pre";52;0;20 "Pre";54;0;21 "Pre";53;0;22 "Pre";78;0;23 "Pre";52;0;24 "Pre";54;0;25 "Pre";52;0;26 Publish/data/Diabetes.csv0000644000176200001440000015466714142666146015063 0ustar liggesusers"id","chol","stab.glu","hdl","ratio","glyhb","location","age","gender","height","weight","frame","bp.1s","bp.1d","bp.2s","bp.2d","waist","hip","time.ppn","AgeGroups","height.europe","weight.europe","BMI" 1000,203,82,56,3.5999999,4.30999994,"Buckingham",46,"female",62,121,"medium",118,59,NA,NA,29,38,720,"40-50",1.5748,54.8847409,22.1309881732667 1001,165,97,24,6.9000001,4.44000006,"Buckingham",29,"female",64,218,"large",112,68,NA,NA,46,48,360,"<40",1.6256,98.8832522,37.4192742794665 1002,228,92,37,6.19999981,4.63999987,"Buckingham",58,"female",61,256,"large",190,92,185,92,49,57,180,"50-60",1.5494,116.1197824,48.3703366546749 1003,78,93,12,6.5,4.63000011,"Buckingham",67,"male",67,119,"large",110,50,NA,NA,33,38,480,"60-70",1.7018,53.9775551,18.6378653900101 1005,249,90,28,8.89999962,7.71999979,"Buckingham",64,"male",68,183,"medium",138,80,NA,NA,44,41,300,"60-70",1.7272,83.0075007,27.8248017752523 1008,248,94,69,3.5999999,4.80999994,"Buckingham",34,"male",71,190,"large",132,86,NA,NA,36,42,195,"<40",1.8034,86.182651,26.4993803246881 1011,195,92,41,4.80000019,4.84000015,"Buckingham",30,"male",69,191,"medium",161,112,161,112,46,49,720,"<40",1.7526,86.6362439,28.2055128371967 1015,227,75,44,5.19999981,3.94000006,"Buckingham",37,"male",59,170,"medium",NA,NA,NA,NA,34,39,1020,"<40",1.4986,77.110793,34.3355266285367 1016,177,87,49,3.5999999,4.84000015,"Buckingham",45,"male",69,166,"large",160,80,128,86,34,40,300,"40-50",1.7526,75.2964214,24.5136917852076 1022,263,89,40,6.5999999,5.78000021,"Buckingham",55,"female",63,202,"small",108,72,NA,NA,45,50,240,"50-60",1.6002,91.6257658,35.7823686143719 1024,242,82,54,4.5,4.76999998,"Louisa",60,"female",65,156,"medium",130,90,130,90,39,45,300,"50-60",1.651,70.7604924,25.9595225036604 1029,215,128,34,6.30000019,4.96999979,"Louisa",38,"female",58,195,"medium",102,68,NA,NA,42,50,90,"<40",1.4732,88.4506155,40.7546754525733 1030,238,75,36,6.5999999,4.46999979,"Louisa",27,"female",60,170,"medium",130,80,NA,NA,35,41,720,"<40",1.524,77.110793,33.2005467205379 1031,183,79,46,4,4.59000015,"Louisa",40,"female",59,165,"medium",NA,NA,NA,NA,37,43,60,"<40",1.4986,74.8428285,33.3256581982857 1035,191,76,30,6.4000001,4.67000008,"Louisa",36,"male",69,183,"medium",100,66,NA,NA,36,40,225,"<40",1.7526,83.0075007,27.0241301005601 1036,213,83,47,4.5,3.41000009,"Louisa",33,"female",65,157,"medium",130,90,120,96,37,41,240,"<40",1.651,71.2140853,26.1259296991967 1037,255,78,38,6.69999981,4.32999992,"Louisa",50,"female",65,183,"medium",130,100,NA,NA,37,43,180,"40-50",1.651,83.0075007,30.4525167831401 1041,230,112,64,3.5999999,4.53000021,"Louisa",20,"male",67,159,"medium",100,90,NA,NA,31,39,1440,"<40",1.7018,72.1212711,24.9026940925345 1045,194,81,36,5.4000001,5.28000021,"Louisa",36,"male",64,126,"medium",110,76,NA,NA,30,34,120,"<40",1.6256,57.1527054,21.627653941343 1250,196,206,41,4.80000019,11.2399998,"Buckingham",62,"female",65,196,"large",178,90,NA,NA,46,51,540,"60-70",1.651,88.9042084,32.6158103251118 1252,186,97,50,3.70000005,6.48999977,"Buckingham",70,"male",67,178,"large",148,88,148,84,42,41,1020,"60-70",1.7018,80.7395362,27.8784877262336 1253,234,65,76,3.0999999,4.67000008,"Buckingham",47,"male",67,230,"large",137,100,149,110,45,46,480,"40-50",1.7018,104.326367,36.0227650395154 1254,203,299,43,4.69999981,12.7399998,"Buckingham",38,"female",69,288,"large",136,83,NA,NA,48,55,240,"<40",1.7526,130.6347552,42.5297785189143 1256,281,92,41,6.9000001,5.55999994,"Buckingham",66,"female",62,185,"large",158,88,160,88,48,44,285,"60-70",1.5748,83.9146865,33.8366348103664 1271,228,66,45,5.0999999,4.61000013,"Buckingham",24,"female",61,113,"medium",100,70,110,70,33,38,210,"<40",1.5494,51.2559977,21.3509689139776 1277,179,80,92,1.89999998,4.17999983,"Buckingham",41,"female",72,118,"small",144,112,NA,NA,28,36,780,"40-50",1.8288,53.5239622,16.0035315074488 1280,232,87,30,7.69999981,5.0999999,"Buckingham",37,"male",68,252,"large",140,95,NA,NA,43,47,420,"<40",1.7272,114.3054108,38.3161204773967 1281,NA,74,NA,NA,4.28000021,"Buckingham",48,"male",68,100,"small",120,85,NA,NA,27,33,510,"40-50",1.7272,45.35929,15.2048097132526 1282,254,84,52,4.9000001,4.51999998,"Buckingham",43,"female",62,145,"medium",125,70,NA,NA,31,38,720,"40-50",1.5748,65.7709705,26.5206056621791 1285,215,72,42,5.0999999,4.36999989,"Louisa",40,"male",70,189,"medium",180,122,170,112,37,39,450,"<40",1.778,85.7290581,27.1184297582881 1301,177,101,36,4.9000001,5.11000013,"Buckingham",42,"female",65,174,"medium",146,94,139,89,37,40,540,"40-50",1.651,78.9251646,28.9548520233135 1303,182,85,43,4.19999981,4.46999979,"Buckingham",52,"male",68,139,"large",130,90,NA,NA,29,35,780,"50-60",1.7272,63.0494131,21.1346855014212 1304,265,330,34,7.80000019,15.5200005,"Buckingham",61,"male",74,191,"medium",170,88,168,80,39,41,225,"60-70",1.8796,86.6362439,24.5227258250353 1305,182,85,37,4.9000001,5.65999985,"Buckingham",61,"female",69,174,"medium",176,86,180,90,49,43,330,"60-70",1.7526,78.9251646,25.6950745218441 1309,199,87,63,3.20000005,3.67000008,"Buckingham",25,"male",66,118,"medium",120,78,NA,NA,32,34,720,"<40",1.6764,53.5239622,19.0455250997738 1312,183,81,60,3.0999999,4.03000021,"Buckingham",47,"female",66,186,"medium",140,97,NA,NA,39,44,780,"40-50",1.6764,84.3682794,30.0209124454062 1313,194,86,67,2.9000001,2.68000007,"Buckingham",35,"male",66,159,"medium",115,64,NA,NA,31,35,720,"<40",1.6764,72.1212711,25.6630380581698 1314,190,107,32,5.9000001,3.55999994,"Buckingham",46,"male",72,205,"medium",NA,NA,NA,NA,46,49,240,"40-50",1.8288,92.9865445,27.8027454154831 1315,173,80,57,3,6.21000004,"Buckingham",57,"male",71,145,"medium",124,64,NA,NA,31,36,30,"50-60",1.8034,65.7709705,20.2232113004198 1316,182,206,43,4.19999981,7.90999985,"Buckingham",70,"male",69,214,"large",158,90,160,96,45,48,840,"60-70",1.7526,97.0688806,31.6019882050266 1317,136,81,51,2.70000005,4.57999992,"Buckingham",22,"female",66,160,"large",105,85,NA,NA,35,40,720,"<40",1.6764,72.574864,25.8244408132526 1321,218,68,46,4.69999981,3.8900001,"Buckingham",52,"female",62,170,"medium",142,79,NA,NA,40,43,720,"50-60",1.5748,77.110793,31.0931238797961 1323,225,83,42,5.4000001,4.38000011,"Buckingham",36,"male",67,192,"large",149,89,136,88,40,42,30,"<40",1.7018,87.0898368,30.0711777721172 1326,262,84,38,6.9000001,NA,"Buckingham",43,"male",75,253,"large",124,80,NA,NA,43,49,300,"40-50",1.905,114.7590037,31.6225442646441 1500,213,76,40,5.30000019,5.96000004,"Buckingham",72,"female",59,137,"large",130,60,NA,NA,40,40,90,">70",1.4986,62.1422273,27.6703949888796 1501,243,52,59,4.0999999,4.40999985,"Buckingham",37,"female",64,233,"medium",110,82,NA,NA,49,57,90,"<40",1.6256,105.6871457,39.9939949867693 1502,148,193,14,10.6000004,6.13999987,"Buckingham",54,"female",67,165,"medium",140,65,NA,NA,42,42,150,"50-60",1.7018,74.8428285,25.8424183979132 2004,128,223,24,5.30000019,10.8999996,"Buckingham",60,"male",67,196,"medium",110,68,NA,NA,42,43,450,"50-60",1.7018,88.9042084,30.6976606423696 2750,169,85,51,3.29999995,6.13999987,"Buckingham",40,"female",65,180,"medium",106,82,NA,NA,40,44,780,"<40",1.651,81.646722,29.9532951965312 2753,157,74,47,3.29999995,5.57000017,"Buckingham",55,"female",66,219,"medium",150,82,142,78,43,52,360,"50-60",1.6764,99.3368451,35.3472033631395 2754,196,82,58,3.4000001,4.25,"Buckingham",76,"male",65,154,NA,158,78,140,84,37,41,120,">70",1.651,69.8533066,25.6267081125878 2756,237,87,41,5.80000019,5.3499999,"Buckingham",43,"female",64,181,"medium",104,90,NA,NA,36,46,240,"40-50",1.6256,82.1003149,31.0682965347864 2757,212,97,45,4.69999981,6.32999992,"Buckingham",65,"female",61,187,"large",158,94,149,96,43,47,360,"60-70",1.5494,84.8218723,35.3330193532196 2758,233,92,39,6,4.55999994,"Buckingham",45,"female",64,167,"large",124,86,NA,NA,39,44,270,"40-50",1.6256,75.7500143,28.6652238746372 2762,289,111,50,5.80000019,9.39000034,"Buckingham",70,"female",60,220,"medium",126,80,NA,NA,51,54,780,"60-70",1.524,99.790438,42.965413403049 2763,193,106,63,3.0999999,6.3499999,"Buckingham",20,"female",68,274,"small",165,110,153,100,49,58,60,"<40",1.7272,124.2844546,41.6611786143123 2765,204,128,61,3.29999995,5.19999981,"Buckingham",62,"male",68,180,"large",141,81,NA,NA,38,41,540,"60-70",1.7272,81.646722,27.3686574838548 2770,165,94,69,2.4000001,4.98000002,"Buckingham",92,"female",62,217,"large",160,82,NA,NA,51,51,180,">70",1.5748,98.4296593,39.6894581289163 2773,237,233,58,4.0999999,13.6999998,"Buckingham",49,"female",62,189,"large",130,90,NA,NA,43,47,195,"40-50",1.5748,85.7290581,34.5682377251851 2774,218,88,39,5.5999999,NA,"Buckingham",44,"female",66,191,"large",138,79,NA,NA,40,45,720,"40-50",1.6764,86.6362439,30.8279262208203 2775,296,262,60,4.9000001,10.9300003,"Buckingham",74,"female",63,183,"large",159,99,160,103,42,48,300,">70",1.6002,83.0075007,32.4167002793567 2777,178,78,59,3,5.23000002,"Buckingham",36,"male",70,161,"medium",130,79,NA,NA,34,40,720,"<40",1.778,73.0284569,23.1008846089121 2778,443,185,23,19.2999992,14.3100004,"Buckingham",51,"female",70,235,"medium",158,98,148,88,43,48,420,"50-60",1.778,106.5943315,33.7186825036915 2780,145,85,29,5,3.99000001,"Buckingham",38,"female",NA,125,NA,NA,NA,NA,NA,31,35,120,"<40",NA,56.6991125,NA 2784,234,80,63,3.70000005,NA,"Buckingham",31,"male",70,165,"medium",121,71,NA,NA,35,39,720,"<40",1.778,74.8428285,23.6748196302515 2785,146,77,60,2.4000001,4.26999998,"Buckingham",28,"female",64,126,"small",120,90,NA,NA,28,32,180,"<40",1.6256,57.1527054,21.627653941343 2787,223,75,85,2.5999999,4.25,"Buckingham",22,"female",62,137,"medium",120,70,NA,NA,28,35,960,"<40",1.5748,62.1422273,25.0573998325416 2791,213,203,75,2.79999995,11.4099998,"Buckingham",71,"female",63,165,"medium",150,80,145,80,34,42,960,">70",1.6002,74.8428285,29.2281723830266 2793,173,131,69,2.5,4.44000006,"Buckingham",76,"female",61,102,"medium",160,60,160,60,31,33,1020,">70",1.5494,46.2664758,19.272556010847 2794,232,184,114,2,8.39999962,"Buckingham",91,"female",61,127,NA,170,82,NA,NA,35,38,120,">70",1.5494,57.6062983,23.9962216997801 2795,171,92,54,3.20000005,4.59000015,"Buckingham",40,"male",71,214,"medium",138,94,140,80,41,39,240,"<40",1.8034,97.0688806,29.8466704709644 3250,164,86,40,4.0999999,5.23000002,"Buckingham",23,"female",69,245,"large",126,75,NA,NA,44,47,420,"<40",1.7526,111.1302605,36.1798463094931 3750,170,69,64,2.70000005,4.38999987,"Buckingham",20,"female",64,161,"medium",108,70,NA,NA,37,40,120,"<40",1.6256,73.0284569,27.6353355917161 3751,180,84,69,2.5999999,5.19999981,"Buckingham",40,"female",68,264,"medium",142,98,130,92,43,54,240,"<40",1.7272,119.7485256,40.140697642987 3752,204,57,74,2.79999995,6.11000013,"Buckingham",52,"male",75,142,"small",140,90,NA,NA,31,35,300,"50-60",1.905,64.4101918,17.7486216821323 4000,209,113,65,3.20000005,7.44000006,"Buckingham",76,"female",60,143,"large",156,78,144,76,35,40,1200,">70",1.524,64.8637847,27.9275187119819 4500,242,108,53,4.5999999,5.46999979,"Buckingham",46,"female",62,183,"medium",130,86,NA,NA,37,45,180,"40-50",1.5748,83.0075007,33.470833352957 4501,134,105,42,3.20000005,4.28999996,"Buckingham",48,"male",70,173,"large",178,120,182,110,36,40,240,"40-50",1.778,78.4715717,24.8226896729304 4506,217,81,60,3.5999999,3.93000007,"Buckingham",22,"female",71,223,"medium",120,75,NA,NA,46,50,210,"<40",1.8034,101.1512167,31.1019042758181 4515,251,94,36,7,6.96000004,"Buckingham",58,"female",63,154,"large",174,75,NA,NA,38,41,180,"50-60",1.6002,69.8533066,27.2796275574914 4517,217,88,40,5.4000001,4.84000015,"Buckingham",34,"male",73,219,"medium",145,100,NA,NA,41,42,270,"<40",1.8542,99.3368451,28.8933041564713 4750,300,103,44,6.80000019,5.17999983,"Louisa",61,"female",67,169,"small",138,78,NA,NA,40,44,10,"60-70",1.7018,76.6572001,26.4689012681656 4751,218,87,38,5.69999981,5.51999998,"Louisa",40,"male",73,200,"small",120,76,NA,NA,38,41,210,"<40",1.8542,90.71858,26.38657913833 4753,189,96,47,4,4.38000011,"Louisa",28,"female",64,200,"medium",136,52,NA,NA,38,45,60,"<40",1.6256,90.71858,34.3296094307032 4758,185,84,52,3.5999999,5.28000021,"Louisa",53,"female",61,145,"medium",147,72,NA,NA,37,40,420,"50-60",1.5494,65.7709705,27.397260995812 4759,206,85,46,4.5,4.82000017,"Louisa",67,"male",67,178,"large",119,68,NA,NA,37,41,780,"60-70",1.7018,80.7395362,27.8784877262336 4760,218,182,54,4,10.5500002,"Louisa",51,"female",NA,215,"large",139,69,NA,NA,42,53,720,"50-60",NA,97.5224735,NA 4761,189,75,72,2.5999999,4.86000013,"Louisa",49,"female",62,205,"medium",120,80,NA,NA,40,49,840,"40-50",1.5748,92.9865445,37.4946493844601 4763,229,95,74,3.0999999,4.86000013,"Louisa",65,"female",62,151,"medium",125,64,NA,NA,37,42,660,"60-70",1.5748,68.4925279,27.6180100344072 4767,228,76,53,4.30000019,4.11000013,"Louisa",54,"male",66,170,"large",121,62,NA,NA,36,41,420,"50-60",1.6764,77.110793,27.4384683640809 4770,159,88,43,3.70000005,5.01999998,"Louisa",38,"male",68,169,"large",138,79,NA,NA,34,40,690,"<40",1.7272,76.6572001,25.696128415397 4771,249,197,44,5.69999981,9.17000008,"Louisa",64,"female",63,159,"medium",151,85,148,79,33,41,1140,"60-70",1.6002,72.1212711,28.1653297509165 4772,170,106,42,4,5.11000013,"Louisa",41,"female",61,110,"small",103,64,NA,NA,29,30,120,"40-50",1.5494,49.895219,20.7841290313056 4776,174,125,44,4,5.07000017,"Louisa",67,"male",68,198,"large",119,72,NA,NA,36,43,60,"60-70",1.7272,89.8113942,30.1055232322402 4780,204,62,70,2.9000001,4.84000015,"Louisa",27,"female",67,185,"medium",110,90,NA,NA,35,44,10,"<40",1.7018,83.9146865,28.9748327491754 4783,203,84,75,2.70000005,4.0999999,"Louisa",21,"female",63,142,"medium",125,85,117,68,28,39,900,"<40",1.6002,64.4101918,25.1539422932713 4786,241,86,63,3.79999995,4.78999996,"Louisa",41,"female",59,139,"medium",112,72,NA,NA,29,39,1560,"40-50",1.4986,63.0494131,28.07434236098 4787,245,120,39,6.30000019,7.78999996,"Louisa",47,"female",63,156,"medium",142,102,156,106,35,39,120,"40-50",1.6002,70.7604924,27.6339084348615 4789,143,91,37,3.9000001,5.1500001,"Louisa",61,"female",65,220,"large",160,92,150,98,40,50,20,"60-70",1.651,99.790438,36.6095830179826 4790,224,341,33,6.80000019,10.1499996,"Louisa",65,"male",67,197,"medium",160,80,158,80,42,43,390,"60-70",1.7018,89.3578013,30.8542813599327 4792,168,69,45,3.70000005,4.17000008,"Louisa",28,"female",63,200,"large",111,65,NA,NA,42,46,780,"<40",1.6002,90.71858,35.4280877370019 4793,184,79,39,4.69999981,4.05000019,"Louisa",41,"male",69,154,"large",136,96,130,94,34,39,600,"40-50",1.7526,69.8533066,22.7416176802528 4794,199,130,48,4.0999999,5.44000006,"Louisa",37,"female",61,203,"large",136,84,NA,NA,42,51,10,"<40",1.5494,92.0793587,38.3561653941368 4795,158,91,48,3.29999995,4.30999994,"Louisa",50,"male",71,180,"medium",136,90,126,84,36,40,45,"40-50",1.8034,81.646722,25.1046760970729 4796,209,176,55,3.79999995,9.77000046,"Louisa",57,"female",61,150,"small",115,68,NA,NA,36,39,780,"50-60",1.5494,68.038935,28.3419941335986 4801,214,111,59,3.5999999,3.8900001,"Louisa",28,"male",68,204,"medium",130,90,NA,NA,40,41,60,"<40",1.7272,92.5329516,31.0178118150354 4802,293,85,94,3.0999999,5.17000008,"Louisa",31,"female",67,200,"medium",110,90,NA,NA,41,42,240,"<40",1.7018,90.71858,31.3241435126221 4803,227,105,44,5.19999981,5.71000004,"Louisa",83,"female",59,125,"medium",150,90,156,88,35,40,300,">70",1.4986,56.6991125,25.246710756277 4805,292,235,55,5.30000019,7.86999989,"Buckingham",79,"male",70,165,NA,170,90,170,100,39,41,240,">70",1.778,74.8428285,23.6748196302515 4808,218,80,71,3.0999999,NA,"Buckingham",68,"male",70,170,"large",130,73,NA,NA,37,42,720,"60-70",1.778,77.110793,24.3922384069258 4813,244,101,36,6.80000019,4.65999985,"Buckingham",32,"male",70,212,NA,132,90,NA,NA,39,44,NA,"<40",1.778,96.1616948,30.4185561309898 4818,283,83,74,3.79999995,4.21999979,"Louisa",26,"male",72,227,"large",158,104,158,108,41,44,330,"<40",1.8288,102.9655883,30.7864546795837 4821,186,74,76,2.4000001,5.17000008,"Louisa",36,"male",69,150,"small",138,82,NA,NA,31,38,60,"<40",1.7526,68.038935,22.1509263119345 4822,273,94,49,5.5999999,3.75999999,"Louisa",53,"female",64,174,"medium",160,96,162,96,34,43,30,"50-60",1.6256,78.9251646,29.8667602047118 4823,193,77,49,3.9000001,4.30999994,"Louisa",19,"female",61,119,"small",118,70,NA,NA,32,38,300,"<40",1.5494,53.9775551,22.4846486793215 4825,194,80,34,5.69999981,4.61000013,"Buckingham",63,"male",73,175,"medium",131,88,NA,NA,34,39,30,"60-70",1.8542,79.3787575,23.0882567460387 4826,231,105,61,3.79999995,NA,"Buckingham",58,"female",63,230,"large",141,99,NA,NA,39,48,30,"50-60",1.6002,104.326367,40.7423008975522 4827,217,78,48,4.5,NA,"Buckingham",53,"female",63,158,"medium",139,79,NA,NA,33,40,720,"50-60",1.6002,71.6676782,27.9881893122315 4833,174,173,34,5.0999999,5.3499999,"Buckingham",50,"male",70,263,"large",159,99,150,89,51,64,210,"40-50",1.778,119.2949327,37.7362276530676 4835,225,84,82,2.70000005,4.36000013,"Buckingham",41,"male",71,156,"small",150,80,NA,NA,31,40,120,"40-50",1.8034,70.7604924,21.7573859507965 4840,268,85,51,5.30000019,4.40999985,"Louisa",48,"male",70,120,"small",150,105,150,100,32,35,120,"40-50",1.778,54.431148,17.2180506401829 4841,195,108,46,4.19999981,8.44999981,"Louisa",59,"female",67,172,"small",150,102,150,100,38,43,300,"50-60",1.7018,78.0179788,26.938763420855 4842,179,70,52,3.4000001,3.98000002,"Louisa",34,"male",72,170,"medium",138,82,NA,NA,31,39,1170,"<40",1.8288,77.110793,23.0559352225958 4843,215,119,44,3.9000001,9.76000023,"Louisa",63,"female",63,158,"medium",160,68,158,74,34,42,240,"60-70",1.6002,71.6676782,27.9881893122315 10000,185,76,58,3.20000005,4.82999992,"Buckingham",23,"male",76,164,"small",124,78,NA,NA,32,40,720,"<40",1.9304,74.3892356,19.9625252401474 10001,132,99,34,3.9000001,4.01000023,"Buckingham",21,"female",65,169,"large",112,62,NA,NA,39,43,180,"<40",1.651,76.6572001,28.1228160456321 10012,175,91,42,4.19999981,3.83999991,"Louisa",23,"female",65,235,"medium",110,80,NA,NA,44,50,10,"<40",1.651,106.5943315,39.1056909510269 10014,179,81,35,5.0999999,4.94999981,"Buckingham",36,"female",63,125,"medium",110,76,NA,NA,33,36,240,"<40",1.6002,56.6991125,22.1425548356262 10016,228,115,61,3.70000005,6.38999987,"Buckingham",71,"female",63,244,"large",170,92,NA,NA,48,51,660,">70",1.6002,110.6766676,43.2222670391423 10020,181,177,24,7.5,7.53000021,"Buckingham",64,"male",71,225,"large",130,66,NA,NA,44,47,180,"60-70",1.8034,102.0584025,31.3808451213411 12002,160,100,36,4.4000001,4.61999989,"Louisa",43,"female",64,140,"small",180,110,210,110,37,40,225,"40-50",1.6256,63.503006,24.0307266014923 12004,188,77,45,4.19999981,4.78999996,"Louisa",31,"female",67,227,"medium",122,70,NA,NA,47,53,140,"<40",1.7018,102.9655883,35.552902886826 12005,168,101,59,2.79999995,5.09000015,"Louisa",44,"female",64,160,"small",130,88,NA,NA,40,43,60,"40-50",1.6256,72.574864,27.4636875445626 12006,318,270,108,2.9000001,6.51000023,"Louisa",60,"female",65,167,"medium",132,72,NA,NA,38,44,30,"50-60",1.651,75.7500143,27.7900016545595 12501,192,109,44,4.4000001,4.86000013,"Buckingham",43,"female",64,325,"large",141,79,NA,NA,53,62,60,"40-50",1.6256,147.4176925,55.7856153248928 12502,209,87,34,6.0999999,4.40999985,"Buckingham",48,"female",63,121,"small",111,62,NA,NA,32,38,855,"40-50",1.6002,54.8847409,21.4339930808861 12506,129,110,42,3.0999999,6.13000011,"Buckingham",56,"male",74,151,"small",140,75,NA,NA,34,38,90,"50-60",1.8796,68.4925279,19.3870764375933 12507,160,122,41,3.9000001,6.48999977,"Buckingham",55,"female",67,223,"medium",136,83,NA,NA,43,48,960,"50-60",1.7018,101.1512167,34.9264200165736 12509,160,196,33,4.80000019,7.51000023,"Buckingham",49,"male",71,266,"large",150,98,NA,NA,49,45,90,"40-50",1.8034,120.6557114,37.0991324545633 12751,211,48,34,6.19999981,6.96999979,"Louisa",58,"male",67,177,"medium",162,78,156,82,38,43,315,"50-60",1.7018,80.2859433,27.7218670086705 12754,262,93,43,6.0999999,4.9000001,"Louisa",33,"female",63,170,"medium",110,68,NA,NA,33,46,210,"<40",1.6002,77.110793,30.1138745764516 12760,201,81,87,2.29999995,4.80999994,"Buckingham",48,"female",68,146,"small",145,95,NA,NA,32,41,600,"40-50",1.7272,66.2245634,22.1990221813489 12761,263,82,92,2.9000001,4.57999992,"Buckingham",66,"female",66,121,"small",104,64,NA,NA,31,33,30,"60-70",1.6764,54.8847409,19.5297333650223 12763,219,112,73,3,9.18000031,"Buckingham",59,"male",66,170,"medium",146,92,168,98,37,40,120,"50-60",1.6764,77.110793,27.4384683640809 12765,191,83,88,2.20000005,5.46000004,"Buckingham",45,"female",67,151,"small",130,90,NA,NA,33,38,1320,"40-50",1.7018,68.4925279,23.6497283520297 12766,171,97,69,2.5,4.03999996,"Buckingham",52,"male",71,159,"small",125,72,NA,NA,33,39,750,"50-60",1.8034,72.1212711,22.1757972190811 12768,219,112,73,3,5.23000002,"Buckingham",76,"male",64,105,"medium",125,82,NA,NA,29,33,60,">70",1.6256,47.6272545,18.0230449511192 12769,347,197,42,8.30000019,6.34000015,"Buckingham",36,"male",70,277,"large",140,86,NA,NA,51,49,900,"<40",1.778,125.6452333,39.7450002277556 12772,269,73,34,7.9000001,5.36999989,"Buckingham",41,"female",62,160,"medium",126,90,NA,NA,39,41,390,"40-50",1.5748,72.574864,29.2641165927493 12778,164,71,63,2.5999999,4.51000023,"Buckingham",20,"male",72,145,"small",108,78,NA,NA,29,36,1080,"<40",1.8288,65.7709705,19.6653565133905 13250,181,255,26,7,9.57999992,"Buckingham",50,"male",71,320,"large",140,86,NA,NA,56,49,30,"40-50",1.8034,145.149728,44.6305352836851 13254,190,84,44,4.30000019,5.55000019,"Buckingham",43,"female",62,163,"large",135,88,NA,NA,40,45,720,"40-50",1.5748,73.9356427,29.8128187788634 13500,255,112,34,7.5,5.5999999,"Louisa",82,"male",66,163,NA,179,89,172,91,37,43,60,">70",1.6764,73.9356427,26.3086490785011 13501,218,126,32,6.80000019,4.86999989,"Louisa",35,"male",69,169,"medium",139,90,136,86,39,41,720,"<40",1.7526,76.6572001,24.9567103114462 13503,223,90,48,4.5999999,5.5999999,"Buckingham",47,"female",65,232,"large",120,86,NA,NA,46,54,900,"40-50",1.651,105.2335528,38.606469364418 13505,254,342,37,6.9000001,12.9700003,"Buckingham",75,"male",68,210,"large",151,87,NA,NA,44,45,15,">70",1.7272,95.254509,31.9301003978306 14756,236,102,36,6.5999999,5.63000011,"Buckingham",62,"male",76,160,"large",150,80,NA,NA,35,39,270,"60-70",1.9304,72.574864,19.4756343806316 14758,176,92,55,3.20000005,4.5,"Buckingham",31,"female",62,145,"small",110,72,NA,NA,36,42,720,"<40",1.5748,65.7709705,26.5206056621791 15007,158,91,31,5.0999999,5.55999994,"Louisa",50,"male",70,215,"large",138,89,137,79,40,45,720,"40-50",1.778,97.5224735,30.8490073969944 15008,181,83,44,4.0999999,4.03000021,"Louisa",39,"female",66,255,"medium",140,98,NA,NA,46,54,210,"<40",1.6764,115.6661895,41.1577025461213 15010,151,85,48,3.0999999,4.38000011,"Louisa",33,"male",69,308,"large",110,90,NA,NA,52,58,300,"<40",1.7526,139.7066132,45.4832353605056 15012,115,239,36,3.20000005,13.6000004,"Louisa",58,"male",69,NA,"medium",125,69,NA,NA,30,37,10,"50-60",1.7526,NA,NA 15013,271,121,40,6.80000019,4.57000017,"Louisa",81,"female",64,158,"medium",146,76,NA,NA,36,43,10,">70",1.6256,71.6676782,27.1203914502556 15016,190,92,44,4.30000019,4.65999985,"Louisa",27,"female",65,210,"medium",150,106,160,116,39,47,60,"<40",1.651,95.254509,34.9455110626198 15017,118,95,39,3,4.71000004,"Louisa",47,"female",64,123,"small",140,76,NA,NA,30,36,300,"40-50",1.6256,55.7919267,21.1127097998825 15250,168,82,44,3.79999995,4.4000001,"Buckingham",33,"female",66,118,"small",98,66,NA,NA,29,35,150,"<40",1.6764,53.5239622,19.0455250997738 15252,254,121,39,6.5,9.25,"Buckingham",67,"male",68,167,"large",161,118,151,111,36,39,60,"60-70",1.7272,75.7500143,25.3920322211319 15260,193,77,45,4.30000019,4.73999977,"Buckingham",42,"female",75,186,"medium",125,90,NA,NA,37,46,60,"40-50",1.905,84.3682794,23.2481945977225 15264,187,84,64,2.9000001,4.4000001,"Buckingham",21,"female",63,158,"small",138,88,NA,NA,39,43,180,"<40",1.6002,71.6676782,27.9881893122315 15271,212,79,49,4.30000019,5.48999977,"Buckingham",51,"female",65,145,"small",230,120,235,120,38,42,60,"50-60",1.651,65.7709705,24.1290433527613 15274,170,76,60,2.79999995,3.44000006,"Buckingham",27,"female",63,119,"small",122,86,NA,NA,28,37,270,"<40",1.6002,53.9775551,21.0797122035161 15276,215,110,36,6,9.81999969,"Louisa",51,"female",67,282,"medium",142,78,136,84,52,59,420,"50-60",1.7018,127.9131978,44.1670423527971 15277,199,85,59,3.4000001,4.96000004,"Louisa",71,"male",69,171,"large",136,86,NA,NA,38,40,240,">70",1.7526,77.5643859,25.2520559956054 15278,140,385,31,4.5,11.5900002,"Louisa",50,"male",69,172,"large",138,66,NA,NA,37,41,210,"40-50",1.7526,78.0179788,25.3997288376849 15279,216,79,46,4.69999981,4.40999985,"Louisa",54,"female",65,138,"small",132,80,NA,NA,33,39,990,"50-60",1.651,62.5958202,22.9641929840073 15500,204,113,35,5.80000019,4.44000006,"Buckingham",59,"male",73,187,"medium",148,76,148,78,38,37,90,"50-60",1.8542,84.8218723,24.6714514943385 15501,193,248,24,8,7.13999987,"Buckingham",59,"female",66,189,"medium",140,90,NA,NA,38,45,90,"50-60",1.6764,85.7290581,30.5051207106546 15502,267,133,34,7.9000001,8.81000042,"Louisa",40,"female",59,204,"small",118,69,NA,NA,40,47,780,"<40",1.4986,92.5329516,41.2026319542441 15512,201,106,53,3.79999995,5.3499999,"Louisa",58,"male",66,215,"large",186,102,190,110,46,44,360,"50-60",1.6764,97.5224735,34.7015923428082 15513,204,120,44,4.5999999,4.69000006,"Louisa",72,"male",65,167,"large",140,72,NA,NA,45,46,480,">70",1.651,75.7500143,27.7900016545595 15514,246,104,62,4,7.4000001,"Louisa",66,"female",66,189,"medium",200,94,208,90,45,46,195,"60-70",1.6764,85.7290581,30.5051207106546 15515,229,91,43,5.30000019,4.73000002,"Louisa",23,"male",72,180,"small",110,78,NA,NA,34,41,60,"<40",1.8288,81.646722,24.4121667062779 15516,172,101,46,3.70000005,4.51999998,"Louisa",42,"female",65,165,"small",118,68,NA,NA,33,45,150,"40-50",1.651,74.8428285,27.457187263487 15517,197,120,37,5.30000019,4.94999981,"Louisa",43,"male",71,179,"medium",146,98,136,96,37,44,30,"40-50",1.8034,81.1931291,24.9652056743114 15518,205,79,32,6.4000001,4.21000004,"Louisa",75,"male",69,204,"large",136,90,NA,NA,44,42,120,">70",1.7526,92.5329516,30.125259784231 15519,219,106,50,4.4000001,4.55999994,"Louisa",65,"female",63,233,"large",140,90,136,86,40,53,45,"60-70",1.6002,105.6871457,41.2737222136072 15520,174,90,36,4.80000019,5.3499999,"Louisa",34,"male",71,210,"medium",142,92,148,98,37,43,90,"<40",1.8034,95.254509,29.2887887799184 15521,192,89,30,6.4000001,4.03999996,"Louisa",37,"male",71,195,"medium",136,96,130,98,36,43,630,"<40",1.8034,88.4506155,27.1967324384956 15522,206,94,44,4.69999981,5.48999977,"Louisa",61,"female",63,199,"medium",180,96,176,94,41,47,720,"60-70",1.6002,90.2649871,35.2509472983169 15527,160,71,44,3.5999999,4.63999987,"Louisa",36,"female",64,185,"medium",110,80,NA,NA,39,45,300,"<40",1.6256,83.9146865,31.7548887234005 15529,216,109,86,2.5,4.4000001,"Louisa",45,"female",67,147,"medium",140,102,148,102,32,38,80,"40-50",1.7018,66.6781563,23.0232454817772 15540,236,111,82,2.9000001,5.23999977,"Louisa",68,"female",61,119,"small",142,96,140,86,29,37,135,"60-70",1.5494,53.9775551,22.4846486793215 15542,205,88,41,5,NA,"Louisa",57,"male",66,171,"medium",132,82,NA,NA,37,40,210,"50-60",1.6764,77.5643859,27.5998711191637 15545,206,112,33,6.19999981,4.03000021,"Louisa",41,"female",62,184,"small",104,80,NA,NA,39,44,10,"40-50",1.5748,83.4610936,33.6537340816617 15546,143,371,46,3.0999999,4.80999994,"Louisa",68,"male",67,158,"small",138,82,NA,NA,37,43,90,"60-70",1.7018,71.6676782,24.7460733749714 15757,173,83,37,4.69999981,4.30999994,"Buckingham",40,"female",NA,130,"small",122,76,NA,NA,37,38,360,"<40",NA,58.967077,NA 15758,235,91,37,6.4000001,5.23000002,"Buckingham",79,"female",65,134,"small",142,70,NA,NA,34,38,240,">70",1.651,60.7814486,22.2985642018621 15760,169,95,29,5.80000019,5.21999979,"Buckingham",62,"male",66,251,"large",118,72,NA,NA,50,47,720,"60-70",1.6764,113.8518179,40.51209152579 15761,283,145,39,7.30000019,8.25,"Buckingham",63,"female",61,200,"medium",190,110,170,90,44,48,720,"60-70",1.5494,90.71858,37.7893255114648 15762,174,93,77,2.29999995,4.94999981,"Buckingham",55,"male",70,140,"medium",118,86,NA,NA,32,33,120,"50-60",1.778,63.503006,20.0877257468801 15763,271,103,90,3,4.01000023,"Buckingham",55,"female",63,114,"small",180,105,165,105,30,37,15,"50-60",1.6002,51.7095906,20.1940100100911 15766,203,94,62,3.29999995,4.67000008,"Buckingham",27,"female",67,209,"medium",140,80,NA,NA,34,43,780,"<40",1.7018,94.8009161,32.7337299706901 15773,188,174,24,7.80000019,6.17000008,"Louisa",66,"male",68,210,"large",160,78,158,84,45,48,60,"60-70",1.7272,95.254509,31.9301003978306 15777,293,87,120,2.4000001,4.76000023,"Louisa",63,"female",64,179,"medium",142,80,142,90,47,45,30,"60-70",1.6256,81.1931291,30.7250004404794 15779,215,80,100,2.20000005,4.65999985,"Louisa",78,"male",65,109,"small",170,88,180,100,33,34,435,">70",1.651,49.4416261,18.138384313455 15782,207,77,46,4.5,4.82000017,"Buckingham",68,"male",55,130,"small",199,115,190,99,29,33,120,"60-70",1.397,58.967077,30.2145957515056 15787,179,77,72,2.5,4.96999979,"Buckingham",31,"male",66,145,"medium",131,79,NA,NA,33,38,150,"<40",1.6764,65.7709705,23.4033994870102 15792,202,81,55,3.70000005,5.5,"Buckingham",64,"female",62,167,"medium",190,118,NA,NA,44,47,120,"60-70",1.5748,75.7500143,30.5444216936821 15795,211,98,40,5.30000019,3.54999995,"Buckingham",40,"female",68,179,"small",110,76,NA,NA,37,43,60,"<40",1.7272,81.1931291,27.2166093867222 15797,211,225,29,7.30000019,10.0900002,"Buckingham",61,"female",63,144,"medium",190,100,170,86,40,42,120,"60-70",1.6002,65.3173776,25.5082231706414 15798,151,74,47,3.20000005,4.01000023,"Buckingham",28,"male",69,130,"small",135,75,NA,NA,29,35,720,"<40",1.7526,58.967077,19.1974694703433 15799,171,85,61,2.79999995,5.0999999,"Buckingham",34,"female",63,164,"medium",120,80,NA,NA,34,43,60,"<40",1.6002,74.3892356,29.0510319443415 15800,342,251,48,7.0999999,12.6700001,"Buckingham",63,"female",65,201,"medium",178,88,160,82,45,46,180,"60-70",1.651,91.1721729,33.4478463027932 15801,179,236,63,2.79999995,12.0699997,"Buckingham",55,"male",75,186,"medium",122,74,NA,NA,38,38,180,"50-60",1.905,84.3682794,23.2481945977225 15802,155,58,69,2.20000005,4.17000008,"Buckingham",26,"male",73,174,"small",110,76,NA,NA,30,35,180,"<40",1.8542,78.9251646,22.9563238503471 15805,197,92,46,4.30000019,4.75,"Buckingham",36,"female",64,136,"small",NA,NA,NA,NA,32,37,NA,"<40",1.6256,61.6886344,23.3441344128782 15812,200,56,51,3.9000001,3.54999995,"Buckingham",40,"female",62,105,"small",125,64,NA,NA,26,33,720,"<40",1.5748,47.6272545,19.2045765139917 15813,237,96,52,4.5999999,NA,"Buckingham",45,"male",69,130,"small",137,74,NA,NA,33,35,720,"40-50",1.7526,58.967077,19.1974694703433 15814,198,118,46,4.30000019,4.44000006,"Buckingham",68,"female",63,124,"medium",130,70,NA,NA,32,38,60,"60-70",1.6002,56.2455196,21.9654143969412 15815,240,88,49,4.9000001,4.92000008,"Buckingham",82,"female",63,170,"medium",180,86,NA,NA,41,46,720,">70",1.6002,77.110793,30.1138745764516 15816,192,56,42,4.5999999,4.59000015,"Buckingham",60,"female",62,134,"small",130,70,NA,NA,31,40,90,"50-60",1.5748,60.7814486,24.5086976464276 15818,145,84,54,2.70000005,4.73000002,"Buckingham",30,"female",65,165,"small",102,56,NA,NA,33,42,720,"<40",1.651,74.8428285,27.457187263487 15820,269,59,66,4.0999999,5.13999987,"Buckingham",41,"male",67,191,"large",130,73,NA,NA,38,41,240,"40-50",1.7018,86.6362439,29.9145570545541 15821,240,96,57,4.19999981,5.73999977,"Buckingham",54,"female",65,175,"medium",152,100,140,100,37,43,60,"50-60",1.651,79.3787575,29.1212592188498 15827,205,83,42,4.9000001,4.86999989,"Buckingham",72,"female",61,180,NA,170,90,150,100,39,47,240,">70",1.5494,81.646722,34.0103929603183 15828,266,82,54,4.9000001,5.40999985,"Buckingham",47,"male",68,142,"medium",118,78,NA,NA,35,39,120,"40-50",1.7272,64.4101918,21.5908297928188 16000,188,88,51,3.70000005,5.13000011,"Buckingham",50,"female",61,147,"large",160,66,150,80,34,41,720,"40-50",1.5494,66.6781563,27.7751542509266 16001,222,82,87,2.5999999,4.63999987,"Buckingham",51,"female",66,110,"small",150,110,150,90,28,37,270,"50-60",1.6764,49.895219,17.7543030591112 16003,142,155,25,5.69999981,6.96000004,"Buckingham",45,"male",69,204,"large",165,115,160,96,40,43,720,"40-50",1.7526,92.5329516,30.125259784231 16004,268,90,48,5.5999999,5.36000013,"Buckingham",38,"female",63,181,"medium",142,100,144,110,38,46,210,"<40",1.6002,82.1003149,32.0624194019867 16005,174,105,117,1.5,5.53000021,"Buckingham",20,"male",70,187,"medium",132,86,NA,NA,37,41,210,"<40",1.778,84.8218723,26.8314622476184 16016,214,87,35,6.0999999,5.38000011,"Buckingham",44,"female",NA,190,"large",140,75,NA,NA,38,44,720,"40-50",NA,86.182651,NA 17002,194,54,57,3.4000001,4.26000023,"Louisa",63,"male",70,181,"large",184,76,180,84,37,42,60,"60-70",1.778,82.1003149,25.9705597156092 17751,196,115,62,3.20000005,4.34000015,"Louisa",50,"male",67,140,"medium",176,110,150,102,35,37,60,"40-50",1.7018,63.503006,21.9269004588354 17752,207,187,46,4.5,8.56999969,"Louisa",44,"female",67,201,"large",150,74,146,76,46,49,30,"40-50",1.7018,91.1721729,31.4807642301852 17754,204,89,56,3.5999999,5.01999998,"Louisa",48,"male",68,196,"medium",170,96,178,96,38,42,90,"40-50",1.7272,88.9042084,29.8014270379752 17755,189,84,46,4.0999999,4.36000013,"Louisa",41,"female",63,153,"medium",130,80,NA,NA,32,40,15,"40-50",1.6002,69.3997137,27.1024871188064 17756,179,77,50,3.5999999,3.32999992,"Buckingham",29,"male",68,170,"small",122,68,NA,NA,38,39,300,"<40",1.7272,77.110793,25.8481765125295 17757,159,100,54,2.9000001,4.17999983,"Buckingham",76,"male",66,188,"large",116,53,NA,NA,40,41,180,">70",1.6764,85.2754652,30.3437179555718 17760,260,68,60,4.30000019,4.78000021,"Buckingham",69,"female",59,179,"large",158,98,159,80,45,48,180,"60-70",1.4986,81.1931291,36.1532898029887 17762,228,79,37,6.19999981,4.73999977,"Buckingham",26,"male",72,259,"large",122,90,NA,NA,48,49,720,"<40",1.8288,117.4805611,35.1263954273665 17765,242,74,55,4.4000001,3.97000003,"Buckingham",70,"female",66,200,"medium",140,65,NA,NA,41,47,180,"60-70",1.6764,90.71858,32.2805510165658 17766,227,98,66,3.4000001,6.42000008,"Buckingham",25,"male",71,162,"medium",123,82,NA,NA,35,39,900,"<40",1.8034,73.4820498,22.5942084873656 17767,208,122,51,4.0999999,6.48000002,"Buckingham",42,"female",62,141,"large",118,78,NA,NA,33,40,720,"40-50",1.5748,63.9565989,25.7890027473603 17771,208,95,32,6.5,5.5999999,"Buckingham",56,"male",68,183,"medium",131,75,NA,NA,36,39,20,"50-60",1.7272,83.0075007,27.8248017752523 17772,209,89,43,4.9000001,4.8499999,"Buckingham",31,"female",67,160,"medium",108,58,NA,NA,30,44,240,"<40",1.7018,72.574864,25.0593148100977 17773,163,83,57,2.9000001,4.61000013,"Buckingham",31,"female",65,120,"small",136,86,NA,NA,29,40,240,"<40",1.651,54.431148,19.9688634643541 17776,201,100,46,4.4000001,4.0999999,"Buckingham",27,"female",65,145,"small",121,75,NA,NA,32,35,60,"<40",1.651,65.7709705,24.1290433527613 17781,237,118,45,5.30000019,7.51000023,"Buckingham",73,"female",64,174,"large",162,75,NA,NA,38,44,300,">70",1.6256,78.9251646,29.8667602047118 17784,176,90,34,5.19999981,4.23999977,"Buckingham",32,"female",63,252,"medium",100,72,NA,NA,45,58,180,"<40",1.6002,114.3054108,44.6393905486224 17790,146,79,41,3.5999999,4.76000023,"Buckingham",19,"female",60,135,"medium",108,58,NA,NA,33,40,240,"<40",1.524,61.2350415,26.3651400427801 17791,231,70,110,2.0999999,3.75,"Buckingham",71,"female",63,155,"small",150,78,NA,NA,33,41,900,">70",1.6002,70.3068995,27.4567679961765 17794,241,92,40,6,5.03999996,"Buckingham",27,"female",63,179,"medium",120,75,NA,NA,40,42,720,"<40",1.6002,81.1931291,31.7081385246167 17795,305,91,44,6.9000001,5.34000015,"Buckingham",31,"male",71,211,"large",100,60,NA,NA,40,45,540,"<40",1.8034,95.7081019,29.4282592026799 17800,149,77,49,3,4.5,"Buckingham",20,"female",62,115,"small",105,82,NA,NA,31,37,720,"<40",1.5748,52.1631835,21.0335838010386 17802,183,69,51,3.5999999,4.36999989,"Buckingham",31,"female",66,190,"medium",125,70,NA,NA,41,47,720,"<40",1.6764,86.182651,30.6665234657375 17805,235,109,59,4,7.48000002,"Buckingham",62,"female",63,290,"large",175,80,152,102,55,62,300,"60-70",1.6002,131.541941,51.3707272186527 17808,244,101,39,6.30000019,4.36000013,"Buckingham",44,"male",71,168,"medium",140,89,NA,NA,36,39,720,"40-50",1.8034,76.2036072,23.4310310239347 17813,199,153,77,2.5999999,4.73999977,"Buckingham",36,"female",66,255,"large",118,66,NA,NA,47,52,360,"<40",1.6764,115.6661895,41.1577025461213 17814,224,85,30,7.5,5.26000023,"Buckingham",36,"male",69,205,"medium",150,99,130,80,37,41,360,"<40",1.7526,92.9865445,30.2729326263105 17816,173,225,31,5.5999999,10.4700003,"Buckingham",47,"male",73,260,"medium",150,98,142,90,42,47,60,"40-50",1.8542,117.934154,34.302552879829 17817,192,124,31,5.5999999,5.17000008,"Buckingham",30,"male",72,250,"medium",142,79,NA,NA,43,51,120,"<40",1.8288,113.398225,33.9057870920526 17818,157,91,34,4.5999999,5.69999981,"Buckingham",63,"male",69,166,"large",106,82,NA,NA,39,38,420,"60-70",1.7526,75.2964214,24.5136917852076 17819,172,117,56,3.0999999,3.58999991,"Buckingham",48,"female",63,170,"medium",130,82,NA,NA,35,42,240,"40-50",1.6002,77.110793,30.1138745764516 17828,170,67,33,5.19999981,6.42000008,"Buckingham",65,"male",69,182,"large",140,65,NA,NA,42,39,270,"60-70",1.7526,82.5539078,26.8764572584806 17829,215,97,46,4.69999981,5.03000021,"Buckingham",59,"female",63,176,"large",140,70,NA,NA,34,44,60,"50-60",1.6002,79.8323504,31.1767172085617 17830,214,67,47,4.5999999,4.40999985,"Buckingham",37,"female",64,145,"medium",108,76,NA,NA,34,42,90,"<40",1.6256,65.7709705,24.8889668372598 17834,195,171,29,6.69999981,5.67999983,"Buckingham",78,"male",66,172,"large",130,82,NA,NA,40,40,60,">70",1.6764,78.0179788,27.7612738742466 17835,230,86,37,6.19999981,4.38999987,"Buckingham",23,"male",71,277,"large",150,99,150,85,50,49,840,"<40",1.8034,125.6452333,38.6333071049399 17841,206,90,38,5.4000001,4.07000017,"Buckingham",38,"female",69,167,"medium",138,90,NA,NA,36,47,90,"<40",1.7526,75.7500143,24.6613646272871 17846,147,86,34,4.30000019,4.61999989,"Buckingham",38,"male",69,205,"small",130,96,130,90,39,41,480,"<40",1.7526,92.9865445,30.2729326263105 17849,234,78,54,4.30000019,3.70000005,"Buckingham",41,"male",67,183,"medium",122,96,126,96,38,40,NA,"40-50",1.7018,83.0075007,28.6615913140492 20254,135,88,34,4,3.96000004,"Buckingham",29,"female",65,123,"small",118,61,NA,NA,26,37,240,"<40",1.651,55.7919267,20.468085050963 20258,226,68,83,2.70000005,NA,"Buckingham",49,"female",63,128,"small",121,75,NA,NA,31,36,720,"40-50",1.6002,58.0598912,22.6739761516812 20260,179,75,36,5,4.75,"Buckingham",23,"female",65,183,"medium",120,80,NA,NA,43,45,720,"<40",1.651,83.0075007,30.4525167831401 20261,163,69,48,3.4000001,4.30999994,"Buckingham",29,"female",62,99,"small",125,60,NA,NA,30,36,720,"<40",1.5748,44.9056971,18.1071721417636 20267,191,74,33,5.80000019,5.3499999,"Louisa",40,"male",72,270,"large",136,70,NA,NA,45,49,150,"<40",1.8288,122.470083,36.6182500594168 20271,138,95,40,3.5,4.80000019,"Louisa",38,"female",60,138,"small",140,90,NA,NA,31,39,330,"<40",1.524,62.5958202,26.9510320437308 20272,184,92,36,5.0999999,4.80999994,"Louisa",40,"female",63,285,"large",142,98,142,96,50,60,690,"<40",1.6002,129.2739765,50.4850250252277 20274,181,101,44,4.0999999,4.88000011,"Louisa",29,"male",68,180,"medium",130,78,NA,NA,38,42,720,"<40",1.7272,81.646722,27.3686574838548 20275,224,98,44,5.0999999,5.05000019,"Louisa",78,"female",63,160,"large",150,81,NA,NA,36,45,300,">70",1.6002,72.574864,28.3424701896015 20278,293,115,54,5.4000001,4.86999989,"Buckingham",50,"male",71,170,"medium",131,75,NA,NA,34,39,120,"40-50",1.8034,77.110793,23.7099718694577 20279,147,78,42,3.5,4.67000008,"Buckingham",23,"female",61,185,NA,127,71,NA,NA,43,47,600,"<40",1.5494,83.9146865,34.9551260981049 20288,198,92,62,3.20000005,4.42999983,"Louisa",60,"male",70,163,"medium",126,78,NA,NA,36,40,795,"50-60",1.778,73.9356427,23.3878521195818 20289,152,103,32,4.80000019,4.26999998,"Louisa",40,"female",52,187,"medium",148,82,158,80,38,49,135,"<40",1.3208,84.8218723,48.6221024457582 20290,277,119,62,4.5,5.03000021,"Louisa",60,"female",61,128,"small",140,86,128,74,33,39,240,"50-60",1.5494,58.0598912,24.1851683273375 20292,219,105,63,3.5,4.4000001,"Louisa",40,"female",62,153,"small",106,82,NA,NA,36,44,10,"<40",1.5748,69.3997137,27.9838114918165 20293,182,74,44,4.0999999,4.67000008,"Louisa",30,"female",62,125,"medium",132,80,NA,NA,31,39,480,"<40",1.5748,56.6991125,22.8625910880854 20294,135,88,47,2.9000001,4.21000004,"Louisa",21,"male",69,155,"small",110,68,NA,NA,31,39,10,"<40",1.7526,70.3068995,22.8892905223324 20298,277,88,45,6.19999981,5.23999977,"Louisa",63,"female",64,223,"medium",220,100,202,98,45,54,375,"60-70",1.6256,101.1512167,38.2775145152341 20306,212,82,68,3.0999999,4.61000013,"Louisa",63,"male",70,161,"medium",180,110,190,114,37,40,30,"60-70",1.778,73.0284569,23.1008846089121 20308,162,76,40,4.0999999,4.4000001,"Louisa",43,"male",67,216,"large",100,70,NA,NA,41,44,30,"40-50",1.7018,97.9760664,33.8300749936318 20309,207,102,43,4.80000019,5.01000023,"Louisa",46,"female",63,179,"medium",212,114,210,112,38,46,150,"40-50",1.6002,81.1931291,31.7081385246167 20312,255,100,34,7.5,6.05999994,"Louisa",64,"male",68,227,"medium",134,74,NA,NA,44,47,270,"60-70",1.7272,102.9655883,34.5149180490835 20313,404,206,33,12.1999998,10.75,"Louisa",56,"male",69,159,"medium",162,88,150,80,38,39,570,"50-60",1.7526,72.1212711,23.4799818906506 20314,239,97,55,4.30000019,4.69000006,"Louisa",35,"male",74,170,"small",122,62,NA,NA,32,38,720,"<40",1.8796,77.110793,21.8265098966283 20315,220,95,58,3.79999995,5.63000011,"Louisa",59,"female",66,138,"small",138,80,NA,NA,32,38,30,"50-60",1.6764,62.5958202,22.2735802014304 20318,165,76,46,3.5999999,3.69000006,"Louisa",22,"female",63,114,"small",112,78,NA,NA,28,35,120,"<40",1.6002,51.7095906,20.1940100100911 20325,243,74,42,5.80000019,3.8499999,"Louisa",43,"female",64,239,"medium",128,90,138,90,48,53,330,"40-50",1.6256,108.4087031,41.0238832696904 20329,149,138,50,3,4.09000015,"Louisa",26,"female",62,174,"medium",148,92,138,84,38,46,10,"<40",1.5748,78.9251646,31.8247267946149 20332,178,64,52,3.4000001,4.0999999,"Louisa",41,"female",65,188,"small",130,76,NA,NA,35,46,5,"40-50",1.651,85.2754652,31.2845527608215 20335,190,228,57,3.29999995,9.27999973,"Louisa",43,"female",65,198,"small",110,64,NA,NA,40,49,60,"40-50",1.651,89.8113942,32.9486247161843 20337,226,97,70,3.20000005,3.88000011,"Louisa",20,"female",64,114,"small",122,64,NA,NA,31,39,90,"<40",1.6256,51.7095906,19.5678773755008 20340,132,83,40,3.29999995,5.69999981,"Louisa",28,"female",68,225,"medium",136,86,NA,NA,41,52,105,"<40",1.7272,102.0584025,34.2108218548185 20343,160,82,41,3.9000001,2.8499999,"Louisa",30,"female",63,143,"medium",172,124,176,124,33,40,30,"<40",1.6002,64.8637847,25.3310827319563 20346,204,173,37,5.5,13.0600004,"Louisa",66,"male",67,146,"medium",138,78,NA,NA,36,48,1260,"60-70",1.7018,66.2245634,22.8666247642141 20350,164,91,67,2.4000001,3.97000003,"Louisa",20,"female",70,141,"small",122,86,NA,NA,32,39,390,"<40",1.778,63.9565989,20.2312095022149 20352,155,81,70,2.20000005,3.02999997,"Louisa",32,"female",65,151,"small",120,68,NA,NA,33,40,420,"<40",1.651,68.4925279,25.127486525979 20355,251,118,38,6.5999999,5.51000023,"Louisa",38,"female",64,248,"medium",110,80,NA,NA,49,58,15,"<40",1.6256,112.4910392,42.568715694072 20361,198,86,66,3,5.67999983,"Louisa",61,"male",74,152,"small",138,76,NA,NA,33,38,420,"60-70",1.8796,68.9461208,19.5154676722794 20365,179,90,60,3,4.19999981,"Louisa",26,"female",60,130,"small",138,84,NA,NA,32,40,270,"<40",1.524,58.967077,25.388653374529 20367,223,88,42,5.30000019,6.44000006,"Louisa",74,"female",62,165,"medium",250,100,NA,NA,41,46,60,">70",1.5748,74.8428285,30.1786202362727 20368,207,71,41,5,9.61999989,"Louisa",72,"male",70,180,"medium",138,88,NA,NA,39,40,45,">70",1.778,81.646722,25.8270759602744 20369,244,89,92,2.70000005,4.53999996,"Louisa",21,"male",71,163,"medium",116,76,NA,NA,34,39,180,"<40",1.8034,73.9356427,22.7336789101271 20750,245,119,26,9.39999962,7.51000023,"Louisa",36,"male",66,179,"large",150,92,130,86,37,42,390,"<40",1.6764,81.1931291,28.8910931598264 20754,191,81,53,3.5999999,5.63000011,"Louisa",42,"female",61,156,"medium",138,84,NA,NA,36,42,150,"40-50",1.5494,70.7604924,29.4756738989425 20761,221,120,83,2.70000005,5.76999998,"Louisa",66,"female",64,130,"small",110,64,NA,NA,31,38,15,"60-70",1.6256,58.967077,22.3142461299571 20762,300,65,59,5.0999999,4.55999994,"Louisa",34,"female",NA,160,"small",120,60,NA,NA,40,47,300,"<40",NA,72.574864,NA 20765,173,85,58,3,4.4000001,"Buckingham",43,"female",69,210,"medium",130,75,NA,NA,44,47,720,"40-50",1.7526,95.254509,31.0112968367084 20768,138,81,45,3.0999999,4.69999981,"Buckingham",57,"male",73,164,"small",148,81,NA,NA,31,37,240,"50-60",1.8542,74.3892356,21.6369948934306 20773,203,71,78,2.5999999,2.8499999,"Louisa",45,"male",66,115,"small",135,88,NA,NA,30,34,15,"40-50",1.6764,52.1631835,18.5613168345253 20774,260,67,46,5.69999981,5.34000015,"Louisa",44,"female",62,159,"small",140,94,130,95,36,43,330,"40-50",1.5748,72.1212711,29.0812158640446 20775,166,77,68,2.4000001,4.94999981,"Louisa",27,"male",72,141,"small",110,58,NA,NA,33,38,120,"<40",1.8288,63.9565989,19.1228639199177 20782,180,92,34,5.30000019,3.58999991,"Buckingham",63,"male",69,169,"small",145,72,142,70,35,39,30,"60-70",1.7526,76.6572001,24.9567103114462 20783,159,172,28,5.69999981,8.22999954,"Buckingham",65,"male",70,181,"large",142,81,NA,NA,43,49,480,"60-70",1.778,82.1003149,25.9705597156092 20784,207,75,44,4.69999981,5.05999994,"Buckingham",30,"male",72,180,"small",118,62,NA,NA,35,41,180,"<40",1.8288,81.646722,24.4121667062779 20787,298,84,50,6,NA,"Buckingham",28,"male",66,209,"medium",131,111,130,80,42,46,300,"<40",1.6764,94.8009161,33.7331758123112 20790,203,104,36,5.5999999,NA,"Buckingham",41,"male",71,210,NA,140,112,138,89,37,42,30,"40-50",1.8034,95.254509,29.2887887799184 21254,191,155,58,3.29999995,8.06000042,"Buckingham",31,"female",62,237,"large",140,87,NA,NA,53,56,240,"<40",1.5748,107.5015173,43.3474727030099 21255,231,84,91,2.5,4.9000001,"Buckingham",33,"male",69,163,"small",140,70,NA,NA,35,38,150,"<40",1.7526,73.9356427,24.0706732589689 21257,184,76,42,4.4000001,4.71000004,"Buckingham",66,"male",74,185,"medium",130,75,NA,NA,40,41,180,"60-70",1.8796,83.9146865,23.752378416919 21281,164,94,58,2.79999995,3.79999995,"Buckingham",28,"female",67,180,"small",128,94,124,96,39,43,270,"<40",1.7018,81.646722,28.1917291613599 21284,134,101,36,3.70000005,4.67000008,"Buckingham",25,"female",63,245,NA,142,78,141,80,47,58,10,"<40",1.6002,111.1302605,43.3994074778273 21298,220,60,66,3.29999995,10.9700003,"Buckingham",26,"male",70,150,"small",136,88,NA,NA,33,39,300,"<40",1.778,68.038935,21.5225633002286 21318,180,76,46,3.9000001,4.42999983,"Louisa",40,"female",64,146,"medium",128,82,NA,NA,37,43,240,"<40",1.6256,66.2245634,25.0606148844134 21320,216,155,30,7.19999981,5.90999985,"Louisa",38,"male",68,145,"medium",110,60,NA,NA,34,37,20,"<40",1.7272,65.7709705,22.0469740842163 21321,158,74,64,2.5,2.73000002,"Louisa",30,"female",62,142,"medium",108,68,NA,NA,NA,NA,330,"<40",1.5748,64.4101918,25.971903476065 21322,261,101,83,3.0999999,5.11999989,"Louisa",52,"female",64,198,"medium",152,92,162,92,42,49,20,"50-60",1.6256,89.8113942,33.9863133363962 21323,172,70,36,4.80000019,3.77999997,"Louisa",22,"female",64,148,"small",90,48,NA,NA,35,38,240,"<40",1.6256,67.1317492,25.4039109787204 21329,249,81,28,8.89999962,5.11999989,"Louisa",51,"female",65,200,"medium",122,90,NA,NA,43,46,150,"50-60",1.651,90.71858,33.2814391072569 21333,189,80,40,4.69999981,3.61999989,"Louisa",45,"male",69,190,"large",140,75,NA,NA,39,44,300,"40-50",1.7526,86.182651,28.0578399951171 21334,225,74,36,6.30000019,4.65999985,"Louisa",53,"female",63,182,"large",126,80,NA,NA,38,46,540,"50-60",1.6002,82.5539078,32.2395598406717 21338,193,75,49,3.9000001,5.01000023,"Louisa",21,"female",61,220,"small",130,82,NA,NA,40,52,240,"<40",1.5494,99.790438,41.5682580626113 21341,219,78,67,3.29999995,3.75,"Louisa",53,"female",64,179,"medium",135,100,170,98,39,47,150,"50-60",1.6256,81.1931291,30.7250004404794 21343,156,86,34,4.5999999,4.55000019,"Louisa",37,"female",67,212,"small",122,74,NA,NA,48,51,150,"<40",1.7018,96.1616948,33.2035921233794 21345,224,71,42,5.30000019,4.92000008,"Louisa",34,"female",60,165,"medium",135,80,NA,NA,34,46,30,"<40",1.524,74.8428285,32.2240600522868 21346,181,77,46,3.9000001,4.09000015,"Louisa",30,"female",66,257,"medium",162,108,158,110,47,55,60,"<40",1.6764,116.5733753,41.480508056287 21347,306,92,56,5.5,5.57999992,"Louisa",74,"male",69,184,"large",140,72,NA,NA,39,41,195,">70",1.7526,83.4610936,27.1718029426397 21357,122,82,43,2.79999995,3.98000002,"Louisa",36,"female",71,183,NA,110,80,NA,NA,41,45,90,"<40",1.8034,83.0075007,25.5230873653574 21359,219,130,44,5,7.21999979,"Louisa",45,"male",67,218,"large",172,110,168,108,41,45,180,"40-50",1.7018,98.8832522,34.143316428758 40251,150,80,38,3.9000001,3.97000003,"Louisa",35,"male",73,179,"medium",138,92,135,88,32,37,450,"<40",1.8542,81.1931291,23.6159883288053 40253,185,67,59,3.0999999,4.6500001,"Louisa",50,"female",64,228,"medium",142,90,142,92,42,54,225,"40-50",1.6256,103.4191812,39.1357547510017 40500,226,100,65,3.5,4.82999992,"Louisa",27,"male",69,289,"large",130,100,170,114,48,51,75,"<40",1.7526,131.0883481,42.6774513609939 40501,206,83,68,3,4.88000011,"Louisa",52,"male",69,153,"small",140,98,142,102,36,40,195,"50-60",1.7526,69.3997137,22.5939448381732 40502,199,81,36,5.5,4.92999983,"Louisa",42,"female",67,235,"large",178,100,170,96,47,52,210,"40-50",1.7018,106.5943315,36.8058686273309 40751,239,85,63,3.79999995,5.15999985,"Louisa",39,"male",60,144,"medium",162,90,152,90,33,42,180,"<40",1.524,65.3173776,28.1228160456321 40754,235,106,37,6.4000001,6.78000021,"Louisa",73,"male",65,183,"large",134,78,NA,NA,43,46,195,">70",1.651,83.0075007,30.4525167831401 40755,184,99,36,5.0999999,4.15999985,"Louisa",28,"male",67,154,"small",124,94,110,74,35,38,330,"<40",1.7018,69.8533066,24.119590504719 40762,242,297,34,7.0999999,12.1599998,"Louisa",53,"male",69,216,"large",142,96,142,98,43,45,285,"50-60",1.7526,97.9760664,31.8973338891857 40764,307,87,58,5.30000019,4.28000021,"Louisa",49,"male",67,181,"small",120,80,NA,NA,41,42,240,"40-50",1.7018,82.1003149,28.348349878923 40772,204,94,54,3.79999995,4.15999985,"Louisa",55,"female",66,202,"small",140,90,140,90,43,47,150,"50-60",1.6764,91.6257658,32.6033565267314 40773,212,88,36,5.9000001,5.21999979,"Louisa",37,"female",64,160,"small",124,82,NA,NA,37,45,15,"<40",1.6256,72.574864,27.4636875445626 40774,203,90,51,4,14.9399996,"Louisa",60,"female",59,123,"medium",130,72,NA,NA,36,41,60,"50-60",1.4986,55.7919267,24.8427633841766 40775,219,173,31,7.0999999,10.1599998,"Louisa",56,"female",65,197,"small",100,50,NA,NA,41,50,210,"50-60",1.651,89.3578013,32.7822175206481 40784,226,279,52,4.30000019,10.0699997,"Louisa",84,"female",60,192,"small",144,88,146,82,41,48,210,">70",1.524,87.0898368,37.4970880608428 40785,217,75,54,4,3.66000009,"Louisa",20,"female",67,187,"medium",110,72,NA,NA,40,45,1440,"<40",1.7018,84.8218723,29.2880741843016 40786,157,92,47,3.29999995,6.48000002,"Louisa",80,"male",71,212,"medium",156,88,158,86,47,48,390,">70",1.8034,96.1616948,29.5677296254414 40787,235,102,42,5.5999999,4.9000001,"Louisa",60,"male",69,186,"medium",148,98,130,100,40,42,900,"50-60",1.7526,84.3682794,27.4671486267988 40789,252,161,87,2.9000001,11.1800003,"Louisa",80,"female",62,162,"small",160,100,160,100,44,41,1440,">70",1.5748,73.4820498,29.6299180501587 40792,204,71,55,3.70000005,4.32999992,"Louisa",29,"female",64,120,"small",110,70,NA,NA,33,38,90,"<40",1.6256,54.431148,20.5977656584219 40797,188,84,46,4.0999999,3.75,"Louisa",43,"female",66,152,"small",122,80,NA,NA,37,41,260,"40-50",1.6764,68.9461208,24.53321877259 40799,194,95,36,5.4000001,4.96999979,"Louisa",63,"female",58,210,"medium",140,100,136,100,44,53,240,"60-70",1.4732,95.254509,43.8896504873866 40803,215,64,84,2.5999999,4.03999996,"Louisa",37,"female",59,148,"medium",140,100,136,92,32,42,270,"<40",1.4986,67.1317492,29.892105535432 40804,179,105,60,3,4.67999983,"Louisa",20,"female",58,170,"medium",140,100,138,82,34,46,270,"<40",1.4732,77.110793,35.5297170612177 40805,202,84,33,6.0999999,4.17000008,"Louisa",44,"male",68,157,"small",125,80,NA,NA,33,37,180,"40-50",1.7272,71.2140853,23.8715512498067 41000,194,87,65,3,4.13999987,"Louisa",54,"male",69,129,"small",170,96,160,94,30,37,15,"50-60",1.7526,58.5134841,19.0497966282637 41001,227,85,26,8.69999981,4.98000002,"Louisa",58,"male",70,211,"large",144,82,144,80,38,43,480,"50-60",1.778,95.7081019,30.275072375655 41003,337,85,62,5.4000001,4.65999985,"Louisa",35,"male",72,189,"medium",124,84,NA,NA,36,44,240,"<40",1.8288,85.7290581,25.6327750415918 41004,255,83,90,2.79999995,4.28999996,"Louisa",52,"male",70,120,"medium",170,110,166,108,30,33,780,"50-60",1.778,54.431148,17.2180506401829 41021,162,90,46,3.5,5.55999994,"Louisa",60,"female",63,121,"medium",110,64,NA,NA,32,34,300,"50-60",1.6002,54.8847409,21.4339930808861 41023,322,87,92,3.5,4.44999981,"Louisa",43,"female",56,120,NA,120,98,122,100,32,41,60,"40-50",1.4224,54.431148,26.9032041252858 41029,289,267,38,7.5999999,11.4099998,"Louisa",59,"male",68,169,"large",142,79,NA,NA,36,38,900,"50-60",1.7272,76.6572001,25.696128415397 41034,217,87,40,5.4000001,4.07000017,"Louisa",33,"female",62,186,"small",140,90,138,84,42,46,40,"<40",1.5748,84.3682794,34.0195355390711 41035,209,91,36,5.80000019,5.01000023,"Louisa",37,"male",70,262,"medium",130,94,130,88,42,48,450,"<40",1.778,118.8413398,37.5927438977327 41036,214,77,48,4.5,4.48000002,"Louisa",40,"male",72,222,"medium",120,84,NA,NA,40,44,1020,"<40",1.8288,100.6976238,30.1083389377427 41037,302,81,57,5.30000019,4.6500001,"Louisa",38,"female",67,222,"medium",128,82,NA,NA,41,51,210,"<40",1.7018,100.6976238,34.7697992990105 41039,179,85,52,3.4000001,4.05000019,"Louisa",32,"female",62,179,"medium",140,96,148,100,37,47,60,"<40",1.5748,81.1931291,32.7392304381383 41041,279,270,40,7,8.10999966,"Louisa",60,"female",68,224,"large",174,90,174,84,48,50,180,"50-60",1.7272,101.6048096,34.0587737576859 41055,144,81,28,5.0999999,4.13000011,"Louisa",30,"male",72,165,"small",118,78,NA,NA,31,38,180,"<40",1.8288,74.8428285,22.3778194807547 41063,270,73,40,6.80000019,3.57999992,"Louisa",42,"male",66,185,"large",146,94,149,94,39,41,30,"40-50",1.6764,83.9146865,29.8595096903233 41065,196,120,67,2.9000001,9.36999989,"Louisa",52,"female",62,147,"medium",144,94,142,92,34,42,480,"50-60",1.5748,66.6781563,26.8864071195884 41075,221,126,48,4.5999999,5.53000021,"Louisa",59,"female",62,177,"medium",130,78,NA,NA,39,45,60,"50-60",1.5748,80.2859433,32.3734289807289 41078,210,81,81,2.5999999,4.96000004,"Louisa",78,"male",66,145,"large",110,70,NA,NA,38,39,540,">70",1.6764,65.7709705,23.4033994870102 41253,192,85,69,2.79999995,4.38000011,"Louisa",51,"male",65,146,"large",130,110,170,118,NA,NA,60,"50-60",1.651,66.2245634,24.2954505482975 41254,169,104,58,2.9000001,4.82000017,"Louisa",25,"female",60,154,"medium",140,95,130,94,40,42,60,"<40",1.524,69.8533066,30.0757893821343 41500,179,85,50,3.5999999,4.98999977,"Louisa",37,"male",66,136,"medium",190,94,172,100,33,39,480,"<40",1.6764,61.6886344,21.9507746912647 41501,216,84,64,3.4000001,NA,"Louisa",54,"female",66,168,"medium",132,90,126,80,38,42,330,"50-60",1.6764,76.2036072,27.1156628539152 41503,301,90,118,2.5999999,4.28000021,"Louisa",89,"female",61,115,"medium",218,90,238,90,31,41,210,">70",1.5494,52.1631835,21.7288621690923 41506,296,369,46,6.4000001,16.1100006,"Louisa",53,"male",69,173,"medium",138,94,130,94,35,39,210,"50-60",1.7526,78.4715717,25.5474016797645 41507,284,89,54,5.30000019,4.38999987,"Louisa",51,"female",63,154,"medium",140,100,146,102,32,43,180,"50-60",1.6002,69.8533066,27.2796275574914 41510,194,269,38,5.0999999,13.6300001,"Louisa",29,"female",69,167,"small",120,70,NA,NA,33,40,20,"<40",1.7526,75.7500143,24.6613646272871 41752,199,76,52,3.79999995,4.48999977,"Louisa",41,"female",63,197,"medium",120,78,NA,NA,41,48,255,"40-50",1.6002,89.3578013,34.8966664209469 41756,159,88,79,2,NA,"Louisa",68,"female",64,220,"medium",100,72,NA,NA,49,58,900,"60-70",1.6256,99.790438,37.7625703737736 Publish/data/CiTable.csv0000644000176200001440000000442714142666146014632 0ustar liggesusers"Drug";"Time";"Drug.Time";"Dose";"Mean";"SD";"n";"HazardRatio";"lower";"upper";"p" "Metropolol";"3 months";"Metropolol";">200 mg/day";200;0;2989;1;1;1;NA "Metropolol";"3 months";"3 months";"<100 mg/day";64.6;25.8;25049;1.038;0.978;1.101;0.2178 "Metropolol";"3 months";"";"101-199 mg/day";144.3;10.5;4929;1.066;0.994;1.142;0.0721 "Carvedilol";"3 months";"Carvedilol";"<12.5 mg/day";10.2;3;3915;1.098;1.016;1.187;0.0184 "Carvedilol";"3 months";"3 months";"12.6-49 mg/day";26.3;6;3155;0.949;0.871;1.033;0.2251 "Carvedilol";"3 months";"";">50 mg/day";54.9;11.3;1957;0.887;0.8;0.984;0.0237 "Bisoprolol";"3 months";"Bisoprolol";"<5 mg/day";4.5;1;1700;1.058;0.967;1.157;0.2179 "Bisoprolol";"3 months";"3 months";"6-9 mg/day";7.5;0.29;337;1.068;0.906;1.26;0.4336 "Bisoprolol";"3 months";"";">10 mg/day";14.3;4.2;831;1.127;1.003;1.266;0.0435 "Metropolol";"6 months";"Metropolol";">200 mg/day";200;0;2927;1;1;1;NA "Metropolol";"6 months";"6 months";"<100 mg/day";67.4;26.3;19561;0.998;0.934;1.065;0.9441 "Metropolol";"6 months";"";"101-199 mg/day";144.3;10.5;3863;1.026;0.948;1.11;0.5214 "Carvedilol";"6 months";"Carvedilol";"<12.5 mg/day";10.4;2.9;2879;1.122;1.03;1.223;0.0087 "Carvedilol";"6 months";"6 months";"12.6-49 mg/day";27.5;6.6;3687;0.919;0.824;1.003;0.0594 "Carvedilol";"6 months";"";">50 mg/day";53.9;9.8;2844;0.865;0.784;0.954;0.0039 "Bisoprolol";"6 months";"Bisoprolol";"<5 mg/day";4.3;1.1;1334;1.099;0.994;1.214;0.0656 "Bisoprolol";"6 months";"2 years";"6-9 mg/day";7.5;0.3;357;0.939;0.79;1.116;0.4749 "Bisoprolol";"6 months";"";">10 mg/day";12.6;3.7;818;0.93;0.816;1.06;0.2793 "Metropolol";"2 years";"Metropolol";">200 mg/day";200;0;2559;1;1;1;NA "Metropolol";"2 years";"2 years";"<100 mg/day";66.6;27.5;14190;1.086;0.997;1.182;0.0572 "Metropolol";"2 years";"";"101-199 mg/day";145.3;9.8;2133;1.149;1.031;1.281;0.0121 "Carvedilol";"2 years";"Carvedilol";"<12.5 mg/day";10.5;2.9;1634;1.233;1.099;1.384;0.0004 "Carvedilol";"2 years";"2 years";"12.6-49 mg/day";28.3;6.9;2747;1.017;0.909;1.136;0.7731 "Carvedilol";"2 years";"";">50 mg/day";53.6;9.4;3336;0.972;0.868;1.089;0.6233 "Bisoprolol";"2 years";"Bisoprolol";"<5 mg/day";4.3;1.1;1144;1.055;0.931;1.195;0.4017 "Bisoprolol";"2 years";"2 years";"6-9 mg/day";7.5;0.3;170;1.252;0.977;1.605;0.076 "Bisoprolol";"2 years";"";">10 mg/day";11.9;3.4;774;1.134;0.972;1.322;0.1097 Publish/NAMESPACE0000755000176200001440000000636615040353504013114 0ustar liggesusers# Generated by roxygen2: do not edit by hand S3method(as.data.frame,specialFrame) S3method(ci.mean,default) S3method(ci.mean,formula) S3method(plot,ci) S3method(plot,regressionTable) S3method(plot,subgroupAnalysis) S3method(plot,summary.regressionTable) S3method(print,ci) S3method(print,regressionTable) S3method(print,subgroupAnalysis) S3method(print,summary.regressionTable) S3method(print,table2x2) S3method(print,univariateTable) S3method(publish,CauseSpecificCox) S3method(publish,FGR) S3method(publish,MIresult) S3method(publish,Score) S3method(publish,ci) S3method(publish,coxph) S3method(publish,data.frame) S3method(publish,default) S3method(publish,geeglm) S3method(publish,glm) S3method(publish,gls) S3method(publish,htest) S3method(publish,list) S3method(publish,lm) S3method(publish,lme) S3method(publish,matrix) S3method(publish,prodlim) S3method(publish,riskReclassification) S3method(publish,riskRegression) S3method(publish,subgroupAnalysis) S3method(publish,summary.aov) S3method(publish,summary.prodlim) S3method(publish,survdiff) S3method(publish,table) S3method(publish,univariateTable) S3method(summary,ci) S3method(summary,regressionTable) S3method(summary,subgroupAnalysis) S3method(summary,univariateTable) S3method(summary,utable) export(Spaghettiogram) export(Units) export(acut) export(ci.mean) export(coxphSeries) export(fixRegressionTable) export(followupTable) export(formatCI) export(glmSeries) export(labelUnits) export(lazyDateCoding) export(lazyFactorCoding) export(org) export(parseInteractionTerms) export(plotConfidence) export(pubformat) export(publish) export(regressionTable) export(spaghettiogram) export(specialFrame) export(splinePlot.lrm) export(stripes) export(subgroupAnalysis) export(summary.univariateTable) export(summary.utable) export(sutable) export(table2x2) export(univariateTable) export(utable) importFrom(data.table,".N") importFrom(data.table,".SD") importFrom(data.table,":=") importFrom(data.table,as.data.table) importFrom(data.table,copy) importFrom(data.table,data.table) importFrom(data.table,is.data.table) importFrom(data.table,melt) importFrom(data.table,rbindlist) importFrom(data.table,set) importFrom(data.table,setcolorder) importFrom(data.table,setkey) importFrom(data.table,setnames) importFrom(data.table,setorder) importFrom(grDevices,dev.size) importFrom(graphics,abline) importFrom(graphics,par) importFrom(graphics,plot) importFrom(graphics,polygon) importFrom(graphics,rect) importFrom(graphics,segments) importFrom(graphics,strwidth) importFrom(prodlim,Hist) importFrom(prodlim,getEvent) importFrom(stats,anova) importFrom(stats,binom.test) importFrom(stats,binomial) importFrom(stats,chisq.test) importFrom(stats,coef) importFrom(stats,confint) importFrom(stats,delete.response) importFrom(stats,fisher.test) importFrom(stats,get_all_vars) importFrom(stats,glm) importFrom(stats,kruskal.test) importFrom(stats,model.frame) importFrom(stats,model.response) importFrom(stats,na.omit) importFrom(stats,na.pass) importFrom(stats,naprint) importFrom(stats,pchisq) importFrom(stats,pt) importFrom(stats,qnorm) importFrom(stats,qt) importFrom(stats,quantile) importFrom(stats,symnum) importFrom(stats,terms) importFrom(stats,update) importFrom(stats,update.formula) importFrom(stats,var) importFrom(survival,Surv) importFrom(survival,coxph) Publish/README.md0000644000176200001440000000075614142666146013161 0ustar liggesusers# Publish R package Publish ## Installation To install the development version of Publish run the following commands from within R ```{r} library(devtools) install_github('tagteam/Publish') ``` ## Trouble shooting To install a package from github you need a program to unzip the download. If you don't have such a program and the install_github above command failed, then you should try ```{r} library(devtools) options(unzip="internal") install_github('tagteam/Publish') ``` ## Examples Publish/man/0000755000176200001440000000000015040353504012432 5ustar liggesusersPublish/man/spaghettiogram.Rd0000644000176200001440000000356114142666146015757 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/Spaghettiogram.R \name{spaghettiogram} \alias{spaghettiogram} \alias{Spaghettiogram} \title{Spaghettiogram} \usage{ spaghettiogram( formula, data, xlim, ylim, xlab = "", ylab = "", axes = TRUE, col, lwd, lty, pch, legend = FALSE, add = FALSE, background = TRUE, ... ) } \arguments{ \item{formula}{A formula which specifies the variables for the spaghettiograms. If Y ~ X + id(Z) then for each value of Z the spaghettiogram is the graph (X,Y) in the subset defined by the value of Z. Data are expected to be in the "long" format. Y is a numeric vector and X is a factor whose levels define the X-axis. Each level of the id-vector corresponds to one line (spaghetti) in the plot.} \item{data}{data set in which variables X, Y and Z are defined.} \item{xlim}{Limits for x-axis} \item{ylim}{Limits for y-axis} \item{xlab}{Label for x-axis} \item{ylab}{Label for x-axis} \item{axes}{Logical indicating if axes should be drawn.} \item{col}{Colors for the spaghettiograms} \item{lwd}{Widths for the spaghettiograms} \item{lty}{Type for the spaghettiograms} \item{pch}{Point-type for the spaghettiograms} \item{legend}{If \code{TRUE} add a legend. Argument A of legend is controlled as legend.A. E.g., when \code{legend.cex=2} legend will be called with argument cex=2.} \item{add}{If \code{TRUE} add to existing plot device.} \item{background}{Control the background color of the graph.} \item{...}{used to transport arguments which are passed to the following subroutines: \code{"plot"}, \code{"lines"}, \code{"legend"}, \code{"background"}, \code{"axis1"}, \code{"axis2"}.} } \value{ List with data of each subject } \description{ A spaghettiogram is showing repeated measures (longitudinal data) } \examples{ data(SpaceT) Spaghettiogram(HR~Status+id(ID), data=SpaceT) } Publish/man/acut.Rd0000644000176200001440000001224114142666146013670 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/acut.R \name{acut} \alias{acut} \title{Automatic selection and formatting of breaks in \code{cut}} \usage{ acut( x, n = 5, type = "default", format = NULL, format.low = NULL, format.high = NULL, dig.lab = 3, right = TRUE, breaks, labels = TRUE, ... ) } \arguments{ \item{x}{a numeric vector which is to be converted to a factor by cutting (passed directly to \code{cut}).} \item{n}{number of bins to create based on the empirical quantiles of x. This will be overruled if \code{breaks} is supplied.} \item{type}{a high-level formatting option. For now, the only other option than the default setting is "\code{age}". See details and examples.} \item{format}{string used to make labels. \%l and \%u identifies the lower and upper value of the breaks respectively. See examples.} \item{format.low}{string used specifically on the lowest label.} \item{format.high}{string used specifically on the highest label.} \item{dig.lab}{integer which is used when labels are not given. It determines the number of digits used in formatting the break numbers. (Passed directly to \code{cut}.)} \item{right}{logical, indicating if the intervals should be closed on the right (and open on the left) or vice versa (passed directly to \code{cut}).} \item{breaks}{specify breaks manually as in \code{cut}.} \item{labels}{logical, indicating whether or not to make labels or simply use ordered numbers. If TRUE, the labels are constructed as discribed above.} \item{...}{further arguments passed to \code{cut}.} } \value{ same as for cut. A vector of 'factors' is created, unless 'labels=FALSE'. } \description{ A version of \code{cut} that easily formats the labels and places breaks by default. } \details{ The formats are supplied by specifiyng the text around the lower (\%l) and upper (\%l) value (see examples). If user specified breaks are supplied, the default labels from \code{cut} are used. If automatic breaks are used, the default labels are a slight modification at the end point of the default from \code{cut} All this can of course be adjusted manually through the format functionality (see below). By default, 5 breaks are constructed according to the quantiles with of the input \code{x}. The number of breaks can be adjusted, and default specifying breaks (as in \code{cut}) can be supplied instead. If \code{type} is changed from "\code{default}" to another option, a different formatting template is used. For now the only other option is "\code{age}", which is designed to be well suited to easily group age variables. When \code{type}="\code{age}" only the \code{breaks} argument is used, and it behaves different from otherwise. If a single number is supplied, intervals of length \code{breaks} will automatically be constructed (starting from 0). If a vector is supplied, the intervals are used as in \code{cut} but formatted differently, see examples. } \examples{ data(Diabetes) # load dataset ## The default uses format similar to cut chol.groups <- acut(Diabetes$chol) table(chol.groups) ## The formatting can easily be changed chol.groups <- acut(Diabetes$chol,format="\%l-\%u",n=5) table(chol.groups) ## The default is to automatic place the breaks, so the number of this can easily be changed. chol.groups <- acut(Diabetes$chol,n=7) table(chol.groups) ## Manually setting format and breaks age.groups <- acut(Diabetes$age,format="\%l-\%u",breaks=seq(0,100,by=10)) table(age.groups) ## Other variations age.groups <- acut(Diabetes$age, format="\%l-\%u", format.low="below \%u", format.high="above \%l", breaks=c(0, seq(20,80,by=10), Inf)) table(age.groups) BMI.groups <- acut(Diabetes$BMI, format="BMI between \%l and \%u", format.low="BMI below \%u", format.high="BMI above \%l") table(BMI.groups) org(as.data.frame(table(BMI=BMI.groups))) ## Instead of using the quantiles, we can specify equally spaced breaks, ## but still get the same formatting BMI.grouping <- seq(min(Diabetes$BMI,na.rm=TRUE), max(Diabetes$BMI,na.rm=TRUE), length.out=6) BMI.grouping[1] <- -Inf # To get all included BMI.groups <- acut(Diabetes$BMI, breaks=BMI.grouping, format="BMI between \%l and \%u", format.low="BMI below \%u", format.high="BMI above \%l") table(BMI.groups) org(as.data.frame(table(BMI=BMI.groups))) ## Using type="age" ## When using type="age", categories of 10 years are constructed by default. ## The are formatted to be easier to read when the values are ages. table(acut(Diabetes$age, type="age")) ## This can be changes with the breaks argument. ## Note that this is diffent from cut when breaks is a single number. table(acut(Diabetes$age, type="age", breaks=20)) ## Of course We can also supply the breaks manually. ## The formatting depends on whether or not all the values fall within the breaks: ## All values within the breaks table(acut(Diabetes$age, type="age", breaks=c(0, 30, 50, 80, 100))) ## Some values below and above the breaks table(acut(Diabetes$age, type="age", breaks=c(30, 50, 80))) } \author{ Anders Munch } Publish/man/publish.matrix.Rd0000644000176200001440000000526314361526014015703 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/publish.matrix.R \name{publish.matrix} \alias{publish.matrix} \title{Publishing a matrix in raw, org, latex, or muse format} \usage{ \method{publish}{matrix}( object, title, colnames = TRUE, rownames = TRUE, col1name = "", digits = 4, try.convert = TRUE, sep = " ", endhead, endrow, style, inter.lines, latex = FALSE, wiki = FALSE, org = FALSE, markdown = FALSE, tabular = TRUE, latex.table.format = NA, latex.hline = 1, latex.nodollar = FALSE, ... ) } \arguments{ \item{object}{Matrix to be published} \item{title}{Title for table, only in wiki and muse format} \item{colnames}{If \code{TRUE} show column names} \item{rownames}{If \code{TRUE} show row names} \item{col1name}{Name for first column} \item{digits}{Numbers are rounded according to digits} \item{try.convert}{Logical. If \code{TRUE} try to convert also non-numeric formats such as character to numeric before rounding. Default is \code{TRUE}.} \item{sep}{Field separator when style is \code{"none"}} \item{endhead}{String to be pasted at the end of the first row (header)} \item{endrow}{String to be pasted at the end of each row} \item{style}{Table style for export to \code{"latex"}, \code{"org"}, \code{"markdown"}, \code{"wiki"}, \code{"none"}. Overwritten by argments below.} \item{inter.lines}{A named list which contains strings to be placed between the rows of the table. An element with name \code{"0"} is used to place a line before the first column, elements with name \code{"r"} are placed between line r and r+1.} \item{latex}{If \code{TRUE} use latex table format} \item{wiki}{If \code{TRUE} use mediawiki table format} \item{org}{If \code{TRUE} use emacs orgmode table format} \item{markdown}{If \code{TRUE} use markdown table format} \item{tabular}{For style \code{latex} only: if \code{TRUE} enclose the table in begin/end tabular environement.} \item{latex.table.format}{For style \code{latex} only: format of the tabular environement.} \item{latex.hline}{For style \code{latex} only: if \code{TRUE} add hline statements add the end of each line.} \item{latex.nodollar}{For style \code{latex} only: if \code{TRUE} do not enclose numbers in dollars.} \item{...}{Used to transport arguments. Currently supports \code{wiki.class}.} } \description{ This is the heart of the Publish package } \examples{ x <- matrix(1:12,ncol=3) publish(x) # rounding the numeric part of data mixtures y <- cbind(matrix(letters[1:12],ncol=3),x,matrix(rnorm(12),ncol=3)) publish(y,digits=1) publish(x,latex=TRUE, inter.lines=list("1"="text between line 1 and line 2", "3"="text between line 3 and line 4")) } Publish/man/fixRegressionTable.Rd0000755000176200001440000000245414142666146016543 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/fixRegressionTable.R \name{fixRegressionTable} \alias{fixRegressionTable} \title{Expand regression coefficient table} \usage{ fixRegressionTable( x, varnames, reference.value, reference.style = NULL, factorlevels, scale = NULL, nmiss, intercept ) } \arguments{ \item{x}{object resulting from \code{lm}, \code{glm} or \code{coxph}.} \item{varnames}{Names of variables} \item{reference.value}{Reference value for reference categories} \item{reference.style}{Style for showing results for categorical variables. If \code{"extraline"} show an additional line for the reference category.} \item{factorlevels}{Levels of the categorical variables.} \item{scale}{Scale for some or all of the variables} \item{nmiss}{Number of missing values} \item{intercept}{Intercept} } \value{ a table with regression coefficients } \description{ Expand regression coefficient table } \details{ This function expands results from "regressionTable" with extralines and columns For factor variables the reference group is shown. For continuous variables the units are shown and for transformed continuous variables also the scale. For all variables the numbers of missing values are added. } \author{ Thomas Alexander Gerds } Publish/man/publish.coxph.Rd0000755000176200001440000000471414142666146015533 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/publish.coxph.R \name{publish.coxph} \alias{publish.coxph} \title{Tabulize hazard ratios with confidence intervals and p-values.} \usage{ \method{publish}{coxph}( object, confint.method, pvalue.method, print = TRUE, factor.reference = "extraline", units = NULL, probindex = FALSE, ... ) } \arguments{ \item{object}{A \code{coxph} object.} \item{confint.method}{See \code{regressionTable}} \item{pvalue.method}{See \code{regressionTable}} \item{print}{If \code{FALSE} do not print results.} \item{factor.reference}{See \code{regressionTable}} \item{units}{See \code{regressionTable}} \item{probindex}{Logical. If \code{TRUE} show coefficients on probabilistic index scale instead of hazard ratio scale.} \item{...}{passed to \code{summary.regressionTable} and also to \code{labelUnits}.} } \value{ Table with hazard ratios, confidence intervals and p-values. } \description{ Tabulize the part of the result of a Cox regression analysis which is commonly shown in publications. } \details{ Transforms the log hazard ratios to hazard ratios and returns them with confidence limits and p-values. If explanatory variables are log transformed or log2 transformed, a scaling factor is multiplied to both the log-hazard ratio and its standard-error. } \examples{ library(survival) data(pbc) pbc$edema <- factor(pbc$edema, levels=c("0","0.5","1"), labels=c("0","0.5","1")) fit = coxph(Surv(time,status!=0)~age+sex+edema+log(bili)+log(albumin), data=na.omit(pbc)) publish(fit) ## forest plot plot(publish(fit),cex=1.3) publish(fit,ci.digits=2,pvalue.eps=0.01,pvalue.digits=2,pvalue.stars=TRUE) publish(fit,ci.digits=2,ci.handler="prettyNum",pvalue.eps=0.01, pvalue.digits=2,pvalue.stars=TRUE) publish(fit, ci.digits=2, ci.handler="sprintf", pvalue.eps=0.01, pvalue.digits=2,pvalue.stars=TRUE, ci.trim=FALSE) fit2 = coxph(Surv(time,status!=0)~age+sex+edema+log(bili,base=2)+log(albumin)+log(protime), data=na.omit(pbc)) publish(fit2) # with cluster variable fit3 = coxph(Surv(time,status!=0)~age+cluster(sex)+edema+log(bili,base=2) +log(albumin)+log(protime), data=na.omit(pbc)) publish(fit3) # with strata and cluster variable fit4 = coxph(Surv(time,status!=0)~age+cluster(sex)+strata(edema)+log(bili,base=2) +log(albumin)+log(protime), data=pbc) publish(fit4) } \author{ Thomas Alexander Gerds } Publish/man/univariateTable.Rd0000755000176200001440000001636714361526014016063 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/univariateTable.R \name{univariateTable} \alias{univariateTable} \alias{utable} \title{Univariate table} \usage{ univariateTable( formula, data = parent.frame(), summary.format = "mean(x) (sd(x))", Q.format = "median(x) [iqr(x)]", freq.format = "count(x) (percent(x))", column.percent = TRUE, digits = c(1, 1, 3), big.mark = ",", short.groupnames, compare.groups = TRUE, show.totals = TRUE, n = "inNames", outcome = NULL, ... ) } \arguments{ \item{formula}{Formula specifying the grouping variable (strata) on the left hand side (can be omitted) and on the right hand side the variables for which to obtain (descriptive) statistics.} \item{data}{Data set in which formula is evaluated} \item{summary.format}{Format for the numeric (non-factor) variables. Default is mean (SD). If different formats are desired, either special Q can be used or the function is called multiple times and the results are rbinded. See examples.} \item{Q.format}{Format for quantile summary of numerical variables: Default is median (inter quartile range).} \item{freq.format}{Format for categorical variables. Default is count (percentage).} \item{column.percent}{Logical, if \code{TRUE} and the default freq.format is used then column percentages are given instead of row percentages for categorical variables (factors).} \item{digits}{Number of digits} \item{big.mark}{For formatting large numbers (i.e., greater than 1,000). \code{""} turn this off.} \item{short.groupnames}{If \code{TRUE} group names are abbreviated.} \item{compare.groups}{Method used to compare groups. If \code{"logistic"} and there are exactly two groups logistic regression is used instead of t-tests and Wilcoxon rank tests to compare numeric variables across groups.} \item{show.totals}{If \code{TRUE} show a column with totals.} \item{n}{If \code{TRUE} show the number of subjects as a separate row. If equal to \code{"inNames"}, show the numbers in parentheses in the column names. If \code{FALSE} do not show number of subjects.} \item{outcome}{Outcome data used to calculate p-values when compare groups method is \code{'logistic'} or \code{'cox'}.} \item{...}{saved as part of the result to be passed on to \code{labelUnits}} } \value{ List with one summary table element for each variable on the right hand side of formula. The summary tables can be combined with \code{rbind}. The function \code{summary.univariateTable} combines the tables, and shows p-values in custom format. } \description{ Categorical variables are summarized using counts and frequencies and compared . } \details{ This function can generate the baseline demographic characteristics that forms table 1 in many publications. It is also useful for generating other tables of univariate statistics. The result of the function is an object (list) which containe the various data generated. In most applications the \code{summary} function should be applied which generates a data.frame with a (nearly) publication ready table. Standard manipulation can be used to modify, add or remove columns/rows and for users not accustomed to R the table generated can be exported to a text file which can be read by other software, e.g., via write.csv(table,file="path/to/results/table.csv") By default, continuous variables are summarized by means and standard deviations and compared with t-tests. When continuous variables are summarized by medians and interquartile ranges the Deviations from the above defaults are obtained when the arguments summary.format and freq.format are combined with suitable summary functions. } \examples{ data(Diabetes) library(data.table) univariateTable(~age,data=Diabetes) univariateTable(~gender,data=Diabetes) univariateTable(~age+gender+ height+weight,data=Diabetes) ## same thing but less typing utable(~age+gender+ height+weight,data=Diabetes) ## summary by location: univariateTable(location~Q(age)+gender+height+weight,data=Diabetes) ## continuous variables marked with Q() are (by default) summarized ## with median (IQR) and kruskal.test (with two groups equivalent to wilcox.test) ## variables not marked with Q() are (by default) summarized ## with mean (sd) and anova.glm(...,test="Chisq") ## the p-value of anova(glm()) with only two groups is similar ## but not exactly equal to that of a t.test ## categorical variables are (by default) summarized by count ## (percent) and chi-square tests (\code{chisq.test}). When \code{compare.groups ='logistic'} ## anova(glm(...,family=binomial,test="Chisq")) is used to calculate p-values. ## export result to csv table1 = summary(univariateTable(location~age+gender+height+weight,data=Diabetes), show.pvalues=FALSE) # write.csv(table1,file="~/table1.csv",rownames=FALSE) ## change labels and values utable(location~age+gender+height+weight,data=Diabetes, age="Age (years)",gender="Sex", gender.female="Female", gender.male="Male", height="Body height (inches)", weight="Body weight (pounds)") ## Use quantiles and rank tests for some variables and mean and standard deviation for others univariateTable(gender~Q(age)+location+Q(BMI)+height+weight, data=Diabetes) ## Factor with more than 2 levels Diabetes$AgeGroups <- cut(Diabetes$age, c(19,29,39,49,59,69,92), include.lowest=TRUE) univariateTable(location~AgeGroups+gender+height+weight, data=Diabetes) ## Row percent univariateTable(location~gender+age+AgeGroups, data=Diabetes, column.percent=FALSE) ## change of frequency format univariateTable(location~gender+age+AgeGroups, data=Diabetes, column.percent=FALSE, freq.format="percent(x) (n=count(x))") ## changing Labels u <- univariateTable(location~gender+AgeGroups+ height + weight, data=Diabetes, column.percent=TRUE, freq.format="count(x) (percent(x))") summary(u,"AgeGroups"="Age (years)","height"="Height (inches)") ## more than two groups Diabetes$frame=factor(Diabetes$frame,levels=c("small","medium","large")) univariateTable(frame~gender+BMI+age,data=Diabetes) Diabetes$sex=as.numeric(Diabetes$gender) univariateTable(frame~sex+gender+BMI+age, data=Diabetes,freq.format="count(x) (percent(x))") ## multiple summary formats ## suppose we want for some reason mean (range) for age ## and median (range) for BMI. ## method 1: univariateTable(frame~Q(age)+BMI, data=Diabetes, Q.format="mean(x) (range(x))", summary.format="median(x) (range(x))") ## method 2: u1 <- summary(univariateTable(frame~age, data=na.omit(Diabetes), summary.format="mean(x) (range(x))")) u2 <- summary(univariateTable(frame~BMI, data=na.omit(Diabetes), summary.format="median(x) (range(x))")) publish(rbind(u1,u2),digits=2) ## Large number format (big.mark) n=100000 dat=data.frame(id=1:n,z=rbinom(n,1,.3),x=factor(sample(1:8,size=n,replace=TRUE))) u3 <- summary(univariateTable(z~x, data=dat,big.mark=",")) u3 } \seealso{ summary.univariateTable, publish.univariateTable } \author{ Thomas A. Gerds } Publish/man/publish.riskReclassification.Rd0000644000176200001440000000117215040357323020545 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/publish.riskReclassification.R \name{publish.riskReclassification} \alias{publish.riskReclassification} \title{Publishing riskReclassification objects} \usage{ \method{publish}{riskReclassification}(object, percent = TRUE, digits = ifelse(percent, 1, 2), ...) } \arguments{ \item{object}{riskReclassification object} \item{percent}{Logical. If \code{TRUE} multiply risks by 100.} \item{digits}{Rounding} \item{...}{Passed to \code{publish.matrix}} } \description{ Publishing riskReclassification objects } \author{ Thomas A. Gerds } Publish/man/Diabetes.Rd0000644000176200001440000000451514361526350014454 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/publish-package.R \docType{data} \name{Diabetes} \alias{Diabetes} \title{Diabetes data of Dr John Schorling} \format{ A data frame with 205 observations on the following 12 variables. \describe{ \item{id}{subject id} \item{chol}{Total Cholesterol} \item{stab.glu}{Stabilized Glucose} \item{hdl}{High Density Lipoprotein} \item{ratio}{Cholesterol/HDL Ratio} \item{glyhb}{Glycosolated Hemoglobin} \item{location}{a factor with levels (Buckingham,Louisa)} \item{age}{age (years)} \item{gender}{male or female} \item{height}{height (inches)} \item{height.europe}{height (cm)} \item{weight}{weight (pounds)} \item{weight.europe}{weight (kg)} \item{frame}{a factor with levels (small,medium,large)} \item{bp.1s}{First Systolic Blood Pressure} \item{bp.1d}{First Diastolic Blood Pressure} \item{bp.2s}{Second Diastolic Blood Pressure} \item{bp.2d}{Second Diastolic Blood Pressure} \item{waist}{waist in inches} \item{hip}{hip in inches} \item{time.ppn}{Postprandial Time when Labs were Drawn in minutes} \item{AgeGroups}{Categorized age} \item{BMI}{Categorized BMI} } } \description{ These data are courtesy of Dr John Schorling, Department of Medicine, University of Virginia School of Medicine. The data consist of 19 variables on 403 subjects from 1046 subjects who were interviewed in a study to understand the prevalence of obesity, diabetes, and other cardiovascular risk factors in central Virginia for African Americans. According to Dr John Hong, Diabetes Mellitus Type II (adult onset diabetes) is associated most strongly with obesity. The waist/hip ratio may be a predictor in diabetes and heart disease. DM II is also agssociated with hypertension - they may both be part of "Syndrome X". The 403 subjects were the ones who were actually screened for diabetes. Glycosolated hemoglobin > 7.0 is usually taken as a positive diagnosis of diabetes. } \examples{ data(Diabetes) } \references{ Willems JP, Saunders JT, DE Hunt, JB Schorling: Prevalence of coronary heart disease risk factors among rural blacks: A community-based study. Southern Medical Journal 90:814-820; 1997 Schorling JB, Roach J, Siegel M, Baturka N, Hunt DE, Guterbock TM, Stewart HL: A trial of church-based smoking cessation interventions for rural African Americans. Preventive Medicine 26:92-101; 1997. } \keyword{datasets} Publish/man/parseInteractionTerms.Rd0000644000176200001440000000631414142666146017265 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parseInteractionTerms.R \name{parseInteractionTerms} \alias{parseInteractionTerms} \title{Parse interaction terms} \usage{ parseInteractionTerms( terms, xlevels, units, format.factor, format.contrast, format.scale, format.scale.unit, sep = ": ", ... ) } \arguments{ \item{terms}{Terms of a formula} \item{xlevels}{Factor levels corresponding to the variables in \code{terms}} \item{units}{named list with unit labels. names should match variable names in formula.} \item{format.factor}{For categorical variables. A string which specifies the print format for factor labels. The string has to contain the keywords \code{"var"} and \code{"level"} which will be replaced by the name of the variable and the current level, respectively. Default is \code{"var(level)"}.} \item{format.contrast}{For categorical variables. A string which specifies the print format for constrast statements. The string has to contain the keywords \code{"var"}, \code{"level"} and \code{"ref"} which will be replaced by the name of the variable, the current level and the reference level, respectively.} \item{format.scale}{A string which specifies the print format for continuous variables without units. The string has to contain the keyword \code{"var"} which will be replaced by the name of the variable and the unit, respectively. Default is \code{"var"}.} \item{format.scale.unit}{A string which specifies the print format for continuous variables with units. The string has to contain the keywords \code{"var"} and \code{"unit"} which will be replaced by the name of the variable and the unit, respectively. Default is \code{"var(unit)"}.} \item{sep}{a character string to separate the terms. Default is \code{": "}.} \item{...}{Not yet used} } \value{ List of contrasts which can be passed to \code{lava::estimate}. } \description{ Parse interaction terms for regression tables } \details{ Prepare a list of contrasts which combines regression coefficients to describe statistical interactions. } \examples{ tt <- terms(formula(SBP~age+sex*BMI)) xlev <- list(sex=c("male","female"),BMI=c("normal","overweight","obese")) parseInteractionTerms(terms=tt,xlevels=xlev) parseInteractionTerms(terms=tt,xlevels=xlev,format.factor="var level") parseInteractionTerms(terms=tt,xlevels=xlev,format.contrast="var(level:ref)") tt2 <- terms(formula(SBP~age*factor(sex)+BMI)) xlev2 <- list("factor(sex)"=c("male","female")) parseInteractionTerms(terms=tt2,xlevels=xlev2) parseInteractionTerms(terms=tt2,xlevels=xlev2,units=list(age="yrs")) data(Diabetes) fit <- glm(bp.2s~age*factor(gender)+BMI,data=Diabetes) parseInteractionTerms(terms=terms(fit$formula),xlevels=fit$xlevels, format.scale="var -- level:ref",units=list("age"='years')) parseInteractionTerms(terms=terms(fit$formula),xlevels=fit$xlevels, format.scale.unit="var [unit]",units=list("age"='years')) it <- parseInteractionTerms(terms=terms(fit$formula),xlevels=fit$xlevels) ivars <- unlist(lapply(it,function(x)attr(x,"variables"))) lava::estimate(fit,function(p)lapply(unlist(it),eval,envir=sys.parent(-1))) } \seealso{ lava::estimate } \author{ Thomas A. Gerds } Publish/man/plot.regressionTable.Rd0000644000176200001440000000275714142666146017054 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot.regressionTable.R \name{plot.regressionTable} \alias{plot.regressionTable} \title{Plotting regression coefficients with confidence limits} \usage{ \method{plot}{regressionTable}(x, xlim, xlab, style = 1, ...) } \arguments{ \item{x}{regression table obtained with regressionTable} \item{xlim}{Limits for x-axis} \item{xlab}{Label for x-axis} \item{style}{Determines how to arrange variable names and their corresponding units} \item{...}{passed to plotConfidence} } \description{ Plotting regression coefficients with confidence limits } \examples{ ## linear regression data(Diabetes) f <- glm(bp.1s~AgeGroups+chol+gender+location,data=Diabetes) rtf <- regressionTable(f,factor.reference = "inline") plot(rtf,cex=1.3) ## logistic regression data(Diabetes) f <- glm(I(BMI>25)~bp.1s+AgeGroups+chol+gender+location,data=Diabetes,family=binomial) rtf <- regressionTable(f,factor.reference = "inline") plot(rtf,cex=1.3) ## Poisson regression data(trace) fit <- glm(dead ~ smoking+ sex+ age+Time+offset(log(ObsTime)), family = poisson,data=trace) rtab <- regressionTable(fit,factor.reference = "inline") plot(rtab,xlim=c(0.85,1.15),cex=1.8,xaxis.cex=1.5) ## Cox regression library(survival) data(pbc) coxfit <- coxph(Surv(time,status!=0)~age+log(bili)+log(albumin)+factor(edema)+sex,data=pbc) pubcox <- publish(coxfit) plot(pubcox,cex=1.5,xratio=c(0.4,0.2)) } \seealso{ regressionTable } \author{ Thomas A. Gerds } Publish/man/org.Rd0000755000176200001440000000057514142666146013535 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/org.R \name{org} \alias{org} \title{Wrapper function for publish with output format org} \usage{ org(x, ...) } \arguments{ \item{x}{object to format as org} \item{...}{passed to publish} } \value{ See publish } \description{ Wrapper for \code{publish(...,org=TRUE)} } \author{ Thomas Alexander Gerds } Publish/man/lazyFactorCoding.Rd0000755000176200001440000000177614142666146016214 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/lazyFactorCoding.R \name{lazyFactorCoding} \alias{lazyFactorCoding} \title{Efficient coding of factor levels} \usage{ lazyFactorCoding(data, max.levels = 10) } \arguments{ \item{data}{Data frame in which to search for categorical variables.} \item{max.levels}{Treat non-factor variables only if the number of unique values less than max.levels. Defaults to 10.} } \value{ R-code one line for each variable. } \description{ This function eases the process of generating factor variables with relevant labels. All variables in a data.frame with less than a user set number of levels result in a line which suggests levels and labels. The result can then be modified for use. } \details{ The code needs to be copy-and-pasted from the R-output buffer into the R-code buffer. This can be customized for the really efficiently working people e.g. in emacs. } \examples{ data(Diabetes) lazyFactorCoding(Diabetes) } \author{ Thomas Alexander Gerds } Publish/man/formatCI.Rd0000644000176200001440000000462614142666146014450 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/formatCI.R \name{formatCI} \alias{formatCI} \title{Formatting confidence intervals} \usage{ formatCI( x, lower, upper, show.x = FALSE, handler = "sprintf", format = "[l;u]", degenerated = "asis", digits = 2, nsmall = digits, sep = "", reference.pos, reference.label = "", ... ) } \arguments{ \item{x}{not used (for compatibility with format)} \item{lower}{Numeric vector of lower limits} \item{upper}{Numeric vector of upper limits} \item{show.x}{Logical. If \code{TRUE} show value of x in front of confidence interval.} \item{handler}{Function to format numeric values. Default is \code{sprintf}, also supported are \code{format} and \code{prettyNum}} \item{format}{Character string in which \code{l} will be replaced by the value of the lower limit (argument lower) and \code{u} by the value of the upper upper limit. For example, \code{(l,u)} yields confidence intervals in round parenthesis in which the upper and lower limits are comma separated. Default is \code{[l;u]}.} \item{degenerated}{String to show when lower==upper. Default is '--'} \item{digits}{If handler \code{format} or \code{prettyNum} used format numeric vectors.} \item{nsmall}{If handler \code{format} or \code{prettyNum} used format numeric vectors.} \item{sep}{Field separator} \item{reference.pos}{Position of factor reference} \item{reference.label}{Label for factor reference} \item{...}{passed to handler} } \value{ String vector with confidence intervals } \description{ Format confidence intervals } \details{ The default format for confidence intervals is [lower; upper]. } \examples{ x=ci.mean(rnorm(10)) formatCI(lower=x[3],upper=x[4]) formatCI(lower=c(0.001,-2.8413),upper=c(1,3.0008884)) # change format formatCI(lower=c(0.001,-2.8413),upper=c(1,3.0008884),format="(l, u)") # show x formatCI(x=x$mean,lower=x$lower,upper=x$upper,format="(l, u)",show.x=TRUE) # change of handler function l <- c(-0.0890139,0.0084736,144.898333,0.000000001) u <- c(0.03911392,0.3784706,3338944.8821221,0.00001) cbind(format=formatCI(lower=l,upper=u,format="[l;u)",digits=2,nsmall=2,handler="format"), prettyNum=formatCI(lower=l,upper=u,format="[l;u)",digits=2,nsmall=2,handler="prettyNum"), sprintf=formatCI(lower=l,upper=u,format="[l;u)",digits=2,nsmall=2,handler="sprintf")) } \seealso{ plot.ci ci.mean } \author{ Thomas A. Gerds } Publish/man/followupTable.Rd0000644000176200001440000000317615040352720015546 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/followupTable.R \name{followupTable} \alias{followupTable} \title{Summary tables for a given followup time point.} \usage{ followupTable(formula, data, followup.time, compare.groups, ...) } \arguments{ \item{formula}{Formula A formula whose left hand side is a \code{Hist} object. In some special cases it can also be a \code{Surv} response object. The right hand side is as in \link{utable}.} \item{data}{A data.frame in which all the variables of \code{formula} can be interpreted.} \item{followup.time}{Time point at which to evaluate outcome status.} \item{compare.groups}{Method for comparing groups.} \item{...}{Passed to \code{utable}. All arguments of \code{utable} can be controlled in this way except for \code{compare.groups} which is set to \code{"Cox"}. See details.} } \value{ Summary table. } \description{ Summarize baseline variables in groups defined by outcome at a given followup time point } \details{ If \code{compare.groups!=FALSE}, p-values are obtained from stopped Cox regression, i.e., all events are censored at follow-up time. A univariate Cox regression model is fitted to assess the effect of each variable on the right hand side of the formula on the event hazard and shown is the p-value of \code{anova(fit)}. } \examples{ library(survival) data(pbc) pbc$edema <- factor(pbc$edema,levels=c("0","0.5","1"),labels=c("0","0.5","1")) pbc$sex <- factor(pbc$sex,levels=c("m","f"),labels=c("m","f")) followupTable(Hist(time,status)~age+edema+sex,data=pbc,followup.time=1000) } \seealso{ univariateTable } \author{ Thomas A. Gerds } Publish/man/sutable.Rd0000644000176200001440000000131214142666146014370 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/sutable.R \name{sutable} \alias{sutable} \title{Fast summary of a univariate table} \usage{ sutable(...) } \arguments{ \item{...}{Unnamed arguments and are passed to \code{univariateTable} as well as named arguments that match \code{univariateTable}'s arguments, other arguments are passed to \code{summary.univariateTable}} } \value{ Summary table } \description{ First apply univariateTable then call summary. } \examples{ data(Diabetes) sutable(gender~age+location+Q(BMI)+height+weight,data=Diabetes,BMI="Body mass index (kg/m^2)") } \seealso{ summary.univariateTable univariateTable } \author{ Thomas A. Gerds } Publish/man/specialFrame.Rd0000644000176200001440000000707315040352720015322 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/specialFrame.R \name{specialFrame} \alias{specialFrame} \title{Special frame} \usage{ specialFrame( formula, data, unspecials.design = TRUE, specials, specials.factor = TRUE, specials.design = FALSE, strip.specials = TRUE, strip.arguments = NULL, strip.alias = NULL, strip.unspecials = NULL, drop.intercept = TRUE, response = TRUE, na.action = options()$na.action ) } \arguments{ \item{formula}{Formula whose left hand side specifies the event history, i.e., either via Surv() or Hist().} \item{data}{Data frame in which the formula is interpreted} \item{unspecials.design}{Passed as is to \link[prodlim]{model.design}.} \item{specials}{Character vector of special function names. Usually the body of the special functions is function(x)x but e.g., \link[survival]{strata} does treat the values} \item{specials.factor}{Passed as is to \link[prodlim]{model.design}.} \item{specials.design}{Passed as is to \link[prodlim]{model.design}} \item{strip.specials}{Passed as \code{specials} to \link[prodlim]{strip.terms}} \item{strip.arguments}{Passed as \code{arguments} to \link[prodlim]{strip.terms}} \item{strip.alias}{Passed as \code{alias.names} to \link[prodlim]{strip.terms}} \item{strip.unspecials}{Passed as \code{unspecials} to \link[prodlim]{strip.terms}} \item{drop.intercept}{Passed as is to \link[prodlim]{model.design}} \item{response}{If FALSE do not get response data.} \item{na.action}{Decide what to do with missing values.} } \value{ A list which contains - the response - the design matrix (see \link[prodlim]{model.design}) - one entry for each special (see \link[prodlim]{model.design}) } \description{ Extract data and design matrix including specials from call } \details{ Obtain a list with the data used for event history regression analysis. This function cannot be used directly on the user level but inside a function to prepare data for survival analysis. } \examples{ ## Here are some data with an event time and no competing risks ## and two covariates X1 and X2. ## Suppose we want to declare that variable X1 is treated differently ## than variable X2. For example, X1 could be a cluster variable, or ## X1 should have a proportional effect on the outcome. d <- data.frame(y=1:7, X2=c(2.24,3.22,9.59,4.4,3.54,6.81,5.05), X3=c(1,1,1,1,0,0,1), X4=c(44.69,37.41,68.54,38.85,35.9,27.02,41.84), X1=factor(c("a","b","a","c","c","a","b"), levels=c("c","a","b"))) ## define special functions prop and cluster prop <- function(x)x cluster <- function(x)x ## We pass a formula and the data e <- specialFrame(y~prop(X1)+X2+cluster(X3)+X4, data=d, specials=c("prop","cluster")) ## The first element is the response e$response ## The other elements are the design, i.e., model.matrix for the non-special covariates e$design ## and a data.frame for the special covariates e$prop ## The special covariates can be returned as a model.matrix e2 <- specialFrame(y~prop(X1)+X2+cluster(X3)+X4, data=d, specials=c("prop","cluster"), specials.design=TRUE) e2$prop ## and the non-special covariates can be returned as a data.frame e3 <- specialFrame(y~prop(X1)+X2+cluster(X3)+X4, data=d, specials=c("prop","cluster"), specials.design=TRUE, unspecials.design=FALSE) e3$design } \seealso{ model.frame model.design Hist } \author{ Thomas A. Gerds } Publish/man/CiTable.Rd0000644000176200001440000000127514142666146014244 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/publish-package.R \docType{data} \name{CiTable} \alias{CiTable} \title{CiTable data} \format{ A data frame with 27 observations on the following 9 variables. \describe{ \item{Drug}{} \item{Time}{} \item{Drug.Time}{} \item{Dose}{} \item{Mean}{} \item{SD}{} \item{n}{} \item{HazardRatio}{} \item{lower}{} \item{upper}{} \item{p}{} } } \description{ These data are used for testing Publish package functionality. } \examples{ data(CiTable) labellist <- split(CiTable[,c("Dose","Mean","SD","n")],CiTable[,"Drug"]) labellist plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], labels=labellist) } \keyword{datasets} Publish/man/lazyDateCoding.Rd0000644000176200001440000000212514142666146015635 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/lazyDateCoding.R \name{lazyDateCoding} \alias{lazyDateCoding} \title{Efficient coding of date variables} \usage{ lazyDateCoding(data, format, pattern, varnames, testlength = 10) } \arguments{ \item{data}{Data frame in which to search for date variables.} \item{format}{passed to as.Date} \item{pattern}{match date variables} \item{varnames}{variable names} \item{testlength}{how many rows of data should be evaluated to guess the format.} } \value{ R-code one line for each variable. } \description{ This function eases the process of generating date variables. All variables in a data.frame which match a regular expression are included } \details{ The code needs to be copy-and-pasted from the R-output buffer into the R-code buffer. This can be customized for the really efficiently working people, e.g., in emacs. } \examples{ d <- data.frame(x0="190101",x1=c("12/8/2019"),x2="12-8-2019",x3="20190812",stringsAsFactors=FALSE) lazyDateCoding(d,pattern="x") lazyDateCoding(d,pattern="3") } \author{ Thomas Alexander Gerds } Publish/man/splinePlot.lrm.Rd0000644000176200001440000000330114142666146015653 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/splinePlot.lrm.R \name{splinePlot.lrm} \alias{splinePlot.lrm} \title{Plot predictions of logistic regression} \usage{ splinePlot.lrm( object, xvar, xvalues, xlim = range(xvalues), ylim, xlab = xvar, ylab = scale[[1]], col = 1, lty = 1, lwd = 3, confint = TRUE, newdata = NULL, scale = c("risk", "odds"), add = FALSE, ... ) } \arguments{ \item{object}{Logistic regression model fitted with \code{rms::lrm}} \item{xvar}{Name of the variable to show on x-axis} \item{xvalues}{Sequence of \code{xvar} values} \item{xlim}{x-axis limits} \item{ylim}{y-axis limits} \item{xlab}{x-axis labels} \item{ylab}{y-axis labels} \item{col}{color of the line} \item{lty}{line style} \item{lwd}{line width} \item{confint}{Logical. If \code{TRUE} show confidence shadows} \item{newdata}{How to adjust} \item{scale}{Character string that determines the outcome scale (y-axis). Choose between \code{"risk"} and \code{"odds"}.} \item{add}{Logical. If \code{TRUE} add lines to an existing graph} \item{...}{Further arguments passed to \code{plot}. Only if \code{add} is \code{FALSE}.} } \description{ Plotting the prediction of a logistic regression model with confidence bands against one continuous variable. } \details{ Function which extracts from a logistic regression model fitted with \code{rms::lrm} the predicted risks or odds. } \examples{ data(Diabetes) Diabetes$hypertension= 1*(Diabetes$bp.1s>140) library(rms) uu <- datadist(Diabetes) options(datadist="uu") fit=lrm(hypertension~rcs(age)+gender+hdl,data=Diabetes) splinePlot.lrm(fit,xvar="age",xvalues=seq(30,50,1)) } \author{ Thomas A. Gerds } Publish/man/summary.univariateTable.Rd0000755000176200001440000000500514142666146017552 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/summary.univariateTable.R \name{summary.univariateTable} \alias{summary.univariateTable} \alias{summary.utable} \title{Preparing univariate tables for publication} \usage{ \method{summary}{univariateTable}( object, n = "inNames", drop.reference = FALSE, pvalue.stars = FALSE, pvalue.digits = 4, show.missing = c("ifany", "always", "never"), show.pvalues, show.totals, ... ) } \arguments{ \item{object}{\code{univariateTable} object as obtained with function \code{univariateTable}.} \item{n}{If not missing, show the number of subjects in each column. If equal to \code{"inNames"}, show the numbers in parentheses in the column names. If missing the value \code{object$n} is used.} \item{drop.reference}{Logical or character (vector). Decide if line with reference level should be suppressed for factors. If \code{TRUE} or \code{"all"} suppress for all categorical factors. If \code{'binary'} suppress only for binary variables. Can be character vector in which case reference lines are suppressed for variables that are included in the vector.} \item{pvalue.stars}{If TRUE use \code{symnum} to parse p-values otherwise use \code{format.pval}.} \item{pvalue.digits}{Passed to \code{format.pval}.} \item{show.missing}{Decides if number of missing values are shown in table. Defaults to \code{"ifany"}, and can also be set to \code{"always"} or \code{"never"}.} \item{show.pvalues}{Logical. If set to \code{FALSE} the column \code{p-values} is removed. If missing the value \code{object$compare.groups[[1]]==TRUE} is used.} \item{show.totals}{Logical. If set to \code{FALSE} the column \code{Totals} is removed. If missing the value \code{object$show.totals} is used.} \item{...}{passed on to \code{labelUnits}. This overwrites labels stored in \code{object$labels}} } \value{ Summary table } \description{ Summary function for univariate table } \details{ Collects results of univariate table in a matrix. } \examples{ data(Diabetes) u <- univariateTable(gender~age+location+Q(BMI)+height+weight, data=Diabetes) summary(u) summary(u,n=NULL) summary(u,pvalue.digits=2,"age"="Age (years)","height"="Body height (cm)") u2 <- univariateTable(location~age+AgeGroups+gender+height+weight, data=Diabetes) summary(u2) summary(u2,drop.reference=TRUE) ## same but more flexible summary(u2,drop.reference=c("binary")) ## same but even more flexible summary(u2,drop.reference=c("gender")) } \author{ Thomas A. Gerds } Publish/man/publish.Score.Rd0000644000176200001440000000270414142666146015457 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/publish.Score.R \name{publish.Score} \alias{publish.Score} \title{Publish predictive accuracy results} \usage{ \method{publish}{Score}(object, metrics, score = TRUE, contrasts = TRUE, level = 3, ...) } \arguments{ \item{object}{Object obtained with \code{riskRegression::Score}} \item{metrics}{Which metrics to put into tables. Defaults to \code{object$metrics}.} \item{score}{Logical. If \code{TRUE} print the score elements, i.e., metric applied to the risk prediction models.} \item{contrasts}{Logical. If \code{TRUE} print the contrast elements (if any). These compare risk prediction models according to metrics.} \item{level}{Level of subsection headers, i.e., ** for level 2 and *** for level 3 (useful for emacs org-users). Default is plain subsection headers no stars. A negative value will suppress subjection headers.} \item{...}{Passed to publish} } \value{ Results of Score in tabular form } \description{ Write output of \code{riskRegression::Score} in tables } \details{ Collect prediction accuracy results in tables } \examples{ if (requireNamespace("riskRegression",quietly=TRUE)){ library(riskRegression) library(survival) learn = sampleData(100) val= sampleData(100) f1=CSC(Hist(time,event)~X1+X8,data=learn) f2=CSC(Hist(time,event)~X1+X5+X6+X8,learn) xs=Score(list(f1,f2),data=val,formula=Hist(time,event)~1) publish(xs) } } \author{ Thomas A. Gerds } Publish/man/plotConfidence.Rd0000644000176200001440000004321215040352720015656 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plotConfidence.R \name{plotConfidence} \alias{plotConfidence} \title{Plot confidence intervals} \usage{ plotConfidence( x, y.at, lower, upper, pch = 16, cex = 1, lwd = 1, col = 4, xlim, xlab, labels, title.labels, values, title.values, section.pos, section.sep, section.title = NULL, section.title.x, section.title.offset, order, leftmargin = 0.025, rightmargin = 0.025, stripes, factor.reference.pos, factor.reference.label = "Reference", factor.reference.pch = 16, refline = 1, title.line = TRUE, xratio, y.offset = 0, y.title.offset, digits = 2, format, extremearrows.length = 0.05, extremearrows.angle = 30, add = FALSE, layout = TRUE, xaxis = TRUE, ... ) } \arguments{ \item{x}{Either a vector containing the point estimates or a list whose first element contains the point estimates. Further list elements can contain the confidence intervals and labels. In this case the list needs to have names 'lower' and 'upper' to indicate the values of the lower and the upper limits of the confidence intervals, respectively, and may have an element 'labels' which is a vector or matrix or list with labels.} \item{y.at}{Optional vector of y-position for the confidence intervals and corresponding values and labels.} \item{lower}{Lower confidence limits. Used if object \code{x} is a vector and if \code{x} is a list \code{lower} overwrites element \code{x$lower}.} \item{upper}{Upper confidence limits. Used if object \code{x} is a vector and if \code{x} is a list \code{upper} overwrites element \code{x$upper}.} \item{pch}{Symbol for points.} \item{cex}{Defaults size of all figures and plotting symbol. Single elements are controlled separately. See \code{...}.} \item{lwd}{Default width of all lines Single elements are controlled separately. See \code{...}.} \item{col}{Default colour of confidence intervals.} \item{xlim}{Plotting limits for the confidence intervals. See also \code{xratio} on how to control the layout.} \item{xlab}{Label for the x-axis.} \item{labels}{Vector or matrix or list with \code{labels}. Used if object \code{x} is a vector and if \code{x} is a list it overwrites element \code{x$labels}. To avoid drawing of labels, set \code{labels=FALSE}.} \item{title.labels}{Main title for the column which shows the \code{labels}. If \code{labels} is a matrix or list \code{title.labels} should be a vector with as many elements as labels has columns or elements.} \item{values}{Either logical or vector, matrix or list with values. If \code{values=TRUE} values are constructed according to \code{format} from \code{lower} and \code{upper} overwrites constructed values. If \code{values=FALSE} do not draw values.} \item{title.values}{Main title for the column \code{values}. If \code{values} is a matrix or list \code{title.labels} should be a vector with as many elements as values has columns or elements.} \item{section.pos}{Vector with y-axis posititions for section.titles.} \item{section.sep}{Amount of space between paragraphs (applies only if \code{labels} is a named list)} \item{section.title}{Intermediate section headings.} \item{section.title.x}{x-position for section.titles} \item{section.title.offset}{Y-offset for section.titles} \item{order}{Order of the three columns: labels, confidence limits, values. See examples.} \item{leftmargin}{Percentage of plotting region used for leftmargin. Default is 0.025. See also Details.} \item{rightmargin}{Percentage of plotting region used for rightmargin. Default is 0.025. See also Details.} \item{stripes}{Vector of up to three Logicals. If \code{TRUE} draw stripes into the background. The first applies to the labels, the second to the graphical presentation of the confidence intervals and the third to the values. Thus, stripes} \item{factor.reference.pos}{Position at which factors attain reference values.} \item{factor.reference.label}{Label to use at \code{factor.reference.pos} instead of values.} \item{factor.reference.pch}{Plotting symbol to use at \code{factor.reference.pos}} \item{refline}{Position of a vertical line to indicate the null hypothesis. Default is 1 which would work for odds ratios and hazard ratios.} \item{title.line}{Position of a horizontal line to separate the title line from the plot} \item{xratio}{One or two values between 0 and 1 which determine how to split the plot window in horizontal x-direction. If there are two columns (labels, CI) or (CI, values) only one value is used and the default is 0.618 (goldener schnitt) which gives the graphical presentation of the confidence intervals 38.2 % of the graph. The remaining 61.8 % are used for the labels (or values). If there are three columns (labels, CI, values), xratio has two values which default to fractions of 0.7 according to the relative widths of labels and values, thus by default only 0.3 are used for the graphical presentation of the confidence intervals. The remaining 30 % are used for the graphical presentation of the confidence intervals. See examles.} \item{y.offset}{Either a single value or a vector determining the vertical offset of all rows. If it is a single value all rows are shifted up (or down if negative) by this value. This can be used to add a second set of confidence intervals to an existing graph or to achieve a visual grouping of rows that belong together. See examples.} \item{y.title.offset}{Numeric value by which to vertically shift the titles of the labels and values.} \item{digits}{Number of digits, passed to \code{pubformat} and \code{formatCI}.} \item{format}{Format for constructing values of confidence intervals. Defaults to '(u;l)' if there are negative lower or upper values and to '(u-l)' otherwise.} \item{extremearrows.length}{Length of the arrows in case of confidence intervals that stretch beyond xlim.} \item{extremearrows.angle}{Angle of the arrows in case of confidence intervals that stretch beyond xlim.} \item{add}{Logical. If \code{TRUE} do not draw labels or values and add confidence intervals to existing plot.} \item{layout}{Logical. If \code{FALSE} do not call layout. This is useful when several plotConfidence results should be combined in one graph and hence layout is called externally.} \item{xaxis}{Logical. If \code{FALSE} do not draw x-axis.} \item{...}{Used to control arguments of the following subroutines: \code{plot}: Applies to plotting frame of the graphical presentation of confidence intervals. Use arguments of \code{plot}, e.g., \code{plot.main="Odds ratio"}. \code{points}, \code{arrows}: Use arguments of \code{points} and \code{arrows}, respectively. E.g., \code{points.pch=8} and \code{arrows.lwd=2}. \code{refline}: Use arguments of \code{segments}, e.g., \code{refline.lwd=2}. \code{labels}, \code{values}, \code{title.labels}, \code{title.values}: Use arguments of \code{text}, e.g., \code{labels.col="red"} or \code{title.values.cex=1.8}. \code{xaxis}: Use arguments of \code{axis}, e.g., \code{xaxis.at=c(-0.3,0,0.3)} \code{xlab}: Use arguments of \code{mtext}, e.g., \code{xlab.line=2}. \code{stripes}: Use arguments of \code{stripes}. See examples. See examples for usage.} } \value{ List of dimensions and coordinates } \description{ Function to plot confidence intervals with their values and additional labels. One anticipated use of this function involves first the generation of a regression object, then arrangement of a result table with "regressionTable", further arrangment of table with with e.g. "fixRegressionTable" and various user defined changes - and then finally table along with forest plot using the current function. } \details{ Function to plot means and other point estimates with confidence intervals, their values and additional labels . Horizonal margins as determined by par()$mar are ignored. Instead layout is used to divide the plotting region horizontally into two or three parts plus leftmargin and rightmargin. When values is FALSE there are only two parts. The default order is labels on the left confidence intervals on the right. When no labels are given or labels is FALSE there are only two parts. The default order is confidence intervals on the left values on the right. The default order of three parts from left to right is labels, confidence intervals, values. The order can be changed as shown by the examples below. The relative widths of the two or three parts need to be adapted to the actual size of the text of the labels. This depends on the plotting device and the size of the font and figures and thus has to be adjusted manually. Oma can be used to further control horizontal margins, e.g., par(oma=c(0,4,0,4)). If confidence limits extend beyond the range determined by xlim, then arrows are drawn at the x-lim borders to indicate that the confidence limits continue. } \examples{ library(Publish) data(CiTable) ## A first draft version of the plot is obtained as follows plotConfidence(x=CiTable[,c("HazardRatio","lower","upper","p")], labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")]) ## if argument labels is a named list the table is subdivided: labellist <- split(CiTable[,c("Dose","Time","Mean","SD","n")],CiTable[,"Drug"]) labellist ## the data need to be ordered accordingly CC= data.table::rbindlist(split(CiTable[,c("HazardRatio","lower","upper")],CiTable[,"Drug"])) plotConfidence(x=CC, labels=labellist) ## The graph consist of at most three columns: ## ## column 1: labels ## column 2: printed values of the confidence intervals ## column 3: graphical presentation of the confidence intervals ## ## NOTE: column 3 appears always, the user decides if also ## column 1, 2 should appear ## ## The columns are arranged with the function layout ## and the default order is 1,3,2 such that the graphical ## display of the confidence intervals appears in the middle ## ## the order of appearance of the three columns can be changed as follows plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], order=c(1,3,2)) plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], order=c(2,3,1)) ## if there are only two columns the order is 1, 2 plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], values=FALSE, order=c(2,1)) plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], values=FALSE, order=c(1,2)) ## The relative size of the columns needs to be controlled manually ## by using the argument xratio. If there are only two columns plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], xratio=c(0.4,0.15)) ## The amount of space on the left and right margin can be controlled ## as follows: plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], xratio=c(0.4,0.15), leftmargin=0.1,rightmargin=0.00) ## The actual size of the current graphics device determines ## the size of the figures and the space between them. ## The sizes and line widths are increased as follows: plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], xlab="Hazard ratio", labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], points.cex=3, cex=2, lwd=3, xaxis.lwd=1.3, xaxis.cex=1.3) ## Note that 'cex' of axis ticks is controlled via 'par' but ## cex of the label via argument 'cex' of 'mtext'. ## The sizes and line widths are decreased as follows: plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], cex=0.8, lwd=0.8, xaxis.lwd=0.8, xaxis.cex=0.8) ## Another good news is that all figures can be controlled separately ## The size of the graphic device can be controlled in the usual way, e.g.: \dontrun{ pdf("~/tmp/testCI.pdf",width=8,height=8) plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")]) dev.off() } ## More control of the x-axis and confidence intervals that ## stretch outside the x-range end in an arrow. ## the argument xlab.line adjusts the distance of the x-axis ## label from the graph plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], xlab="Hazard ratio", xlab.line=1.8, xaxis.at=c(0.8,1,1.3), labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], xlim=c(0.8,1.3)) ## log-scale plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], xlab="Hazard ratio", xlab.line=1.8, xaxis.at=c(0.8,1,1.3), labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], xlim=c(0.8,1.3),plot.log="x") ## More pronounced arrows ## Coloured xlab expression plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], xlab=expression(HR[1](s)), xlab.line=1.8, xlab.col="darkred", extremearrows.angle=50, extremearrows.length=0.1, labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], xlim=c(0.8,1.3)) ## Controlling the labels and their titles ## and the values and their titles plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], xlab="Hazard ratio", title.values=expression(bold(HR (CI[95]))), title.labels=c("Drug/Time","Dose","Mean","St.dev.","N"), factor.reference.pos=c(1,10,19), factor.reference.pch=16, cex=1.3, xaxis.at=c(0.75,1,1.25,1.5,2)) ## For factor reference groups, one may want to replace the ## confidence intervals by the word Reference, as in the previous example. ## To change the word 'Reference' we use the argument factor.reference.label: ## To change the plot symbol for the reference lines factor.reference.pch ## To remove the plot symbol in the reference lines use 'NA' as follows: plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], xlab="Hazard ratio", factor.reference.label="Ref", title.values=expression(bold(HR (CI[95]))), title.labels=c("Drug/Time","Dose","Mean","St.dev.","N"), factor.reference.pos=c(1,10,19), factor.reference.pch=NA, cex=1.3, xaxis.at=c(0.75,1,1.25,1.5,2)) ## changing the style of the graphical confidence intervals plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], xlab="Hazard ratio", factor.reference.pos=c(1,10,19), points.pch=15, points.col=rainbow(27), points.cex=2, arrows.col="darkblue", cex=1.3, order=c(1,3,2), xaxis.at=c(0.75,1,1.25,1.5)) ## the values column of the graph can have multiple columns as well ## to illustrate this we create the confidence intervals ## before calling the function and then cbind them ## to the pvalues HR <- pubformat(CiTable[,6]) CI95 <- formatCI(lower=CiTable[,7],upper=CiTable[,8],format="(l-u)") pval <- format.pval(CiTable[,9],digits=3,eps=10^{-3}) pval[pval=="NA"] <- "" plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], values=list("HR"=HR,"CI-95"=CI95,"P-value"=pval), cex=1.2, xratio=c(0.5,0.3)) ## Finally, vertical columns can be delimited with background color ## NOTE: this may slow things down and potentially create ## large figures (many bytes) col1 <- rep(c(prodlim::dimColor("green",density=22), prodlim::dimColor("green")),length.out=9) col2 <- rep(c(prodlim::dimColor("orange",density=22), prodlim::dimColor("orange")),length.out=9) col3 <- rep(c(prodlim::dimColor("blue",density=22), prodlim::dimColor("blue")),length.out=9) plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], stripes=c(1,0,1), stripes.col=c(col1,col2,col3)) plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], stripes=c(1,1,1), stripes.col=c(col1,col2,col3)) threegreens <- c(prodlim::dimColor("green",density=55), prodlim::dimColor("green",density=33), prodlim::dimColor("green",density=22)) plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], values=FALSE, xlim=c(0.75,1.5), stripes=c(1,1,1), xratio=c(0.5,0.15), stripes.horizontal=c(0,9,18,27)+0.5, stripes.col=threegreens) # combining multiple plots into one layout(t(matrix(1:5))) plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], labels=CiTable[,c("Mean","n")], layout=FALSE) plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], layout=FALSE) } \author{ Thomas A. Gerds } Publish/man/glmSeries.Rd0000755000176200001440000000320014142666146014664 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/glmSeries.R \name{glmSeries} \alias{glmSeries} \title{Run a series of generalized linear regression analyses} \usage{ glmSeries(formula, data, vars, ...) } \arguments{ \item{formula}{The fixed part of the regression formula. For univariate analyses this is simply \code{y~1} where \code{y} is the outcome variable. When the aim is to control the effect of \code{vars} in each element of the series by a fixed set of variables it is \code{y~x1+x2} where again y is the outcome and x1 and x2 are confounders.} \item{data}{A \code{data.frame} in which we evaluate the formula.} \item{vars}{A list of variable names, the changing part of the regression formula.} \item{...}{passed to glm} } \value{ Matrix with regression coefficients, one for each element of \code{vars}. } \description{ Run a series of generalized linear regression analyses for a list of predictor variables and summarize the results in a table. The regression models can be adjusted for a fixed set of covariates. } \examples{ data(Diabetes) Diabetes$hyper1 <- factor(1*(Diabetes$bp.1s>140)) ## collect odds ratios from three univariate logistic regression analyses uni.odds <- glmSeries(hyper1~1,vars=c("chol","hdl","location"),data=Diabetes,family=binomial) uni.odds ## control the logistic regression analyses for age and gender ## but collect only information on the variables in `vars'. controlled.odds <- glmSeries(hyper1~age+gender, vars=c("chol","hdl","location"), data=Diabetes, family=binomial) controlled.odds } \author{ Thomas Alexander Gerds } Publish/man/publish.Rd0000755000176200001440000000120214142666146014400 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/publish.R \name{publish} \alias{publish} \title{Publishing tables and figures} \usage{ publish(object, ...) } \arguments{ \item{object}{object to be published} \item{...}{Passed to method.} } \value{ Tables and figures } \description{ Publish provides summary functions for data and results of statistical analysis in ready-for-publication design } \details{ Some warnings are currently suppressed. } \seealso{ publish.CauseSpecificCox publish.ci publish.coxph publish.glm publish.riskRegression publish.survdiff } \author{ Thomas A. Gerds } Publish/man/print.subgroupAnalysis.Rd0000644000176200001440000000120514142666146017437 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/print.subgroupAnalysis.R \name{print.subgroupAnalysis} \alias{print.subgroupAnalysis} \title{Printing univariate tables} \usage{ \method{print}{subgroupAnalysis}(x, ...) } \arguments{ \item{x}{- An object obtained with \code{subgroupAnalysis}} \item{...}{Passed to summary.subgroupAnalysis} } \value{ The result of \code{summary.subgroupAnalysis(x)} } \description{ Print function for subgroupAnalysis } \details{ This function is simply calling \code{summary.subgroupAnalysis} } \seealso{ \code{subgroupAnalysis} } \author{ Christian Torp-Pedersen (ctp@heart.dk) } Publish/man/print.univariateTable.Rd0000644000176200001440000000117014142666146017205 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/print.univariateTable.R \name{print.univariateTable} \alias{print.univariateTable} \title{Printing univariate tables} \usage{ \method{print}{univariateTable}(x, ...) } \arguments{ \item{x}{An object obtained with \code{univariateTable}} \item{...}{Passed to summary.univariateTable} } \value{ The result of \code{summary.univariateTable(x)} } \description{ Print function for univariate tables } \details{ This function is simply calling \code{summary.univariateTable} } \seealso{ \code{univariateTable} } \author{ Thomas A. Gerds } Publish/man/coxphSeries.Rd0000755000176200001440000000322614142666146015236 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/coxphSeries.R \name{coxphSeries} \alias{coxphSeries} \title{Run a series of Cox regression models} \usage{ coxphSeries(formula, data, vars, ...) } \arguments{ \item{formula}{The fixed part of the regression formula. For univariate analyses this is simply \code{Surv(time,status)~1} where \code{Surv(time,status)} is the outcome variable. When the aim is to control the effect of \code{vars} in each element of the series by a fixed set of variables it is \code{Surv(time,status)~x1+x2} where again Surv(time,status) is the outcome and x1 and x2 are confounders.} \item{data}{A \code{data.frame} in which the \code{formula} gets evaluated.} \item{vars}{A list of variable names, the changing part of the regression formula.} \item{...}{passed to publish.coxph} } \value{ matrix with results } \description{ Run a series of Cox regression analyses for a list of predictor variables and summarize the results in a table. The Cox models can be adjusted for a fixed set of covariates This function runs on \code{coxph} from the survival package. } \examples{ library(survival) data(pbc) ## collect hazard ratios from three univariate Cox regression analyses pbc$edema <- factor(pbc$edema,levels=c("0","0.5","1"),labels=c("0","0.5","1")) uni.hr <- coxphSeries(Surv(time,status==2)~1,vars=c("edema","bili","protime"),data=pbc) uni.hr ## control the logistic regression analyses for age and gender ## but collect only information on the variables in `vars'. controlled.hr <- coxphSeries(Surv(time,status==2)~age+sex,vars=c("edema","bili","protime"),data=pbc) controlled.hr } \author{ Thomas Alexander Gerds } Publish/man/stripes.Rd0000644000176200001440000000346315040352720014417 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/stripes.R \name{stripes} \alias{stripes} \title{Background and grid color control.} \usage{ stripes( xlim, ylim, col = "white", lwd = 1, gridcol = "gray77", fill = "white", horizontal = NULL, vertical = NULL, border = "black", xpd = FALSE ) } \arguments{ \item{xlim}{Limits for the horizontal x-dimension. Defaults to par("usr")[1:2].} \item{ylim}{Limits for the vertical y-dimension.} \item{col}{Colors use for the stripes. Can be a vector of colors which are then repeated appropriately.} \item{lwd}{Line width} \item{gridcol}{Color of grid lines} \item{fill}{Color to fill the background rectangle given by par("usr").} \item{horizontal}{Numerical values at which to show horizontal grid lines, and at which to change the color of the stripes.} \item{vertical}{Numerical values at which to show vertical grid lines.} \item{border}{If a fill color is provided, the color of the border around the background.} \item{xpd}{From \code{help(par)}: A logical value or NA. If FALSE, all plotting is clipped to the plot region, if TRUE, all plotting is clipped to the figure region, and if NA, all plotting is clipped to the device region. See also \code{clip}.} } \description{ Some users like background colors, and it may be helpful to have grid lines to read off e.g. probabilities from a Kaplan-Meier graph. Both things can be controlled with this function. However, it mainly serves \link[prodlim]{plot.prodlim}. } \examples{ plot(0,0) backGround(bg="beige",fg="red",vertical=0,horizontal=0) plot(0,0) stripes(col=c("yellow","green"),gridcol="red",xlim=c(-1,1),horizontal=seq(0,1,.1)) stripes(col=c("yellow","green"),gridcol="red",horizontal=seq(0,1,.1)) } \author{ Thomas Alexander Gerds } \keyword{survival} Publish/man/publish.riskRegression.Rd0000644000176200001440000000202015040352073017371 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/publish.riskRegression.R \name{publish.riskRegression} \alias{publish.riskRegression} \title{Publishing results of riskRegression} \usage{ \method{publish}{riskRegression}(object, digits = c(2, 4), print = TRUE, ...) } \arguments{ \item{object}{object of class riskRegression as obtained with functions ARR and LRR.} \item{digits}{Number of digits for regression coefficients} \item{print}{If \code{FALSE} do not print the results} \item{...}{passed to \link{publish.matrix}} } \value{ Table with regression coefficients, confidence intervals and p-values } \description{ Preparing a publishable table from riskRegression results } \examples{ if (requireNamespace("riskRegression",quietly=TRUE)){ library(riskRegression) library(prodlim) library(lava) library(survival) set.seed(20) d <- SimCompRisk(20) f <- ARR(Hist(time,event)~X1+X2,data=d,cause=1) publish(f) publish(f,digits=c(1,3)) } } \seealso{ ARR LRR } \author{ Thomas A. Gerds } Publish/man/print.table2x2.Rd0000644000176200001440000000131214142666146015507 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/print.table2x2.R \name{print.table2x2} \alias{print.table2x2} \title{print results of 2x2 contingency table analysis} \usage{ \method{print}{table2x2}(x, digits = 1, ...) } \arguments{ \item{x}{object obtained with table2x2} \item{digits}{rounding digits} \item{...}{not used} } \value{ invisible x } \description{ print results of 2x2 contingency table analysis } \examples{ table2x2(table("marker"=rbinom(100,1,0.4),"response"=rbinom(100,1,0.1))) table2x2(matrix(c(71,18,38,8),ncol=2),stats="table") table2x2(matrix(c(71,18,38,8),ncol=2),stats=c("rr","fisher")) } \seealso{ table2x2 } \author{ Thomas A. Gerds } Publish/man/publish.summary.aov.Rd0000644000176200001440000000142414142666146016663 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/publish.summary.aov.R \name{publish.summary.aov} \alias{publish.summary.aov} \title{Format summary table of aov results} \usage{ \method{publish}{summary.aov}( object, print = TRUE, handler = "sprintf", digits = c(2, 4), nsmall = digits, ... ) } \arguments{ \item{object}{glm object} \item{print}{Logical. Decide about whether or not to print the results.} \item{handler}{see \code{pubformat}} \item{digits}{see \code{pubformat}} \item{nsmall}{see \code{pubformat}} \item{...}{used to transport further arguments} } \description{ Format summary table of aov results } \examples{ data(Diabetes) f <- glm(bp.1s~age+chol+gender+location,data=Diabetes) publish(summary(aov(f)),digits=c(1,2)) } Publish/man/plot.ci.Rd0000644000176200001440000000412014142666146014301 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot.ci.R \name{plot.ci} \alias{plot.ci} \title{Plot confidence intervals} \usage{ \method{plot}{ci}(x, xlim, xlab = "", labels, ...) } \arguments{ \item{x}{List, data.frame or other object of this form containing point estimates (first element) and the corresponding confidence intervals as elements lower and upper.} \item{xlim}{Limit of the x-axis} \item{xlab}{Label for the y-axis} \item{labels}{labels} \item{...}{Used to transport arguments to \code{plotConfidence}.} } \description{ Function to plot confidence intervals } \details{ Function to plot means and other point estimates with confidence intervals } \examples{ data(Diabetes) x=ci.mean(bp.2s~AgeGroups,data=Diabetes) plot(x,title.labels="Age groups",xratio=c(0.4,0.3)) x=ci.mean(bp.2s/500~AgeGroups+gender,data=Diabetes) plot(x,xratio=c(0.4,0.2)) plot(x,xratio=c(0.4,0.2), labels=split(x$labels[,"AgeGroups"],x$labels[,"gender"]), title.labels="Age groups") \dontrun{ plot(x, leftmargin=0, rightmargin=0) plotConfidence(x, leftmargin=0, rightmargin=0) data(CiTable) with(CiTable,plotConfidence(x=list(HazardRatio), lower=lower, upper=upper, labels=CiTable[,2:6], factor.reference.pos=c(1,10,19), format="(u-l)", points.col="blue", digits=2)) with(CiTable,Publish::plot.ci(x=list(HazardRatio), lower=lower, upper=upper, labels=CiTable[,2:6], factor.reference.pos=c(1,10,19), format="(u-l)", points.col="blue", digits=2, leftmargin=-2, title.labels.cex=1.1, labels.cex=0.8,values.cex=0.8)) } } \author{ Thomas A. Gerds } Publish/man/traceR.Rd0000644000176200001440000000235014142666146014154 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/publish-package.R \docType{data} \name{traceR} \alias{traceR} \title{traceR data} \format{ A data frame with 1749 observations on the following variables. \describe{ \item{weight}{Weight in kilo} \item{height}{Height in meters} \item{abdominalCircumference}{in centimeters} \item{seCreatinine}{in mmol per liter} \item{wallMotionIndex}{left ventricular function 0-2, 0 worst, 2 normal} \item{observationTime}{time to death or censor} \item{age}{age in years} \item{sex}{0=female,1=male} \item{smoking}{0=never,1=prior,2=current} \item{dead}{0=censor,1=dead} \item{treatment}{placebo or trandolapril} } } \description{ These data are from the TRACE randomised trial, a comparison between the angiotensin converting enzyme inhibitor trandolapril and placebo ford large myocardial infarctions. In all, 1749 patients were randomised. The current data are from a 15 year follow-up. } \examples{ data(trace) Units(trace,list("age"="years")) fit <- glm(dead ~ smoking+sex+age+Time+offset(log(ObsTime)), family="poisson",data=trace) rtf <- regressionTable(fit,factor.reference = "inline") summary(rtf) publish(fit) } \references{ Kober et al 1995 NEJM 333,1670 } \keyword{datasets} Publish/man/regressionTable.Rd0000644000176200001440000001115114142666146016063 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/regressionTable.R \name{regressionTable} \alias{regressionTable} \title{Regression table} \usage{ regressionTable( object, param.method = "coef", confint.method = c("default", "profile", "robust", "simultaneous"), pvalue.method = c("default", "robust", "simultaneous"), factor.reference = "extraline", intercept = 0L, units = NULL, noterms = NULL, probindex = 0L, ... ) } \arguments{ \item{object}{Fitted regression model obtained with \code{lm}, \code{glm} or \code{coxph}.} \item{param.method}{Method to obtain model coefficients.} \item{confint.method}{Method to obtain confidence intervals. Default is 'default' which leads to Wald type intervals using the model based estimate of standard error. 'profile' yields profile likelihood confidence intervals, available from library MASS for \code{lm} and \code{glm} objects. 'robust' uses the sandwich form standard error to construct Wald type intervals (see \code{lava::estimate.default}). 'simultaneous' calls \code{multcomp::glht} to obtain simultaneous confidence intervals.} \item{pvalue.method}{Method to obtain p-values. If \code{'default'} show raw p-values. If \code{'robust'} use p-value corresponding to robust standard error as provided by \code{lava::estimate.default}. If \code{'simultaneous'} call \code{multcomp::glht} to obtain p-values.} \item{factor.reference}{Style for showing results for categorical variables. If \code{'extraline'} show an additional line for the reference category. If \code{'inline'} display as level vs. reference.} \item{intercept}{Logical. If \code{FALSE} suppress intercept.} \item{units}{List of units for continuous variables. See examples.} \item{noterms}{Position of terms that should be ignored. E.g., for a Cox model with a cluster(id) term, there will be no hazard ratio for variable id.} \item{probindex}{Logical. If \code{TRUE} show coefficients on probabilistic index scale instead of hazard ratio scale.} \item{...}{Not yet used} } \value{ List of regression blocks } \description{ Tabulate the results of a regression analysis. } \details{ The basic use of this function is to generate a near publication worthy table from a regression object. As with summary(object) reference levels of factor variables are not included. Expansion of the table with such values can be performed using the "fixRegressionTable" function. Forest plot can be added to the output with "plotRegressionTable". regressionTable produces an object (list) with the parameters deriveds. The summary function creates a data frame which can be used as a (near) publication ready table. The table shows changes in mean for linear regression, odds ratios for logistic regression (family = binomial) and hazard ratios for Cox regression. } \examples{ # linear regression data(Diabetes) f1 <- glm(bp.1s~age+gender+frame+chol,data=Diabetes) summary(regressionTable(f1)) summary(regressionTable(f1,units=list("chol"="mmol/L","age"="years"))) ## with interaction f2 <- glm(bp.1s~age*gender+frame+chol,data=Diabetes) summary(regressionTable(f2)) #Add reference values summary(regressionTable(f2)) f3 <- glm(bp.1s~age+gender*frame+chol,data=Diabetes) publish(f3) regressionTable(f3) # logistic regression Diabetes$hyp1 <- factor(1*(Diabetes$bp.1s>140)) l1 <- glm(hyp1~age+gender+frame+chol,data=Diabetes,family="binomial") regressionTable(l1) publish(l1) plot(regressionTable(l1)) ## with interaction l2 <- glm(hyp1~age+gender+frame*chol,data=Diabetes,family="binomial") regressionTable(l2) l3 <- glm(hyp1~age*gender+frame*chol,data=Diabetes,family="binomial") regressionTable(l3) # Cox regression library(survival) data(pbc) pbc$edema <- factor(pbc$edema,levels=c("0","0.5","1"),labels=c("0","0.5","1")) c1 <- coxph(Surv(time,status!=0)~log(bili)+age+protime+sex+edema,data=pbc) regressionTable(c1) # with interaction c2 <- coxph(Surv(time,status!=0)~log(bili)+age+protime*sex+edema,data=pbc) regressionTable(c2) c3 <- coxph(Surv(time,status!=0)~edema*log(bili)+age+protime+sex+edema+edema:sex,data=pbc) regressionTable(c3) if (requireNamespace("nlme",quietly=TRUE)){ ## gls regression library(lava) library(nlme) m <- lvm(Y ~ X1 + gender + group + Interaction) distribution(m, ~gender) <- binomial.lvm() distribution(m, ~group) <- binomial.lvm(size = 2) constrain(m, Interaction ~ gender + group) <- function(x){x[,1]*x[,2]} d <- sim(m, 1e2) d$gender <- factor(d$gender, labels = letters[1:2]) d$group <- factor(d$group) e.gls <- gls(Y ~ X1 + gender*group, data = d, weights = varIdent(form = ~1|group)) regressionTable(e.gls) summary(regressionTable(e.gls)) } } \author{ Thomas A. Gerds } Publish/man/publish.ci.Rd0000644000176200001440000000213115040352073014756 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/publish.ci.R \name{publish.ci} \alias{publish.ci} \title{Publish tables with confidence intervals} \usage{ \method{publish}{ci}(object, format = "[u;l]", se = FALSE, ...) } \arguments{ \item{object}{Object of class ci containing point estimates and the corresponding confidence intervals} \item{format}{A string which indicates the format used for confidence intervals. The string is passed to \link{formatCI} with two arguments: the lower and the upper limit. For example \code{'(l;u)'} yields confidence intervals with round parenthesis in which the upper and the lower limits are separated by semicolon.} \item{se}{If \code{TRUE} add standard error.} \item{...}{passed to \code{publish}} } \value{ table with confidence intervals } \description{ Publish tables with confidence intervals } \details{ This function calls summary.ci with print=FALSE and then publish } \examples{ data(Diabetes) publish(ci.mean(chol~location+gender,data=Diabetes),org=TRUE) } \seealso{ summary.ci } \author{ Thomas A. Gerds } Publish/man/plot.subgroupAnalysis.Rd0000644000176200001440000000267714142666146017277 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot.subgroupAnalysis.R \name{plot.subgroupAnalysis} \alias{plot.subgroupAnalysis} \title{plot.subgroupAnalysis} \usage{ \method{plot}{subgroupAnalysis}(x, ...) } \arguments{ \item{x}{- a subgroupAnalysis object} \item{...}{- passed on to plotConfidence} } \description{ This function operates on a "subgroupAnalysis" object to produce a formatted table and a forest plot } \details{ This function produces a formatted table of a subgroupAnalysis object and adds a forest plot. If further details needs attention before plotting is is advisable use adjust the table produced by the summary function and then plotting with the plotConfidence function } \examples{ #load libraries library(Publish) library(survival) library(data.table) data(traceR) #get dataframe traceR setDT(traceR) traceR[,':='(wmi2=factor(wallMotionIndex<0.9,levels=c(TRUE,FALSE), labels=c("bad","good")), abd2=factor(abdominalCircumference<95, levels=c(TRUE,FALSE), labels=c("slim","fat")), sex=factor(sex))] fit_cox <- coxph(Surv(observationTime,dead)~treatment,data=traceR) # Selected subgroups - univariable analysis sub_cox <- subgroupAnalysis(fit_cox,traceR,treatment="treatment", subgroup=c("smoking","sex","wmi2","abd2")) # subgroups as character string plot(sub_cox) } \seealso{ subgroupAnalysis, plotConfidence } \author{ Christian Torp-Pedersen } Publish/man/publish.CauseSpecificCox.Rd0000644000176200001440000000357114142666146017567 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/publish.CauseSpecificCox.R \name{publish.CauseSpecificCox} \alias{publish.CauseSpecificCox} \title{Tabulizing cause-specific hazard ratio from all causes with confidence limits and Wald test p-values.} \usage{ \method{publish}{CauseSpecificCox}( object, cause, confint.method, pvalue.method, factor.reference = "extraline", units = NULL, print = TRUE, ... ) } \arguments{ \item{object}{Cause-specific hazard model obtained with \code{CSC}.} \item{cause}{Show a table for this cause. If omitted, list all causes.} \item{confint.method}{See \code{regressionTable}} \item{pvalue.method}{See \code{regressionTable}} \item{factor.reference}{See \code{regressionTable}} \item{units}{See \code{regressionTable}} \item{print}{If \code{TRUE} print the table(s).} \item{...}{passed on to control formatting of parameters, confidence intervals and p-values. See \code{summary.regressionTable}.} } \value{ Table with cause-specific hazard ratios, confidence limits and p-values. } \description{ Publish cause-specific Cox models } \details{ The cause-specific hazard ratio's are combined into one table. } \examples{ if (requireNamespace("riskRegression",quietly=TRUE)){ library(riskRegression) library(prodlim) library(survival) data(Melanoma,package="riskRegression") fit1 <- CSC(list(Hist(time,status)~sex,Hist(time,status)~invasion+epicel+age), data=Melanoma) publish(fit1) publish(fit1,pvalue.stars=TRUE) publish(fit1,factor.reference="inline",units=list("age"="years")) # wide format (same variables in both Cox regression formula) fit2 <- CSC(Hist(time,status)~invasion+epicel+age, data=Melanoma) publish(fit2) # with p-values x <- publish(fit2,print=FALSE) table <- cbind(x[[1]]$regressionTable, x[[2]]$regressionTable[,-c(1,2)]) } } \author{ Thomas Alexander Gerds } Publish/man/publish.survdiff.Rd0000644000176200001440000000141614142666146016233 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/publish.survdiff.R \name{publish.survdiff} \alias{publish.survdiff} \title{Alternative summary of survdiff results} \usage{ \method{publish}{survdiff}(object, digits = c(2, 4), print = TRUE, ...) } \arguments{ \item{object}{Object obtained with \code{survival::survdiff}.} \item{digits}{Vector with digits for rounding numbers: the second for pvalues, the first for all other numbers.} \item{print}{If \code{FALSE} do not print results.} \item{...}{Not (yet) used.} } \description{ Alternative summary of survdiff results } \examples{ library(survival) data(pbc) sd <- survdiff(Surv(time,status!=0)~sex,data=pbc) publish(sd) publish(sd,digits=c(3,2)) } \author{ Thomas A. Gerds } Publish/man/publish.MIresult.Rd0000644000176200001440000001056214142666146016151 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/publish.MIresult.R \name{publish.MIresult} \alias{publish.MIresult} \title{Present logistic regression and Cox regression obtained with mitools::MIcombine based on smcfcs::smcfcs multiple imputation analysis} \usage{ \method{publish}{MIresult}( object, confint.method, pvalue.method, digits = c(2, 4), print = TRUE, factor.reference = "extraline", intercept, units = NULL, fit, data, ... ) } \arguments{ \item{object}{Object obtained with mitools::MIcombine based on smcfcs::smcfcs multiple imputation analysis} \item{confint.method}{No options here. Only Wald type confidence intervals.} \item{pvalue.method}{No options here. Only Wald type tests.} \item{digits}{Rounding digits for all numbers but the p-values.} \item{print}{If \code{FALSE} suppress printing of the results} \item{factor.reference}{Style for showing results for categorical. See \code{regressionTable}.} \item{intercept}{See \code{regressionTable}.} \item{units}{See \code{regressionTable}.} \item{fit}{One fitted model using the same formula as \code{object}. This can be the fit to the complete case data or the fit to one of the completed data. It is used to get xlevels, formula and terms. For usage see examples. is used to fit} \item{data}{Original data set which includes the missing values} \item{...}{passed to summary.regressionTable, labelUnits and publish.default.} } \description{ Regression tables after multiple imputations } \details{ Show results of smcfcs based multiple imputations of missing covariates in publishable format } \examples{ \dontrun{ if (requireNamespace("riskRegression",quietly=TRUE) & requireNamespace("mitools",quietly=TRUE) & requireNamespace("smcfcs",quietly=TRUE)){ library(riskRegression) library(mitools) library(smcfcs) ## continuous outcome: linear regression # lava some data with missing values set.seed(7) d=sampleData(78) ## generate missing values d[X1==1,X6:=NA] d[X2==1,X3:=NA] d=d[,.(X8,X4,X3,X6,X7)] sapply(d,function(x)sum(is.na(x))) # multiple imputation (should set m to a large value) set.seed(17) f= smcfcs(d,smtype="lm", smformula=X8~X4+X3+X6+X7, method=c("","","logreg","norm",""),m=3) ccfit=lm(X8~X4+X3+X6+X7,data=d) mifit=MIcombine(with(imputationList(f$impDatasets), lm(X8~X4+X3+X6+X7))) publish(mifit,fit=ccfit,data=d) publish(ccfit) ## binary outcome # lava some data with missing values set.seed(7) db=sampleData(78,outcome="binary") ## generate missing values db[X1==1,X6:=NA] db[X2==1,X3:=NA] db=db[,.(Y,X4,X3,X6,X7)] sapply(db,function(x)sum(is.na(x))) # multiple imputation (should set m to a large value) set.seed(17) fb= smcfcs(db,smtype="logistic", smformula=Y~X4+X3+X6+X7, method=c("","","logreg","norm",""),m=2) ccfit=glm(Y~X4+X3+X6+X7,family="binomial",data=db) mifit=MIcombine(with(imputationList(fb$impDatasets), glm(Y~X4+X3+X6+X7,family="binomial"))) publish(mifit,fit=ccfit) publish(ccfit) ## survival: Cox regression library(survival) # lava some data with missing values set.seed(7) ds=sampleData(78,outcome="survival") ## generate missing values ds[X5==1,X6:=NA] ds[X2==1,X3:=NA] ds=ds[,.(time,event,X4,X3,X6,X7)] sapply(ds,function(x)sum(is.na(x))) set.seed(17) fs= smcfcs(ds,smtype="coxph", smformula="Surv(time,event)~X4+X3+X6+X7", method=c("","","","logreg","norm",""),m=2) ccfit=coxph(Surv(time,event)~X4+X3+X6+X7,data=ds) mifit=MIcombine(with(imputationList(fs$impDatasets), coxph(Surv(time,event)~X4+X3+X6+X7))) publish(mifit,fit=ccfit,data=ds) publish(ccfit) ## competing risks: Cause-specific Cox regression library(survival) # lava some data with missing values set.seed(7) dcr=sampleData(78,outcome="competing.risks") ## generate missing values dcr[X5==1,X6:=NA] dcr[X2==1,X3:=NA] dcr=dcr[,.(time,event,X4,X3,X6,X7)] sapply(dcr,function(x)sum(is.na(x))) set.seed(17) fcr= smcfcs(dcr,smtype="compet", smformula=c("Surv(time,event==1)~X4+X3+X6+X7", "Surv(time,event==2)~X4+X3+X6+X7"), method=c("","","","logreg","norm",""),m=2) ## cause 2 ccfit2=coxph(Surv(time,event==2)~X4+X3+X6+X7,data=dcr) mifit2=MIcombine(with(imputationList(fcr$impDatasets), coxph(Surv(time,event==2)~X4+X3+X6+X7))) publish(mifit2,fit=ccfit2,data=dcr) publish(ccfit2) } } } \author{ Thomas A. Gerds } Publish/man/summary.regressionTable.Rd0000644000176200001440000000317614142666146017567 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/summary.regressionTable.R \name{summary.regressionTable} \alias{summary.regressionTable} \alias{print.summary.regressionTable} \title{Formatting regression tables} \usage{ \method{summary}{regressionTable}(object, show.missing = "ifany", print = TRUE, ...) } \arguments{ \item{object}{object obtained with \code{regressionTable} or \code{summary.regressionTable}.} \item{show.missing}{Decide if number of missing values are shown. Either logical or character. If \code{'ifany'} then number missing values are shown if there are some.} \item{print}{If \code{TRUE} print results.} \item{...}{Used to control formatting of parameter estimates, confidence intervals and p-values. See examples.} } \value{ List with two elements: \itemize{ \item regressionTable: the formatted regression table (a data.frame) \item rawTable: table with the unformatted values (a data.frame) } } \description{ Preparing regression results for publication } \examples{ library(survival) data(pbc) pbc$edema <- factor(pbc$edema,levels=c("0","0.5","1"),labels=c("0","0.5","1")) fit = coxph(Surv(time,status!=0)~age+sex+edema+log(bili)+log(albumin)+log(protime), data=pbc) u=summary(regressionTable(fit)) u$regressionTable u$rawTable summary(regressionTable(fit),handler="prettyNum") summary(regressionTable(fit),handler="format") summary(regressionTable(fit),handler="sprintf",digits=c(2,2),pValue.stars=TRUE) summary(regressionTable(fit),handler="sprintf",digits=c(2,2),pValue.stars=TRUE,ci.format="(l,u)") } \seealso{ publish.glm publish.coxph } \author{ Thomas A. Gerds } Publish/man/SpaceT.Rd0000644000176200001440000000212714142666146014115 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/publish-package.R \docType{data} \name{SpaceT} \alias{SpaceT} \title{A study was made of all 26 astronauts on the first eight space shuttle flights (Bungo et.al., 1985). On a voluntary basis 17 astronauts consumed large quantities of salt and fluid prior to landing as a countermeasure to space deconditioning, while nine did not.} \format{ A data frame with 52 observations on the following 4 variables: \describe{ \item{Status}{Factor with levels Post (after flight) and Pre (before flight)} \item{HR}{Supine heart rate(beats per minute)} \item{Treatment}{Countermeasure salt/fluid (1= yes, 0=no)} \item{ID}{Person id} } } \description{ A study was made of all 26 astronauts on the first eight space shuttle flights (Bungo et.al., 1985). On a voluntary basis 17 astronauts consumed large quantities of salt and fluid prior to landing as a countermeasure to space deconditioning, while nine did not. } \examples{ data(SpaceT) } \references{ Altman, Practical statistics for medical research, Page 223, Ex. 9.1. Bungo et.al., 1985 } Publish/man/publish.glm.Rd0000755000176200001440000000641714361526014015163 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/publish.glm.R \name{publish.glm} \alias{publish.glm} \title{Tabulize regression coefficients with confidence intervals and p-values.} \usage{ \method{publish}{glm}( object, confint.method, pvalue.method, digits = c(2, 4), print = TRUE, factor.reference = "extraline", intercept = ifelse((is.null(object$family) || object$family$family == "gaussian"), 1L, 0L), units = NULL, ... ) } \arguments{ \item{object}{A \code{glm} object.} \item{confint.method}{See \code{regressionTable}.} \item{pvalue.method}{See \code{regressionTable}.} \item{digits}{A vector of two integer values. These determine how to round numbers (first value) and p-values (second value). E.g., c(1,3) would mean 1 digit for all numbers and 3 digits for p-values. The actual rounding is done by \code{summary.regressionTable}.} \item{print}{If \code{FALSE} do not print results.} \item{factor.reference}{Style for showing results for categorical. See \code{regressionTable}.} \item{intercept}{See \code{regressionTable}.} \item{units}{See \code{regressionTable}.} \item{...}{passed to \code{summary.regressionTable} and also to \code{labelUnits}.} \item{reference}{Style for showing results for categorical variables. If \code{"extraline"} show an additional line for the reference category.} } \value{ Table with regression coefficients, confidence intervals and p-values. } \description{ Tabulate the results of a generalized linear regression analysis. } \details{ The table shows changes in mean for linear regression and odds ratios for logistic regression (family = binomial). } \examples{ data(Diabetes) ## Linear regression f = glm(bp.2s~frame+gender+age,data=Diabetes) publish(f) publish(f,factor.reference="inline") publish(f,pvalue.stars=TRUE) publish(f,ci.format="(l,u)") ### interaction fit = glm(bp.2s~frame+gender*age,data=Diabetes) summary(fit) publish(fit) Fit = glm(bp.2s~frame*gender+age,data=Diabetes) publish(Fit) ## Logistic regression Diabetes$hyper1 <- factor(1*(Diabetes$bp.1s>140)) lrfit <- glm(hyper1~frame+gender+age,data=Diabetes,family=binomial) publish(lrfit) ### interaction lrfit1 <- glm(hyper1~frame+gender*age,data=Diabetes,family=binomial) publish(lrfit1) lrfit2 <- glm(hyper1~frame*gender+age,data=Diabetes,family=binomial) publish(lrfit2) ## Poisson regression data(trace) trace <- Units(trace,list("age"="years")) fit <- glm(dead ~ smoking+sex+age+Time+offset(log(ObsTime)), family="poisson",data=trace) rtf <- regressionTable(fit,factor.reference = "inline") summary(rtf) publish(fit) ## gls regression if (requireNamespace("nlme",quietly=TRUE)){ requireNamespace("lava",quietly=TRUE) library(lava) library(nlme) m <- lvm(Y ~ X1 + gender + group + Interaction) distribution(m, ~gender) <- binomial.lvm() distribution(m, ~group) <- binomial.lvm(size = 2) constrain(m, Interaction ~ gender + group) <- function(x){x[,1]*x[,2]} d <- sim(m, 1e2) d$gender <- factor(d$gender, labels = letters[1:2]) d$group <- factor(d$group) e.gls <- gls(Y ~ X1 + gender*group, data = d, weights = varIdent(form = ~1|group)) publish(e.gls) ## lme fm1 <- lme(distance ~ age*Sex, random = ~1|Subject, data = Orthodont) res <- publish(fm1) } } \author{ Thomas Alexander Gerds } Publish/man/trace.Rd0000644000176200001440000000262614142666146014040 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/publish-package.R \docType{data} \name{trace} \alias{trace} \title{trace data} \format{ A data frame with 1832 observations on the following 6 variables. \describe{ \item{Time}{Time after myocardial infarction, in 6 months intervals} \item{smoking}{Smoking status. A factor with levels (Never, Current, Previous)} \item{sex}{A factor with levels (Female, Male)} \item{age}{Age in years at the time of myocardial infarction} \item{ObsTime}{Cumulative risk time in each split} \item{dead}{Count of deaths} } } \description{ These data are from screening to the TRACE study, a comparison between the angiotensin converting enzyme inhibitor trandolapril and placebo ford large myocardial infarctions. A total of 6676 patients were screened for the study. Survival has been followed for the screened population for 16 years. The current data has been prepared for a poisson regression to examine survival. The data has been "split" in 0.5 year intervals (plitLexis function from Epi package) and then collapsed on all variables (aggregate function). } \examples{ data(trace) Units(trace,list("age"="years")) fit <- glm(dead ~ smoking+sex+age+Time+offset(log(ObsTime)), family="poisson",data=trace) rtf <- regressionTable(fit,factor.reference = "inline") summary(rtf) publish(fit) } \references{ Kober et al 1995 Am. J. Cardiol 76,1-5 } \keyword{datasets} Publish/man/print.ci.Rd0000644000176200001440000000166314142666146014470 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/print.ci.R \name{print.ci} \alias{print.ci} \title{Print confidence intervals} \usage{ \method{print}{ci}(x, se = FALSE, print = TRUE, ...) } \arguments{ \item{x}{Object containing point estimates and the corresponding confidence intervals} \item{se}{If \code{TRUE} add the standard error.} \item{print}{Logical: if \code{FALSE} do not actually print confidence intervals but just return them invisibly.} \item{...}{passed to summary.ci} } \value{ A string: the formatted confidence intervals } \description{ Print confidence intervals } \details{ This format of the confidence intervals is user-manipulable. } \examples{ library(lava) m <- lvm(Y~X) m <- categorical(m,Y~X,K=4) set.seed(4) d <- sim(m,24) ci.mean(Y~X,data=d) x <- ci.mean(Y~X,data=d) print(x,format="(l,u)") } \seealso{ ci plot.ci formatCI summary.ci } \author{ Thomas A. Gerds } Publish/man/print.regressionTable.Rd0000644000176200001440000000063615040353504017211 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/print.regressionTable.R \name{print.regressionTable} \alias{print.regressionTable} \title{printing regression tables} \usage{ \method{print}{regressionTable}(x, ...) } \arguments{ \item{x}{regressionTable object} \item{...}{passed to summary} } \description{ printing regression tables } \author{ Thomas A. Gerds } Publish/man/pubformat.Rd0000644000176200001440000000202214142666146014727 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/pubformat.R \name{pubformat} \alias{pubformat} \title{Format numbers for publication} \usage{ pubformat(x, digits = 2, nsmall = digits, handler = "sprintf", ...) } \arguments{ \item{x}{numeric vector} \item{digits}{number of digits} \item{nsmall}{see handler} \item{handler}{String specififying the name of the function which should perform the formatting. See \code{sprintf}, \code{format} and \code{prettyNum}.} \item{...}{Passed to handler function if applicable, i.e., not to \code{sprintf}.} } \value{ Formatted number } \description{ Format numbers according to a specified handler function. Currently supported are sprintf, format and prettyNum. } \examples{ pubformat(c(0.000143,12.8,1)) pubformat(c(0.000143,12.8,1),handler="format") pubformat(c(0.000143,12.8,1),handler="format",trim=TRUE) pubformat(c(0.000143,12.8,1),handler="prettyNum") } \seealso{ \code{sprintf}, \code{format}, \code{prettyNum} } \author{ Thomas A. Gerds } Publish/man/Publish-package.Rd0000644000176200001440000000115315040353721015721 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/publish-package.R \docType{package} \name{Publish-package} \alias{Publish} \alias{Publish-package} \title{Publish package} \description{ This package processes results of descriptive statistcs and regression analysis into final tables and figures of a manuscript } \author{ \strong{Maintainer}: Thomas A. Gerds \email{tag@biostat.ku.dk} Authors: \itemize{ \item Brice Ozenne \email{broz@sund.ku.dk} } Other contributors: \itemize{ \item Christian Torp-Pedersen [contributor] \item Klaus K Holst [contributor] } } \keyword{internal} Publish/man/summary.subgroupAnalysis.Rd0000644000176200001440000000377214142666146020013 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/summary.subgroupAnalysis.R \name{summary.subgroupAnalysis} \alias{summary.subgroupAnalysis} \title{summary.subgroupAnalysis} \usage{ \method{summary}{subgroupAnalysis}( object, digits = 3, eps = 0.001, subgroup.p = FALSE, keep.digital = FALSE, ... ) } \arguments{ \item{object}{- a subgroupAnalysis object} \item{digits}{- number of digits for risk ratios} \item{eps}{- lowest value of p to be shown exactly, others will be " } Publish/man/labelUnits.Rd0000644000176200001440000000202414142666146015034 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/labelUnits.R \name{labelUnits} \alias{labelUnits} \title{labelUnits} \usage{ labelUnits(x, ...) } \arguments{ \item{x}{A matrix obtained with \code{univariateTable}.} \item{...}{not used} } \value{ The re-labeled matrix } \description{ Label output tables } \details{ Modify labels and values of variables in summary tables } \examples{ data(Diabetes) tab <- summary(univariateTable(gender~AgeGroups+chol+waist,data=Diabetes)) publish(tab) ltab <- labelUnits(tab,"chol"="Cholesterol (mg/dL)","<40"="younger than 40") publish(ltab) ## pass labels immediately to utable utable(gender~AgeGroups+chol+waist,data=Diabetes, "chol"="Cholesterol (mg/dL)","<40"="younger than 40") ## sometimes useful to state explicitly which variables value ## should be re-labelled utable(gender~AgeGroups+chol+waist,data=Diabetes, "chol"="Cholesterol (mg/dL)","AgeGroups.<40"="younger than 40") } \seealso{ univariateTable } \author{ Thomas A. Gerds } Publish/man/Units.Rd0000644000176200001440000000135414142666146014041 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/Units.R \name{Units} \alias{Units} \title{Add units to data set} \usage{ Units(object, units) } \arguments{ \item{object}{A data.frame or data.table} \item{units}{Named list of units. Names are variable names. If omitted, show existing units.} } \value{ The object augmented with attribute \code{"units"} } \description{ Add variable units to data.frame (or data.table). } \details{ If the object has units existing units are replaced by given units. } \examples{ data(Diabetes) Diabetes <- Units(Diabetes,list(BMI="kg/m^2")) Units(Diabetes) Diabetes <- Units(Diabetes,list(bp.1s="mm Hg",bp.2s="mm Hg")) Units(Diabetes) } \author{ Thomas A. Gerds } Publish/man/subgroupAnalysis.Rd0000644000176200001440000001207314361526350016304 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/subgroupAnalysis.R \name{subgroupAnalysis} \alias{subgroupAnalysis} \title{Subgroup Analysis - Interactions and estimates} \usage{ subgroupAnalysis( object, data, treatment, subgroups, confint.method = "default", factor.reference = "extraline", ... ) } \arguments{ \item{object}{- glm, coxph or cph object for which subgroups should be analyzed.} \item{data}{- Dataset including all relevant variables} \item{treatment}{- Must be numeric - 0/1} \item{subgroups}{- A vector of variable names presenting the factor variables where subgroups should be formed. These variables should all be "factors"} \item{confint.method}{"default" creates Wald type confidence interval, "robust", creates creates robust standard errors - see regressionTable function.} \item{factor.reference}{"extraline" creates an extraline for the reference, "inline" avoids this line.} \item{...}{additional arguments such as case weights, which are passed on to \code{glm} and \code{coxph}.} } \value{ A data.frame with subsgroup specifications, number in each subgroup, parameter estimates and p-value for interaction. A forest plot can be obtained with "plotConfidence". } \description{ The function can examine Cox regression, logistic regression and Poisson regression (Poisson regression for survival analysis) where the effect of one variable is of particular interest. This function systematically checks for effect modification with a list of other variables. In randomised studies the main regression analysis is often univariate and includes only the exposure of interest. In observational studies the main regression analysis can readily be adjusted for other variables including those which may modify the effect of the variable of interest. } \details{ The function can only handle a bivariate treatment, which MUST coded as zero or one. The p-value for interaction is obtained with a likelihood ratio test comparing the main regression analysis with the interaction model. There are plot and print functions available for the function see helppages for plot.subgroupAnalysis and print.subgroupAnalysis } \examples{ #load libraries library(data.table) library(Publish) library(survival) data(traceR) #get dataframe traceR data.table::setDT(traceR) traceR[,':='(wmi2=factor(wallMotionIndex<0.9,levels=c(TRUE,FALSE), labels=c("bad","good")), abd2=factor(abdominalCircumference<95, levels=c(TRUE,FALSE), labels=c("slim","fat")))] traceR[,sex:=as.factor(sex)] # all subgroup variables needs to be factor traceR[observationTime==0,observationTime:=1] # remove missing covariate values traceR=na.omit(traceR) # univariate analysis of smoking in subgroups of age and sex # Main regression analysis is a simple/univariate Cox regression fit_cox <- coxph(Surv(observationTime,dead)~treatment,data=traceR) sub_cox <- subgroupAnalysis(fit_cox,traceR,treatment="treatment", subgroups=c("smoking","sex","wmi2","abd2")) sub_cox # to see how the results are obtained consider the variable: smoking fit_cox_smoke <- coxph(Surv(observationTime,dead)~treatment*smoking,data=traceR) # the last three rows of the following output: publish(fit_cox_smoke) # are included in the first 3 rows of the result of the sub group analysis: sub_cox[1:3,] # the p-value is obtained as: fit_cox_smoke_add <- coxph(Surv(observationTime,dead)~treatment+smoking,data=traceR) anova(fit_cox_smoke_add,fit_cox_smoke,test="Chisq") # Note that a real subgroup analysis would be to subset the data fit_cox1a <- coxph(Surv(observationTime,dead)~treatment,data=traceR[smoking=="never"]) fit_cox1b <- coxph(Surv(observationTime,dead)~treatment,data=traceR[smoking=="current"]) fit_cox1c <- coxph(Surv(observationTime,dead)~treatment,data=traceR[smoking=="prior"]) ## when the main analysis is already adjusted fit_cox_adj <- coxph(Surv(observationTime,dead)~treatment+smoking+sex+wmi2+abd2, data=traceR) sub_cox_adj <- subgroupAnalysis(fit_cox_adj,traceR,treatment="treatment", subgroups=c("smoking","sex","wmi2","abd2")) # subgroups as character string sub_cox_adj # When both start and end are in the Surv statement: traceR[,null:=0] fit_cox2 <- coxph(Surv(null,observationTime,dead)~treatment+smoking+sex+wmi2+abd2,data=traceR) summary(regressionTable(fit_cox)) sub_cox2 <- subgroupAnalysis(fit_cox2,traceR,treatment="treatment", subgroups=c("smoking","sex","wmi2","abd2")) # Analysis with Poisson - and the unrealistic assumption of constant hazard # and adjusted for age in all subgroups fit_p <- glm(dead~treatment+age+offset(log(observationTime)),family="poisson", data=traceR) sub_pois <- subgroupAnalysis(fit_p,traceR,treatment="treatment", subgroups=~smoking+sex+wmi2+abd2) # Analysis with logistic regression - and very wrongly ignoring censoring fit_log <- glm(dead~treatment+age,family="binomial",data=traceR) sub_log <- subgroupAnalysis(fit_log,traceR,treatment="treatment", subgroups=~smoking+sex+wmi2+abd2, factor.reference="inline") } \seealso{ coxph, glm, plotConfidence } \author{ Christian Torp-Pedersen } Publish/man/ci.mean.Rd0000755000176200001440000000065614142666146014260 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/ci.mean.R \name{ci.mean} \alias{ci.mean} \title{Compute mean values with confidence intervals} \usage{ ci.mean(x, ...) } \arguments{ \item{x}{object passed to methods} \item{...}{passed to methods} } \value{ a list with mean values and confidence limits } \description{ Compute mean values with confidence intervals } \details{ Normal approximation } Publish/man/summary.ci.Rd0000644000176200001440000000306215040352072015010 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/summary.ci.R \name{summary.ci} \alias{summary.ci} \title{Summarize confidence intervals} \usage{ \method{summary}{ci}(object, format = "[u;l]", se = FALSE, print = TRUE, ...) } \arguments{ \item{object}{Object of class ci containing point estimates and the corresponding confidence intervals} \item{format}{A string which indicates the format used for confidence intervals. The string is passed to \link{formatCI} with two arguments: the lower and the upper limit. For example \code{'(l;u)'} yields confidence intervals with round parenthesis in which the upper and the lower limits are separated by semicolon.} \item{se}{If \code{TRUE} add standard error.} \item{print}{Logical: if \code{FALSE} do not actually print confidence intervals but just return them invisibly.} \item{...}{used to control formatting of numbers} } \value{ Formatted confidence intervals } \description{ Summarize confidence intervals } \details{ This format of the confidence intervals is user-manipulable. } \examples{ library(lava) m <- lvm(Y~X) m <- categorical(m,Y~X,K=4) set.seed(4) d <- sim(m,24) ci.mean(Y~X,data=d) x <- summary(ci.mean(Y~X,data=d),digits=2) x x <- summary(ci.mean(Y~X,data=d),format="(u,l)",digits=2) x <- summary(ci.mean(Y~X,data=d),format="(u,l)",digits=1,se=TRUE) x <- summary(ci.mean(Y~X,data=d),format="(u,l)",digits=1,handler="format") x <- summary(ci.mean(Y~X,data=d),format="(u,l)",digits=1,handler="prettyNum") } \seealso{ ci plot.ci format.ci } \author{ Thomas A. Gerds } Publish/man/publish.htest.Rd0000644000176200001440000000154014142666146015530 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/publish.htest.R \name{publish.htest} \alias{publish.htest} \title{Pretty printing of test results.} \usage{ \method{publish}{htest}(object, title, ...) } \arguments{ \item{object}{Result of \code{t.test} or \code{wilcox.test}} \item{title}{Decoration also used to name output} \item{...}{Used to transport arguments \code{ci.arg} and \code{pvalue.arg} to subroutines \code{format.pval} and \code{formatCI}. See also \code{prodlim::SmartControl}.} } \description{ Pretty printing of test results. } \examples{ data(Diabetes) publish(t.test(bp.2s~gender,data=Diabetes)) publish(wilcox.test(bp.2s~gender,data=Diabetes)) publish(with(Diabetes,t.test(bp.2s,bp.1s,paired=TRUE))) publish(with(Diabetes,wilcox.test(bp.2s,bp.1s,paired=TRUE))) } \author{ Thomas A. Gerds } Publish/DESCRIPTION0000644000176200001440000000250015040441566013370 0ustar liggesusersPackage: Publish Type: Package Title: Format Output of Various Routines in a Suitable Way for Reports and Publication Description: A bunch of convenience functions that transform the results of some basic statistical analyses into table format nearly ready for publication. This includes descriptive tables, tables of logistic regression and Cox regression results as well as forest plots. Version: 2025.07.24 Authors@R: c(person("Thomas A.", "Gerds", role = c("aut", "cre"), email = "tag@biostat.ku.dk"), person("Christian", "Torp-Pedersen", role = "ctb"), person("Klaus", "K Holst", role = "ctb"), person("Brice", "Ozenne", role = "aut", email = "broz@sund.ku.dk")) Maintainer: Thomas A. Gerds Depends: prodlim (>= 1.5.4) Imports: survival (>= 2.38), data.table (>= 1.10.4), lava (>= 1.5.1), multcomp (>= 1.4) Suggests: riskRegression (>= 2020.09.07), testthat, smcfcs (>= 1.4.1), rms (>= 6.1.0), mitools (>= 2.4), nlme (>= 3.1-131) License: GPL (>= 2) RoxygenNote: 7.3.2 NeedsCompilation: no Packaged: 2025-07-24 07:25:49 UTC; tag Author: Thomas A. Gerds [aut, cre], Christian Torp-Pedersen [ctb], Klaus K Holst [ctb], Brice Ozenne [aut] Repository: CRAN Date/Publication: 2025-07-24 14:30:14 UTC