tlverse / tmle3
Showing 2 of 8 files from the diff.

@@ -46,6 +46,27 @@
Loading
46 46
  transform = rr_transform
47 47
)
48 48
49 +
# Odds Ratio odds(Y1)/odds(Y0)
50 +
f_log_or <- function(x, dx) {
51 +
  log(x[[2]]/(1-x[[2]])) - log(x[[1]]/(1-x[[1]]))
52 +
}
53 +
54 +
df_log_or <- function(x, dx) {
55 +
  dx[[2]] / (x[[2]]*(1-x[[2]])) - dx[[1]] / (x[[1]]*(1-x[[1]]))
56 +
}
57 +
58 +
or_transform <- exp
59 +
60 +
#' Odds Ratio odds(Y1)/odds(Y0)
61 +
#' @export
62 +
delta_param_OR <- list(
63 +
  type = "OR",
64 +
  name = function(names) sprintf("OR(%s/%s)", names[[2]], names[[1]]),
65 +
  f = f_log_or,
66 +
  df = df_log_or,
67 +
  transform = or_transform
68 +
)
69 +
49 70
paf_transform <- function(x) {
50 71
  1 - exp(-x)
51 72
}

@@ -0,0 +1,64 @@
Loading
1 +
#' Defines a TML Estimator for the Odds Ratio
2 +
#'
3 +
#' Current limitations:
4 +
#' pretty much tailored to Param_TSM
5 +
#' see TODOs for places generalization can be added
6 +
#'
7 +
#' @importFrom R6 R6Class
8 +
#'
9 +
#' @export
10 +
#
11 +
tmle3_Spec_OR <- R6Class(
12 +
  classname = "tmle3_Spec_OR",
13 +
  portable = TRUE,
14 +
  class = TRUE,
15 +
  inherit = tmle3_Spec,
16 +
  public = list(
17 +
    initialize = function(baseline_level = 0, contrast = 1, ...) {
18 +
      # TODO: use sl3 param grabbing code
19 +
      options <- list(
20 +
        baseline_level = baseline_level,
21 +
        contrast_level = contrast
22 +
      )
23 +
      do.call(super$initialize, options)
24 +
    },
25 +
    make_params = function(tmle_task, likelihood) {
26 +
      baseline_level <- self$options$baseline_level
27 +
      contrast_level <- self$options$contrast_level
28 +
29 +
      intervention_base <- define_lf(LF_static, "A", value = baseline_level)
30 +
      intervention_cont <- define_lf(LF_static, "A", value = contrast_level)
31 +
32 +
      tsm_base <- Param_TSM$new(likelihood, intervention_base)
33 +
      tsm_cont <- Param_TSM$new(likelihood, intervention_cont)
34 +
      or <- Param_delta$new(
35 +
        likelihood, delta_param_OR,
36 +
        list(tsm_base, tsm_cont)
37 +
      )
38 +
      tmle_params <- list(tsm_base, tsm_cont, or)
39 +
40 +
      return(tmle_params)
41 +
    }
42 +
  ),
43 +
  active = list(),
44 +
  private = list()
45 +
)
46 +
47 +
#' Odds Ratio
48 +
#'
49 +
#' O = (W, A, Y)
50 +
#' W = Covariates
51 +
#' A = Treatment (binary or categorical)
52 +
#' Y = Outcome (binary or bounded continuous)
53 +
#'
54 +
#' @importFrom sl3 make_learner Lrnr_mean
55 +
#'
56 +
#' @param baseline_level The baseline risk group.
57 +
#' @param contrast_level The contrast risk group.
58 +
#'
59 +
#' @export
60 +
#
61 +
tmle_OR <- function(baseline_level, contrast_level) {
62 +
  # TODO: unclear why this has to be in a factory function
63 +
  tmle3_Spec_OR$new(baseline_level, contrast_level)
64 +
}
Files Coverage
R 79.86%
Project Totals (37 files) 79.86%
Sunburst
The inner-most circle is the entire project, moving away from the center are folders then, finally, a single file. The size and color of each slice is representing the number of statements and the coverage, respectively.
Icicle
The top section represents the entire project. Proceeding with folders and finally individual files. The size and color of each slice is representing the number of statements and the coverage, respectively.
Grid
Each block represents a single file in the project. The size and color of each block is represented by the number of statements and the coverage, respectively.
Loading