fix incidence table

This commit is contained in:
François Vieille 2018-02-03 16:21:01 +01:00
parent 317bafd27b
commit eb3ee16751
2 changed files with 24 additions and 18 deletions

View File

@ -41,7 +41,7 @@ vt.subgroups <- function(vt.trees, only.leaf = T, only.fav = T, tables = F, verb
unique(do.call(rbind, subgroups))
}
else{
subgroups <- vt.tree$getRules(only.leaf = only.leaf, only.fav = only.fav, tables = tables, verbose = verbose, compete = compete)
subgroups <- vt.trees$getRules(only.leaf = only.leaf, only.fav = only.fav, tables = tables, verbose = verbose, compete = compete)
}
}
@ -60,21 +60,27 @@ vt.getQAOriginal <- function(response, trt, ahat){
}
vt.getTable <- function(table){
if(is.list(table)) table <- table[[1]]
Incidence <- function(X) as.character(round(X[2] / X[3], digits = 3))
if(is.list(table)) table <- table[[1]]
Incidence <- function(X) round(X[2] / X[3], digits = 3)
t <- stats::addmargins(table, margin = c(1,2), FUN = sum, quiet = T)
t <- stats::addmargins(t, FUN = Incidence, margin = 1, quiet = T)
rr <- as.numeric(t["Incidence", "1"]) / as.numeric(t["Incidence", "0"])
rr <- NA_real_
if(nrow(t) == 4) rr <- t[4, 2] / t[4, 1]
return(list(table = t, rr = rr))
}
vt.getIncidence <- function(df){
if (nrow(df) == 0) table.res <- NULL
if (ncol(df) != 2) table.res <- NULL
else{
table.res <- vt.getTable(table(df[, 1],
df[, 2],
deparse.level = 2,
dnn = c("resp", "trt")))
table.res <- vt.getTable(
table(
factor(df[, 1], levels = c(0, 1)),
factor(df[, 2], levels = c(0, 1)),
deparse.level = 2,
dnn = c("resp", "trt")
)
)
}
return(table.res)
}

View File

@ -248,17 +248,17 @@ VT.tree <- setRefClass(
if(isTRUE(tables)){
cat("\n")
cat(sprintf("Incidence dans la selection \n"))
cat(sprintf("Incidence in selection \n"))
print(incid$table.selected$table)
cat("\n")
cat(sprintf("Risque relatif (resub) : %0.3f \n", incid$table.selected$rr))
cat(sprintf("Risque relatif (snd) : %0.3f \n\n", incid$table.selected$rr.snd))
cat(sprintf("Relative risk (resub) : %0.3f \n", incid$table.selected$rr))
cat(sprintf("Relative risk (snd) : %0.3f \n\n", incid$table.selected$rr.snd))
cat(sprintf("Incidence dans le complementaire\n"))
cat(sprintf("Incidence in complement\n"))
print(incid$table.not.selected$table)
cat("\n")
cat(sprintf("Risque relatif (resub) : %0.3f \n", incid$table.not.selected$rr))
cat(sprintf("Risque relatif (snd) : %0.3f \n\n", incid$table.not.selected$rr.snd))
cat(sprintf("Relative risk (resub) : %0.3f \n", incid$table.not.selected$rr))
cat(sprintf("Relative risk (snd) : %0.3f \n\n", incid$table.not.selected$rr.snd))
}
cat("\n\n")
@ -310,15 +310,15 @@ VT.tree <- setRefClass(
table.A <- table.inc$table.selected
table.A.cmpl <- table.inc$table.not.selected
cat(sprintf("Incidence dans le sous groupe A\n"))
cat(sprintf("Incidence in subgroup A\n"))
print(table.A$table)
cat("\n")
cat(sprintf("Risque relatif : %0.3f \n\n", table.A$risque_relatif))
cat(sprintf("Relative risk : %0.3f \n\n", table.A$risque_relatif))
cat(sprintf("Incidence dans le sous groupe A complementaire\n"))
cat(sprintf("Incidence in complement subgroup of A\n"))
print(table.A.cmpl$table)
cat("\n")
cat(sprintf("Risque relatif : %0.3f \n\n", table.A.cmpl$risque_relatif))
cat(sprintf("Relative risk : %0.3f \n\n", table.A.cmpl$risque_relatif))
}else{
return("Empty set")
}