mirror of
https://github.com/prise6/aVirtualTwins.git
synced 2024-05-07 20:36:32 +02:00
First global description of fields, refClass
This commit is contained in:
parent
8e4f4136ef
commit
38127d4224
21
DESCRIPTION
21
DESCRIPTION
|
@ -7,3 +7,24 @@ Author: Who wrote it
|
||||||
Maintainer: Who to complain to <yourfault@somewhere.net>
|
Maintainer: Who to complain to <yourfault@somewhere.net>
|
||||||
Description: More about what it does (maybe more than one line)
|
Description: More about what it does (maybe more than one line)
|
||||||
License: What license is it under?
|
License: What license is it under?
|
||||||
|
Imports:
|
||||||
|
rpart
|
||||||
|
Suggests:
|
||||||
|
randomForest,
|
||||||
|
caret,
|
||||||
|
party
|
||||||
|
Collate:
|
||||||
|
'VirtualTwins.R'
|
||||||
|
'object.R'
|
||||||
|
'difft.R'
|
||||||
|
'setClass.R'
|
||||||
|
'predict.R'
|
||||||
|
'forest.R'
|
||||||
|
'forest.double.R'
|
||||||
|
'forest.fold.R'
|
||||||
|
'forest.one.R'
|
||||||
|
'incidences.R'
|
||||||
|
'tools.R'
|
||||||
|
'tree.R'
|
||||||
|
'tree.class.R'
|
||||||
|
'tree.reg.R'
|
||||||
|
|
|
@ -1 +1,4 @@
|
||||||
exportPattern("^[[:alpha:]]+")
|
# Generated by roxygen2 (4.1.1): do not edit by hand
|
||||||
|
|
||||||
|
import(methods)
|
||||||
|
importClassesFrom(party,RandomForest)
|
||||||
|
|
15
R/difft.R
15
R/difft.R
|
@ -1,7 +1,14 @@
|
||||||
# DIFFT -------------------------------------------------------------------
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
#' A reference class to represent difference between twin1 and twin2
|
||||||
|
#'
|
||||||
|
#' @include object.R
|
||||||
|
#'
|
||||||
|
#' @field vt.object VT.object (refClass) representing data
|
||||||
|
#' @field twin1 vector of \eqn{E(Y|T= real treatment)}
|
||||||
|
#' @field twin2 vector of \eqn{E(Y|T= antoher treatment)}
|
||||||
|
#' @field difft vector of difference between twin1 and twin2
|
||||||
|
#'
|
||||||
|
#' @import methods
|
||||||
VT.difft <- setRefClass(
|
VT.difft <- setRefClass(
|
||||||
Class = "VT.difft",
|
Class = "VT.difft",
|
||||||
|
|
||||||
|
@ -14,6 +21,7 @@ VT.difft <- setRefClass(
|
||||||
|
|
||||||
methods = list(
|
methods = list(
|
||||||
initialize = function(vt.object = VT.object(), ...){
|
initialize = function(vt.object = VT.object(), ...){
|
||||||
|
|
||||||
.self$vt.object <- vt.object
|
.self$vt.object <- vt.object
|
||||||
|
|
||||||
.self$twin1 <- .self$twin2 <- rep(NA, nrow(vt.object$data))
|
.self$twin1 <- .self$twin2 <- rep(NA, nrow(vt.object$data))
|
||||||
|
@ -22,6 +30,7 @@ VT.difft <- setRefClass(
|
||||||
},
|
},
|
||||||
|
|
||||||
computeDifft = function(){
|
computeDifft = function(){
|
||||||
|
"Compute difference between twin1 and twin2"
|
||||||
|
|
||||||
if(sum(is.na(.self$twin1)) != 0 | sum(is.na(.self$twin2)) != 0 ) stop("Twins must be valid")
|
if(sum(is.na(.self$twin1)) != 0 | sum(is.na(.self$twin2)) != 0 ) stop("Twins must be valid")
|
||||||
|
|
||||||
|
|
16
R/forest.R
16
R/forest.R
|
@ -1,13 +1,10 @@
|
||||||
# FORESTS -----------------------------------------------------------------
|
# FORESTS -----------------------------------------------------------------
|
||||||
|
|
||||||
# Objet enfant de VT.difft
|
#' A abstract reference class to compute twin via random forests
|
||||||
# Objet Parent de VT.forest.one & VT.forest.double, Abstract class : ne doit pas etre instanciée
|
#'
|
||||||
# twin1 - Proba du "oui" de la réponse (modalité d'intéret codé par "o" ou 1 contre "n" ou 0 dans le cas binaire)
|
#' @include difft.R predict.R
|
||||||
# sachant le vrai traitement
|
#'
|
||||||
# twin2 - Proba du "oui" [...] sachant le traitement opposé
|
#' @import methods
|
||||||
# difft - différence de twin1 - twin2 SI le vrai traitement == 1 SINON twin2 - twin1
|
|
||||||
#
|
|
||||||
# $run() - lance le calcul des probas
|
|
||||||
VT.forest <- setRefClass(
|
VT.forest <- setRefClass(
|
||||||
Class = "VT.forest",
|
Class = "VT.forest",
|
||||||
|
|
||||||
|
@ -15,6 +12,7 @@ VT.forest <- setRefClass(
|
||||||
|
|
||||||
methods = list(
|
methods = list(
|
||||||
run = function(){
|
run = function(){
|
||||||
|
"Compute twin1 and twin2 computation. Switch treatment if necessary."
|
||||||
.self$computeTwin1()
|
.self$computeTwin1()
|
||||||
|
|
||||||
if(inherits(.self, "VT.forest.one")) .self$vt.object$switchTreatment() #if one forest
|
if(inherits(.self, "VT.forest.one")) .self$vt.object$switchTreatment() #if one forest
|
||||||
|
@ -31,12 +29,14 @@ VT.forest <- setRefClass(
|
||||||
},
|
},
|
||||||
|
|
||||||
checkModel = function(model){
|
checkModel = function(model){
|
||||||
|
"Checking model class: Must be : train, RandomForest, randomForest"
|
||||||
if(!(inherits(model, "train") | inherits(model, "RandomForest") | inherits(model, "randomForest"))){
|
if(!(inherits(model, "train") | inherits(model, "RandomForest") | inherits(model, "randomForest"))){
|
||||||
stop("Model is not recognized. Must be : train, RandomForest, randomForest")
|
stop("Model is not recognized. Must be : train, RandomForest, randomForest")
|
||||||
}
|
}
|
||||||
},
|
},
|
||||||
|
|
||||||
getFullData = function(){
|
getFullData = function(){
|
||||||
|
"Return twin1, twin2 and difft in column"
|
||||||
if(length(.self$twin1) != nrow(.self$vt.object$data)) stop("Twin1 must have same length as data")
|
if(length(.self$twin1) != nrow(.self$vt.object$data)) stop("Twin1 must have same length as data")
|
||||||
if(length(.self$twin2) != nrow(.self$vt.object$data)) stop("Twin2 must have same length as data")
|
if(length(.self$twin2) != nrow(.self$vt.object$data)) stop("Twin2 must have same length as data")
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,14 @@
|
||||||
# VT.FOREST.DOUBLE --------------------------------------------------------
|
# VT.FOREST.DOUBLE --------------------------------------------------------
|
||||||
# IF RUNNING DOUBLE FOREST COMPUTATION
|
# IF RUNNING DOUBLE FOREST COMPUTATION
|
||||||
|
|
||||||
|
#' A reference class to compute twins via double random forests
|
||||||
|
#'
|
||||||
|
#' @include forest.R
|
||||||
|
#'
|
||||||
|
#' @field model_trt1 a caret/RandomForest/randomForest object for treatment T = 1
|
||||||
|
#' @field model_trt0 a caret/RandomForest/randomForest object for treatment T = 0
|
||||||
|
#'
|
||||||
|
#' @import methods
|
||||||
VT.forest.double <- setRefClass(
|
VT.forest.double <- setRefClass(
|
||||||
Class = "VT.forest.double",
|
Class = "VT.forest.double",
|
||||||
|
|
||||||
|
@ -23,6 +31,7 @@ VT.forest.double <- setRefClass(
|
||||||
},
|
},
|
||||||
|
|
||||||
computeTwin1 = function(){
|
computeTwin1 = function(){
|
||||||
|
"Compute twin1 with OOB predictions from double forests"
|
||||||
# Model with treatment (1)
|
# Model with treatment (1)
|
||||||
.self$twin1[.self$vt.object$data[, 2] == 1] <- VT.predict(rfor = .self$model_trt1, type = .self$vt.object$type)
|
.self$twin1[.self$vt.object$data[, 2] == 1] <- VT.predict(rfor = .self$model_trt1, type = .self$vt.object$type)
|
||||||
|
|
||||||
|
@ -33,6 +42,7 @@ VT.forest.double <- setRefClass(
|
||||||
},
|
},
|
||||||
|
|
||||||
computeTwin2 = function(){
|
computeTwin2 = function(){
|
||||||
|
"Compute twin2 by the other part of data in the other forest"
|
||||||
# Model with treatment (1)
|
# Model with treatment (1)
|
||||||
.self$twin2[.self$vt.object$data[, 2] == 1] <- VT.predict(.self$model_trt0, newdata = .self$vt.object$getX(1, interactions = F), type = .self$vt.object$type)
|
.self$twin2[.self$vt.object$data[, 2] == 1] <- VT.predict(.self$model_trt0, newdata = .self$vt.object$getX(1, interactions = F), type = .self$vt.object$type)
|
||||||
|
|
||||||
|
|
|
@ -1,5 +1,15 @@
|
||||||
# VT.FOREST.FOLD ----------------------------------------------------------
|
# VT.FOREST.FOLD ----------------------------------------------------------
|
||||||
|
|
||||||
|
#' A reference class to compute twins via k random forest
|
||||||
|
#'
|
||||||
|
#' @include forest.R
|
||||||
|
#'
|
||||||
|
#' @field interactions logical set TRUE if model has been computed with interactions
|
||||||
|
#' @field fold numeric Number of fold, i.e. number of forest
|
||||||
|
#' @field ratio numeric
|
||||||
|
#' @field groups vector Define which observations belong to which group
|
||||||
|
#'
|
||||||
|
#' @import methods
|
||||||
VT.forest.fold <- setRefClass(
|
VT.forest.fold <- setRefClass(
|
||||||
Class = "VT.forest.fold",
|
Class = "VT.forest.fold",
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,15 @@
|
||||||
# VT.FOREST.ONE -----------------------------------------------------------
|
# VT.FOREST.ONE -----------------------------------------------------------
|
||||||
# IF RUNNING ONE FOREST COMPUTATION
|
# IF RUNNING ONE FOREST COMPUTATION
|
||||||
# model - modèle de forêt aléatoire issus du package caret, randomForest ou party (cforest)
|
|
||||||
|
#' A reference class to compute twins via one random forest
|
||||||
|
#'
|
||||||
|
#' @include forest.R
|
||||||
|
#'
|
||||||
|
#' @field model ANY a caret/RandomForest/randomForest class object
|
||||||
|
#' @field interactions logical set TRUE if model has been computed with interactions
|
||||||
|
#' @field ... field from parent class : VT.forest
|
||||||
|
#'
|
||||||
|
#' @import methods
|
||||||
VT.forest.one <- setRefClass(
|
VT.forest.one <- setRefClass(
|
||||||
Class = "VT.forest.one",
|
Class = "VT.forest.one",
|
||||||
|
|
||||||
|
@ -23,11 +32,13 @@ VT.forest.one <- setRefClass(
|
||||||
},
|
},
|
||||||
|
|
||||||
computeTwin1 = function(){
|
computeTwin1 = function(){
|
||||||
|
"Compute twin1 with OOB predictions"
|
||||||
.self$twin1 <- as.vector(VT.predict(rfor = .self$model, type = .self$vt.object$type))
|
.self$twin1 <- as.vector(VT.predict(rfor = .self$model, type = .self$vt.object$type))
|
||||||
return(invisible(.self$twin1))
|
return(invisible(.self$twin1))
|
||||||
},
|
},
|
||||||
|
|
||||||
computeTwin2 = function(){
|
computeTwin2 = function(){
|
||||||
|
"Compute twin2 by switching treatment and applying random forest model"
|
||||||
.self$twin2 <- as.vector(VT.predict(.self$model,
|
.self$twin2 <- as.vector(VT.predict(.self$model,
|
||||||
newdata = .self$vt.object$getX(interactions = .self$interactions),
|
newdata = .self$vt.object$getX(interactions = .self$interactions),
|
||||||
.self$vt.object$type))
|
.self$vt.object$type))
|
||||||
|
|
|
@ -1,5 +1,6 @@
|
||||||
# INCIDENCE TABLES FUNCTION /!\ important
|
# INCIDENCE TABLES FUNCTION /!\ important
|
||||||
|
|
||||||
|
|
||||||
setGeneric("VT.incidences",
|
setGeneric("VT.incidences",
|
||||||
function(vt.difft, select, rr.snd){ standardGeneric("VT.incidences") }
|
function(vt.difft, select, rr.snd){ standardGeneric("VT.incidences") }
|
||||||
)
|
)
|
||||||
|
|
35
R/object.R
35
R/object.R
|
@ -1,18 +1,19 @@
|
||||||
# VT.OBJECT ---------------------------------------------------------------
|
# VT.OBJECT ---------------------------------------------------------------
|
||||||
|
|
||||||
# Permet de stocker les données
|
#' A Reference Class to deal with RCT dataset
|
||||||
# alpha - paramètre inutile dans cette version
|
#'
|
||||||
# screening & varimp permettent de construire des arbres sur les variables
|
#' @field data A data.frame de la forme \eqn{Y,T,X_{1}, \ldots, X_{p}}. Y must
|
||||||
# définies dans varimp si screening = True
|
#' be two levels factor if type is binary. T must be numeric or integer.
|
||||||
# delta - différence d'incidence entre les deux "bras"
|
#' @field alpha no usefull now, set to 1
|
||||||
# type - type de réponse - binary ou continous - seul binary est disponible
|
#' @field screening logical, set to FALSE. Se TRUE to use varimp in trees
|
||||||
# interactions - si TRUE getX() retourne (X,X*T,X*(1-T))
|
#' computation
|
||||||
#
|
#' @field varimp character vector of important variables to use in trees
|
||||||
# $getFormula() - utile pour retourner une formule pour rpart
|
#' computation
|
||||||
# $getX(trt = c(0,1,NULL), interactions = c(TRUE, FALSE)) - si trt est non NULL
|
#' @field delta numeric representing the difference of incidence between
|
||||||
# getX() retourne les lignes pour le traitement passé paramètre (utile pour les doubles forests)
|
#' treatments
|
||||||
# $getY() - retourne la réponse / cible
|
#' @field type character : binary or continous. Only binary is possible.
|
||||||
# ...
|
#'
|
||||||
|
#' @import methods
|
||||||
VT.object <- setRefClass(
|
VT.object <- setRefClass(
|
||||||
Class = "VT.object",
|
Class = "VT.object",
|
||||||
|
|
||||||
|
@ -38,10 +39,13 @@ VT.object <- setRefClass(
|
||||||
},
|
},
|
||||||
|
|
||||||
getFormula = function(){
|
getFormula = function(){
|
||||||
|
"Return formula : Y~T+X1+...+Xp. Usefull for cforest function."
|
||||||
return(as.formula(paste(colnames(.self$data)[1], ".", sep = "~")))
|
return(as.formula(paste(colnames(.self$data)[1], ".", sep = "~")))
|
||||||
},
|
},
|
||||||
|
|
||||||
getX = function(interactions = T, trt = NULL){
|
getX = function(interactions = T, trt = NULL){
|
||||||
|
"Return predictors {T,X,X*T,X*(1-T)}. Or {T,X} if interactions is FALSE.
|
||||||
|
If trt is not NULL, return predictors for T=trt"
|
||||||
# retour les prédicteurs si trt n'est pas null
|
# retour les prédicteurs si trt n'est pas null
|
||||||
if(!is.null(trt)) return(.self$data[.self$data[,2] == trt, -c(1,2)])
|
if(!is.null(trt)) return(.self$data[.self$data[,2] == trt, -c(1,2)])
|
||||||
# retourne les predicteurs*traitement peut importe le traitement si interactions est à TRUE
|
# retourne les predicteurs*traitement peut importe le traitement si interactions est à TRUE
|
||||||
|
@ -51,16 +55,19 @@ VT.object <- setRefClass(
|
||||||
},
|
},
|
||||||
|
|
||||||
getY = function(trt = NULL){
|
getY = function(trt = NULL){
|
||||||
|
"Return outcome. If trt is not NULL, return outcome for T=trt."
|
||||||
if(is.null(trt)) return(.self$data[, 1])
|
if(is.null(trt)) return(.self$data[, 1])
|
||||||
return(.self$data[.self$data[,2] == trt, 1])
|
return(.self$data[.self$data[,2] == trt, 1])
|
||||||
},
|
},
|
||||||
|
|
||||||
getXwithInt = function(){
|
getXwithInt = function(){
|
||||||
|
"Return predictors with interactions. Use VT.object::getX(interactions = T) instead."
|
||||||
tmp <- .self$data[, -c(1,2)]
|
tmp <- .self$data[, -c(1,2)]
|
||||||
return(data.frame(cbind(.self$data[,-1], tmp*.self$data[, 2], tmp*(1 - .self$data[, 2]))))
|
return(data.frame(cbind(.self$data[,-1], tmp*.self$data[, 2], tmp*(1 - .self$data[, 2]))))
|
||||||
},
|
},
|
||||||
|
|
||||||
switchTreatment = function(){
|
switchTreatment = function(){
|
||||||
|
"Switch treatment value."
|
||||||
cl <- class(.self$data[, 2])
|
cl <- class(.self$data[, 2])
|
||||||
# Treatments must be numeric or integer and binary
|
# Treatments must be numeric or integer and binary
|
||||||
.self$data[, 2] <- 1 - .self$data[, 2]
|
.self$data[, 2] <- 1 - .self$data[, 2]
|
||||||
|
@ -75,6 +82,7 @@ VT.object <- setRefClass(
|
||||||
},
|
},
|
||||||
|
|
||||||
computeDelta = function(){
|
computeDelta = function(){
|
||||||
|
"Compute delta value."
|
||||||
if(.self$type == "binary"){
|
if(.self$type == "binary"){
|
||||||
.self$delta <- sum((as.numeric(.self$data[, 1]) - 1)*(.self$data[, 2])) / sum(.self$data[, 2]) -
|
.self$delta <- sum((as.numeric(.self$data[, 1]) - 1)*(.self$data[, 2])) / sum(.self$data[, 2]) -
|
||||||
sum((as.numeric(.self$data[, 1]) - 1)*(1 - .self$data[, 2])) / sum(1 - .self$data[, 2])
|
sum((as.numeric(.self$data[, 1]) - 1)*(1 - .self$data[, 2])) / sum(1 - .self$data[, 2])
|
||||||
|
@ -86,6 +94,7 @@ VT.object <- setRefClass(
|
||||||
},
|
},
|
||||||
|
|
||||||
getIncidences = function(){
|
getIncidences = function(){
|
||||||
|
"Return incidence table of data."
|
||||||
return(vt.getIncidence(.self$data))
|
return(vt.getIncidence(.self$data))
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
|
|
34
R/predict.R
34
R/predict.R
|
@ -3,17 +3,33 @@
|
||||||
# LES METHODES SUIVANTES PERMETTENT DE PREDIRE LA PROBA D'INTERET POUR
|
# LES METHODES SUIVANTES PERMETTENT DE PREDIRE LA PROBA D'INTERET POUR
|
||||||
# LES TROIS CLASSES SUIVANTES : train, randomForest, RandomForest{party}
|
# LES TROIS CLASSES SUIVANTES : train, randomForest, RandomForest{party}
|
||||||
|
|
||||||
|
|
||||||
|
#' VT.predict generic function
|
||||||
|
#'
|
||||||
|
#' @param rfor random forest model. Can be train, randomForest or RandomForest
|
||||||
|
#' class.
|
||||||
|
#' @param newdata Newdata to predict by the random forest model. If missing, OOB
|
||||||
|
#' predictions are returned.
|
||||||
|
#' @param type Must be binary or continous, depending on the outcome. Only
|
||||||
|
#' binary is really available.
|
||||||
|
#'
|
||||||
|
#' @return vector \eqn{E(Y=1)}
|
||||||
|
#'
|
||||||
|
#' @include setClass.R
|
||||||
|
#' @importClassesFrom party RandomForest
|
||||||
setGeneric("VT.predict",
|
setGeneric("VT.predict",
|
||||||
function(rfor, newdata, type){standardGeneric("VT.predict")}
|
function(rfor, newdata, type){standardGeneric("VT.predict")}
|
||||||
)
|
)
|
||||||
|
|
||||||
|
#' @describeIn VT.predict
|
||||||
setMethod(
|
setMethod(
|
||||||
f = "VT.predict",
|
f = "VT.predict",
|
||||||
signature = c(rfor = "RandomForest", newdata = "missing", type = "character"),
|
signature = c(rfor = "RandomForest", newdata = "missing", type = "character"),
|
||||||
function(rfor, type = "binary"){
|
function(rfor, type = "binary"){
|
||||||
if(! type %in% c("binary", "continous")) stop("Type must be Binary or continous")
|
if(! type %in% c("binary", "continous")) stop("Type must be Binary or continous")
|
||||||
if(type == "binary"){
|
if(type == "binary"){
|
||||||
tmp <- predict(rfor, OOB = T, type = "prob")
|
if(!requireNamespace("party", quietly = TRUE)) stop("Party package must be loaded.")
|
||||||
|
tmp <- predict.RandomForest(rfor, OOB = T, type = "prob")
|
||||||
tmp <- unlist(tmp)
|
tmp <- unlist(tmp)
|
||||||
tmp <- tmp[seq(2, length(tmp), 2)]
|
tmp <- tmp[seq(2, length(tmp), 2)]
|
||||||
}else{
|
}else{
|
||||||
|
@ -25,13 +41,15 @@ setMethod(
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
|
|
||||||
|
#' @describeIn VT.predict
|
||||||
setMethod(
|
setMethod(
|
||||||
f = "VT.predict",
|
f = "VT.predict",
|
||||||
signature = c(rfor = "RandomForest", newdata = "data.frame", type = "character"),
|
signature = c(rfor = "RandomForest", newdata = "data.frame", type = "character"),
|
||||||
function(rfor, newdata, type = "binary"){
|
function(rfor, newdata, type = "binary"){
|
||||||
if(! type %in% c("binary", "continous")) stop("Type must be Binary or continous")
|
if(! type %in% c("binary", "continous")) stop("Type must be Binary or continous")
|
||||||
if(type == "binary"){
|
if(type == "binary"){
|
||||||
tmp <- predict(rfor, newdata = newdata, type = "prob")
|
if(!requireNamespace("party", quietly = TRUE)) stop("Party package must be loaded.")
|
||||||
|
tmp <- predict.RandomForest(rfor, newdata = newdata, type = "prob")
|
||||||
tmp <- unlist(tmp)
|
tmp <- unlist(tmp)
|
||||||
tmp <- tmp[seq(2, length(tmp), 2)]
|
tmp <- tmp[seq(2, length(tmp), 2)]
|
||||||
}else{
|
}else{
|
||||||
|
@ -43,6 +61,7 @@ setMethod(
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
|
|
||||||
|
#' @describeIn VT.predict
|
||||||
setMethod(
|
setMethod(
|
||||||
f = "VT.predict",
|
f = "VT.predict",
|
||||||
signature = c(rfor = "randomForest", newdata = "missing", type = "character"),
|
signature = c(rfor = "randomForest", newdata = "missing", type = "character"),
|
||||||
|
@ -51,7 +70,8 @@ setMethod(
|
||||||
if(type == "binary"){
|
if(type == "binary"){
|
||||||
# no longer available in all version ?!
|
# no longer available in all version ?!
|
||||||
# tmp <- rfor$vote[, 2] # get the "o" prob
|
# tmp <- rfor$vote[, 2] # get the "o" prob
|
||||||
tmp <- predict(rfor, type = "prob")[, 2] # We want to get the "o" prob
|
if(!requireNamespace("randomForest", quietly = TRUE)) stop("randomForest package must be loaded.")
|
||||||
|
tmp <- predict.randomForest(rfor, type = "prob")[, 2] # We want to get the "o" prob
|
||||||
}else{
|
}else{
|
||||||
message("continous is not done yet")
|
message("continous is not done yet")
|
||||||
tmp <- NULL
|
tmp <- NULL
|
||||||
|
@ -60,13 +80,15 @@ setMethod(
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
|
|
||||||
|
#' @describeIn VT.predict
|
||||||
setMethod(
|
setMethod(
|
||||||
f = "VT.predict",
|
f = "VT.predict",
|
||||||
signature = c(rfor = "randomForest", newdata = "data.frame", type = "character"),
|
signature = c(rfor = "randomForest", newdata = "data.frame", type = "character"),
|
||||||
function(rfor, newdata, type = "binary"){
|
function(rfor, newdata, type = "binary"){
|
||||||
if(! type %in% c("binary", "continous")) stop("Type must be Binary or continous")
|
if(! type %in% c("binary", "continous")) stop("Type must be Binary or continous")
|
||||||
if(type == "binary"){
|
if(type == "binary"){
|
||||||
tmp <- predict(rfor, newdata = newdata, type = "prob")[, 2] # We want to get the "o" prob
|
if(!requireNamespace("randomForest", quietly = TRUE)) stop("randomForest package must be loaded.")
|
||||||
|
tmp <- predict.randomForest(rfor, newdata = newdata, type = "prob")[, 2] # We want to get the "o" prob
|
||||||
}else{
|
}else{
|
||||||
message("continous is not done yet")
|
message("continous is not done yet")
|
||||||
tmp <- NULL
|
tmp <- NULL
|
||||||
|
@ -75,18 +97,22 @@ setMethod(
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
|
|
||||||
|
#' @describeIn VT.predict
|
||||||
setMethod(
|
setMethod(
|
||||||
f = "VT.predict",
|
f = "VT.predict",
|
||||||
signature = c(rfor = "train", newdata = "ANY", type = "character"),
|
signature = c(rfor = "train", newdata = "ANY", type = "character"),
|
||||||
function(rfor, newdata, type = "binary"){
|
function(rfor, newdata, type = "binary"){
|
||||||
|
if(!requireNamespace("caret", quietly = TRUE)) stop("randomForest package must be loaded.")
|
||||||
return(VT.predict(rfor$finalModel, newdata, type))
|
return(VT.predict(rfor$finalModel, newdata, type))
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
|
|
||||||
|
#' @describeIn VT.predict
|
||||||
setMethod(
|
setMethod(
|
||||||
f = "VT.predict",
|
f = "VT.predict",
|
||||||
signature = c(rfor = "train", newdata = "missing", type = "character"),
|
signature = c(rfor = "train", newdata = "missing", type = "character"),
|
||||||
function(rfor, type = "binary"){
|
function(rfor, type = "binary"){
|
||||||
|
if(!requireNamespace("caret", quietly = TRUE)) stop("randomForest package must be loaded.")
|
||||||
return(VT.predict(rfor=rfor$finalModel, type=type))
|
return(VT.predict(rfor=rfor$finalModel, type=type))
|
||||||
}
|
}
|
||||||
)
|
)
|
3
R/setClass.R
Normal file
3
R/setClass.R
Normal file
|
@ -0,0 +1,3 @@
|
||||||
|
setOldClass("randomForest")
|
||||||
|
setOldClass("train")
|
||||||
|
setOldClass("rpart")
|
31
R/tree.R
31
R/tree.R
|
@ -1,20 +1,17 @@
|
||||||
# TREES COMPUTATIONS ------------------------------------------------------
|
# TREES COMPUTATIONS ------------------------------------------------------
|
||||||
|
#' An abstract reference class to compute tree
|
||||||
# outcome - variable à expliquer par l'arbre (continue ou binaire)
|
#'
|
||||||
# threshold - seuil à dépasser par difft
|
#' @include difft.R setClass.R
|
||||||
# screening - override de vt.forest$screening sinon prend la valeur de vt.forest$screening
|
#'
|
||||||
# name - nom de l'arbre
|
#' @field vt.difft VT.difft object
|
||||||
# tree - objet rpart (l'arbre en lui même)
|
#' @field outcome vector
|
||||||
# Ahat - indicatrice des observations appartement à Ahat (toujours en fonction du treshold)
|
#' @field threshold numeric Threshold for difft (c)
|
||||||
# NE PAS OUBLIER QUE CELA DEPEND EGALEMENT DE LA FORET ASSOCIEE
|
#' @field screening logical TRUE if using varimp (default is VT.object screening field)
|
||||||
#
|
#' @field sens character Sens can be ">" (default) or "<". Meaning : difft > threshold or difft < threshold
|
||||||
# $getData() - les variables explicatives de l'arbre: soit les X, soit intersections de X et vt.forest$varimp
|
#' @field name character Names of the tree
|
||||||
# $run(...) - lance l'arbre, en options les paramètre de rpart(...)
|
#' @field tree rpart Rpart object to construct the tree
|
||||||
# $getInfos() - Résume threshold, delta, sizeof Ahat.
|
#' @field Ahat vector Indicator of beglonging to Ahat
|
||||||
# $getRules() - Récupère les incidences, les règles, les stats de chaques noeuds (terminaux ou non, favorable ou non)
|
#'
|
||||||
# $getIncidences() - Récupère un tableau d'incidence d'une rule
|
|
||||||
# $getAhatIncidence - Récupère le tableau d'incidence de Ahat
|
|
||||||
# $getAhatQualty - Récupère la qualité de Ahat (snd, resub)
|
|
||||||
VT.tree <- setRefClass(
|
VT.tree <- setRefClass(
|
||||||
Class = "VT.tree",
|
Class = "VT.tree",
|
||||||
|
|
||||||
|
@ -122,7 +119,7 @@ VT.tree <- setRefClass(
|
||||||
if (length(frm) == 0) stop("VT.tree : no tree");
|
if (length(frm) == 0) stop("VT.tree : no tree");
|
||||||
if (ncol(frm)==0) stop("VT.tree : no rules");
|
if (ncol(frm)==0) stop("VT.tree : no rules");
|
||||||
|
|
||||||
pth <- path.rpart(.self$tree, nodes = row.names(frm), print.it = F)
|
pth <- rpart::path.rpart(.self$tree, nodes = row.names(frm), print.it = F)
|
||||||
# Delete 'root' node des règles
|
# Delete 'root' node des règles
|
||||||
pth <- lapply(pth, FUN = function(d) return(d[-1]))
|
pth <- lapply(pth, FUN = function(d) return(d[-1]))
|
||||||
|
|
||||||
|
|
|
@ -1,5 +1,8 @@
|
||||||
# VT.TREE.CLASS -----------------------------------------------------------
|
# VT.TREE.CLASS -----------------------------------------------------------
|
||||||
|
|
||||||
|
#' A reference class to compute subgroups by classifiation tree
|
||||||
|
#'
|
||||||
|
#' @include tree.R
|
||||||
VT.tree.class <- setRefClass(
|
VT.tree.class <- setRefClass(
|
||||||
Class = "VT.tree.class",
|
Class = "VT.tree.class",
|
||||||
|
|
||||||
|
@ -23,7 +26,7 @@ VT.tree.class <- setRefClass(
|
||||||
|
|
||||||
data <- .self$getData()
|
data <- .self$getData()
|
||||||
if(sum(data[,1]) != 0){
|
if(sum(data[,1]) != 0){
|
||||||
.self$tree <- rpart(as.formula(paste(.self$name, ".", sep = "~")), data = data, method = "class", ...)
|
.self$tree <- rpart::rpart(as.formula(paste(.self$name, ".", sep = "~")), data = data, method = "class", ...)
|
||||||
.self$Ahat <- as.numeric(predict(.self$tree, data, type = "class")) - 1
|
.self$Ahat <- as.numeric(predict(.self$tree, data, type = "class")) - 1
|
||||||
}else{
|
}else{
|
||||||
.self$Ahat <- .self$outcome
|
.self$Ahat <- .self$outcome
|
||||||
|
|
|
@ -1,7 +1,9 @@
|
||||||
|
|
||||||
|
|
||||||
# VT.TREE.REG -------------------------------------------------------------
|
# VT.TREE.REG -------------------------------------------------------------
|
||||||
|
|
||||||
|
#' @include tree.R
|
||||||
|
#' A reference class to compute subgroups by regression tree with rpart package
|
||||||
|
#'
|
||||||
|
|
||||||
VT.tree.reg <- setRefClass(
|
VT.tree.reg <- setRefClass(
|
||||||
Class = "VT.tree.reg",
|
Class = "VT.tree.reg",
|
||||||
|
|
||||||
|
@ -21,7 +23,7 @@ VT.tree.reg <- setRefClass(
|
||||||
|
|
||||||
data <- .self$getData()
|
data <- .self$getData()
|
||||||
|
|
||||||
.self$tree <- rpart(as.formula(paste(.self$name, ".", sep = "~")), data = data, ...)
|
.self$tree <- rpart::rpart(as.formula(paste(.self$name, ".", sep = "~")), data = data, ...)
|
||||||
|
|
||||||
if(.self$sens == ">")
|
if(.self$sens == ">")
|
||||||
res <- ifelse(predict(.self$tree) >= (.self$threshold), 1, 0)
|
res <- ifelse(predict(.self$tree) >= (.self$threshold), 1, 0)
|
||||||
|
|
27
man/VT.difft-class.Rd
Normal file
27
man/VT.difft-class.Rd
Normal file
|
@ -0,0 +1,27 @@
|
||||||
|
% Generated by roxygen2 (4.1.1): do not edit by hand
|
||||||
|
% Please edit documentation in R/difft.R
|
||||||
|
\docType{class}
|
||||||
|
\name{VT.difft-class}
|
||||||
|
\alias{VT.difft}
|
||||||
|
\alias{VT.difft-class}
|
||||||
|
\title{A reference class to represent difference between twin1 and twin2}
|
||||||
|
\description{
|
||||||
|
A reference class to represent difference between twin1 and twin2
|
||||||
|
}
|
||||||
|
\section{Fields}{
|
||||||
|
|
||||||
|
\describe{
|
||||||
|
\item{\code{vt.object}}{VT.object (refClass) representing data}
|
||||||
|
|
||||||
|
\item{\code{twin1}}{vector of \eqn{E(Y|T= real treatment)}}
|
||||||
|
|
||||||
|
\item{\code{twin2}}{vector of \eqn{E(Y|T= antoher treatment)}}
|
||||||
|
|
||||||
|
\item{\code{difft}}{vector of difference between twin1 and twin2}
|
||||||
|
}}
|
||||||
|
\section{Methods}{
|
||||||
|
|
||||||
|
\describe{
|
||||||
|
\item{\code{computeDifft()}}{Compute difference between twin1 and twin2}
|
||||||
|
}}
|
||||||
|
|
20
man/VT.forest-class.Rd
Normal file
20
man/VT.forest-class.Rd
Normal file
|
@ -0,0 +1,20 @@
|
||||||
|
% Generated by roxygen2 (4.1.1): do not edit by hand
|
||||||
|
% Please edit documentation in R/forest.R
|
||||||
|
\docType{class}
|
||||||
|
\name{VT.forest-class}
|
||||||
|
\alias{VT.forest}
|
||||||
|
\alias{VT.forest-class}
|
||||||
|
\title{A abstract reference class to compute twin via random forests}
|
||||||
|
\description{
|
||||||
|
A abstract reference class to compute twin via random forests
|
||||||
|
}
|
||||||
|
\section{Methods}{
|
||||||
|
|
||||||
|
\describe{
|
||||||
|
\item{\code{checkModel(model)}}{Checking model class: Must be : train, RandomForest, randomForest}
|
||||||
|
|
||||||
|
\item{\code{getFullData()}}{Return twin1, twin2 and difft in column}
|
||||||
|
|
||||||
|
\item{\code{run()}}{Compute twin1 and twin2 computation. Switch treatment if necessary.}
|
||||||
|
}}
|
||||||
|
|
25
man/VT.forest.double-class.Rd
Normal file
25
man/VT.forest.double-class.Rd
Normal file
|
@ -0,0 +1,25 @@
|
||||||
|
% Generated by roxygen2 (4.1.1): do not edit by hand
|
||||||
|
% Please edit documentation in R/forest.double.R
|
||||||
|
\docType{class}
|
||||||
|
\name{VT.forest.double-class}
|
||||||
|
\alias{VT.forest.double}
|
||||||
|
\alias{VT.forest.double-class}
|
||||||
|
\title{A reference class to compute twins via double random forests}
|
||||||
|
\description{
|
||||||
|
A reference class to compute twins via double random forests
|
||||||
|
}
|
||||||
|
\section{Fields}{
|
||||||
|
|
||||||
|
\describe{
|
||||||
|
\item{\code{model_trt1}}{a caret/RandomForest/randomForest object for treatment T = 1}
|
||||||
|
|
||||||
|
\item{\code{model_trt0}}{a caret/RandomForest/randomForest object for treatment T = 0}
|
||||||
|
}}
|
||||||
|
\section{Methods}{
|
||||||
|
|
||||||
|
\describe{
|
||||||
|
\item{\code{computeTwin1()}}{Compute twin1 with OOB predictions from double forests}
|
||||||
|
|
||||||
|
\item{\code{computeTwin2()}}{Compute twin2 by the other part of data in the other forest}
|
||||||
|
}}
|
||||||
|
|
27
man/VT.forest.fold-class.Rd
Normal file
27
man/VT.forest.fold-class.Rd
Normal file
|
@ -0,0 +1,27 @@
|
||||||
|
% Generated by roxygen2 (4.1.1): do not edit by hand
|
||||||
|
% Please edit documentation in R/forest.fold.R
|
||||||
|
\docType{class}
|
||||||
|
\name{VT.forest.fold-class}
|
||||||
|
\alias{VT.forest.fold}
|
||||||
|
\alias{VT.forest.fold-class}
|
||||||
|
\title{A reference class to compute twins via k random forest}
|
||||||
|
\description{
|
||||||
|
A reference class to compute twins via k random forest
|
||||||
|
}
|
||||||
|
\section{Fields}{
|
||||||
|
|
||||||
|
\describe{
|
||||||
|
\item{\code{interactions}}{logical set TRUE if model has been computed with interactions}
|
||||||
|
|
||||||
|
\item{\code{fold}}{numeric Number of fold, i.e. number of forest}
|
||||||
|
|
||||||
|
\item{\code{ratio}}{numeric}
|
||||||
|
|
||||||
|
\item{\code{groups}}{vector Define which observations belong to which group}
|
||||||
|
}}
|
||||||
|
\section{Methods}{
|
||||||
|
|
||||||
|
\describe{
|
||||||
|
\item{\code{run()}}{Compute twin1 and twin2 computation. Switch treatment if necessary.}
|
||||||
|
}}
|
||||||
|
|
27
man/VT.forest.one-class.Rd
Normal file
27
man/VT.forest.one-class.Rd
Normal file
|
@ -0,0 +1,27 @@
|
||||||
|
% Generated by roxygen2 (4.1.1): do not edit by hand
|
||||||
|
% Please edit documentation in R/forest.one.R
|
||||||
|
\docType{class}
|
||||||
|
\name{VT.forest.one-class}
|
||||||
|
\alias{VT.forest.one}
|
||||||
|
\alias{VT.forest.one-class}
|
||||||
|
\title{A reference class to compute twins via one random forest}
|
||||||
|
\description{
|
||||||
|
A reference class to compute twins via one random forest
|
||||||
|
}
|
||||||
|
\section{Fields}{
|
||||||
|
|
||||||
|
\describe{
|
||||||
|
\item{\code{model}}{ANY a caret/RandomForest/randomForest class object}
|
||||||
|
|
||||||
|
\item{\code{interactions}}{logical set TRUE if model has been computed with interactions}
|
||||||
|
|
||||||
|
\item{\code{...}}{field from parent class : VT.forest}
|
||||||
|
}}
|
||||||
|
\section{Methods}{
|
||||||
|
|
||||||
|
\describe{
|
||||||
|
\item{\code{computeTwin1()}}{Compute twin1 with OOB predictions}
|
||||||
|
|
||||||
|
\item{\code{computeTwin2()}}{Compute twin2 by switching treatment and applying random forest model}
|
||||||
|
}}
|
||||||
|
|
48
man/VT.object-class.Rd
Normal file
48
man/VT.object-class.Rd
Normal file
|
@ -0,0 +1,48 @@
|
||||||
|
% Generated by roxygen2 (4.1.1): do not edit by hand
|
||||||
|
% Please edit documentation in R/object.R
|
||||||
|
\docType{class}
|
||||||
|
\name{VT.object-class}
|
||||||
|
\alias{VT.object}
|
||||||
|
\alias{VT.object-class}
|
||||||
|
\title{A Reference Class to deal with RCT dataset}
|
||||||
|
\description{
|
||||||
|
A Reference Class to deal with RCT dataset
|
||||||
|
}
|
||||||
|
\section{Fields}{
|
||||||
|
|
||||||
|
\describe{
|
||||||
|
\item{\code{data}}{A data.frame de la forme \eqn{Y,T,X_{1}, \ldots, X_{p}}. Y must
|
||||||
|
be two levels factor if type is binary. T must be numeric or integer.}
|
||||||
|
|
||||||
|
\item{\code{alpha}}{no usefull now, set to 1}
|
||||||
|
|
||||||
|
\item{\code{screening}}{logical, set to FALSE. Se TRUE to use varimp in trees
|
||||||
|
computation}
|
||||||
|
|
||||||
|
\item{\code{varimp}}{character vector of important variables to use in trees
|
||||||
|
computation}
|
||||||
|
|
||||||
|
\item{\code{delta}}{numeric representing the difference of incidence between
|
||||||
|
treatments}
|
||||||
|
|
||||||
|
\item{\code{type}}{character : binary or continous. Only binary is possible.}
|
||||||
|
}}
|
||||||
|
\section{Methods}{
|
||||||
|
|
||||||
|
\describe{
|
||||||
|
\item{\code{computeDelta()}}{Compute delta value.}
|
||||||
|
|
||||||
|
\item{\code{getFormula()}}{Return formula : Y~T+X1+...+Xp. Usefull for cforest function.}
|
||||||
|
|
||||||
|
\item{\code{getIncidences()}}{Return incidence table of data.}
|
||||||
|
|
||||||
|
\item{\code{getX(interactions = T, trt = NULL)}}{Return predictors {T,X,X*T,X*(1-T)}. Or {T,X} if interactions is FALSE.
|
||||||
|
If trt is not NULL, return predictors for T=trt}
|
||||||
|
|
||||||
|
\item{\code{getXwithInt()}}{Return predictors with interactions. Use VT.object::getX(interactions = T) instead.}
|
||||||
|
|
||||||
|
\item{\code{getY(trt = NULL)}}{Return outcome. If trt is not NULL, return outcome for T=trt.}
|
||||||
|
|
||||||
|
\item{\code{switchTreatment()}}{Switch treatment value.}
|
||||||
|
}}
|
||||||
|
|
60
man/VT.predict.Rd
Normal file
60
man/VT.predict.Rd
Normal file
|
@ -0,0 +1,60 @@
|
||||||
|
% Generated by roxygen2 (4.1.1): do not edit by hand
|
||||||
|
% Please edit documentation in R/predict.R
|
||||||
|
\docType{methods}
|
||||||
|
\name{VT.predict}
|
||||||
|
\alias{VT.predict}
|
||||||
|
\alias{VT.predict,RandomForest,data.frame,character-method}
|
||||||
|
\alias{VT.predict,RandomForest,missing,character-method}
|
||||||
|
\alias{VT.predict,randomForest,data.frame,character-method}
|
||||||
|
\alias{VT.predict,randomForest,missing,character-method}
|
||||||
|
\alias{VT.predict,train,ANY,character-method}
|
||||||
|
\alias{VT.predict,train,missing,character-method}
|
||||||
|
\title{VT.predict generic function}
|
||||||
|
\usage{
|
||||||
|
VT.predict(rfor, newdata, type)
|
||||||
|
|
||||||
|
\S4method{VT.predict}{RandomForest,missing,character}(rfor, type = "binary")
|
||||||
|
|
||||||
|
\S4method{VT.predict}{RandomForest,data.frame,character}(rfor, newdata,
|
||||||
|
type = "binary")
|
||||||
|
|
||||||
|
\S4method{VT.predict}{randomForest,missing,character}(rfor, type = "binary")
|
||||||
|
|
||||||
|
\S4method{VT.predict}{randomForest,data.frame,character}(rfor, newdata,
|
||||||
|
type = "binary")
|
||||||
|
|
||||||
|
\S4method{VT.predict}{train,ANY,character}(rfor, newdata, type = "binary")
|
||||||
|
|
||||||
|
\S4method{VT.predict}{train,missing,character}(rfor, type = "binary")
|
||||||
|
}
|
||||||
|
\arguments{
|
||||||
|
\item{rfor}{random forest model. Can be train, randomForest or RandomForest
|
||||||
|
class.}
|
||||||
|
|
||||||
|
\item{newdata}{Newdata to predict by the random forest model. If missing, OOB
|
||||||
|
predictions are returned.}
|
||||||
|
|
||||||
|
\item{type}{Must be binary or continous, depending on the outcome. Only
|
||||||
|
binary is really available.}
|
||||||
|
}
|
||||||
|
\value{
|
||||||
|
vector \eqn{E(Y=1)}
|
||||||
|
}
|
||||||
|
\description{
|
||||||
|
VT.predict generic function
|
||||||
|
}
|
||||||
|
\section{Methods (by class)}{
|
||||||
|
\itemize{
|
||||||
|
\item \code{rfor = RandomForest,newdata = missing,type = character}:
|
||||||
|
|
||||||
|
\item \code{rfor = RandomForest,newdata = data.frame,type = character}:
|
||||||
|
|
||||||
|
\item \code{rfor = randomForest,newdata = missing,type = character}:
|
||||||
|
|
||||||
|
\item \code{rfor = randomForest,newdata = data.frame,type = character}:
|
||||||
|
|
||||||
|
\item \code{rfor = train,newdata = ANY,type = character}:
|
||||||
|
|
||||||
|
\item \code{rfor = train,newdata = missing,type = character}:
|
||||||
|
}}
|
||||||
|
|
30
man/VT.tree-class.Rd
Normal file
30
man/VT.tree-class.Rd
Normal file
|
@ -0,0 +1,30 @@
|
||||||
|
% Generated by roxygen2 (4.1.1): do not edit by hand
|
||||||
|
% Please edit documentation in R/tree.R
|
||||||
|
\docType{class}
|
||||||
|
\name{VT.tree-class}
|
||||||
|
\alias{VT.tree}
|
||||||
|
\alias{VT.tree-class}
|
||||||
|
\title{An abstract reference class to compute tree}
|
||||||
|
\description{
|
||||||
|
An abstract reference class to compute tree
|
||||||
|
}
|
||||||
|
\section{Fields}{
|
||||||
|
|
||||||
|
\describe{
|
||||||
|
\item{\code{vt.difft}}{VT.difft object}
|
||||||
|
|
||||||
|
\item{\code{outcome}}{vector}
|
||||||
|
|
||||||
|
\item{\code{threshold}}{numeric Threshold for difft (c)}
|
||||||
|
|
||||||
|
\item{\code{screening}}{logical TRUE if using varimp (default is VT.object screening field)}
|
||||||
|
|
||||||
|
\item{\code{sens}}{character Sens can be ">" (default) or "<". Meaning : difft > threshold or difft < threshold}
|
||||||
|
|
||||||
|
\item{\code{name}}{character Names of the tree}
|
||||||
|
|
||||||
|
\item{\code{tree}}{rpart Rpart object to construct the tree}
|
||||||
|
|
||||||
|
\item{\code{Ahat}}{vector Indicator of beglonging to Ahat}
|
||||||
|
}}
|
||||||
|
|
11
man/VT.tree.class-class.Rd
Normal file
11
man/VT.tree.class-class.Rd
Normal file
|
@ -0,0 +1,11 @@
|
||||||
|
% Generated by roxygen2 (4.1.1): do not edit by hand
|
||||||
|
% Please edit documentation in R/tree.class.R
|
||||||
|
\docType{class}
|
||||||
|
\name{VT.tree.class-class}
|
||||||
|
\alias{VT.tree.class}
|
||||||
|
\alias{VT.tree.class-class}
|
||||||
|
\title{A reference class to compute subgroups by classifiation tree}
|
||||||
|
\description{
|
||||||
|
A reference class to compute subgroups by classifiation tree
|
||||||
|
}
|
||||||
|
|
Loading…
Reference in a new issue