From eb3ee16751c3bbb2f74cf3dab7351be18b983f95 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Fran=C3=A7ois=20Vieille?= <vieille.francois@gmail.com>
Date: Sat, 3 Feb 2018 16:21:01 +0100
Subject: [PATCH] fix incidence table

---
 R/tools.R | 22 ++++++++++++++--------
 R/tree.R  | 20 ++++++++++----------
 2 files changed, 24 insertions(+), 18 deletions(-)

diff --git a/R/tools.R b/R/tools.R
index 94974aa..a77c3a7 100644
--- a/R/tools.R
+++ b/R/tools.R
@@ -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)
 }
diff --git a/R/tree.R b/R/tree.R
index da7c0cd..a218299 100644
--- a/R/tree.R
+++ b/R/tree.R
@@ -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")
       }