Create initial app building function

zajichek commented 1 year ago

The initial intent of the package is to be able to easily build applications at https://riskcalc.org/. These are generally in a standard, common format, so we'll start by tailoring the functionality of the package to these (with a long-term goal of abstracting and generalizes the construction of a "risk calculator").

We'll use https://riskcalc.org/bladderCancer/ as a guide to define function(s) to build replicate-able apps to these with ease.

From there we can continually iterate by looking at another app, try to reconstruct with current package source code, and refine as needed. Eventually we'll have a first version of a working tool for building apps at https://riskcalc.org/.

zajichek commented 1 year ago

Note: The source code for this application has been added to https://github.com/ClevelandClinicQHS/riskcalc-website/tree/main/bladderCancer

To start building functionality to streamline this app, we can imagine doing something like this:

# Build set of inputs
inputs <-

  # Each element is one input (risk factor) in that order
  list(
    Intercept = -2.1264314, # Optionally add a list element called 'Intercept'
    Gender =
      list(
        label = "Gender",
        levels = c("Female", "Male"), # Indicates categorical
        weights = c(0, 0.034072352)
      ),
    AgeYr =
      list(
        label = "Age (Years)",
        range = c(20, 100), # Indicates numeric
        x_trans =
          list(
            \(x)x,
            \(x)max(x - 44, 0)**3,
            \(x)max(x - 62, 0)**3,
            \(x)max(x - 77, 0)**3
           ), # Each of these contributes to weighted sum
        weights = c(0.0041362795, 7.4691198e-06, 1.6432063e-05, 8.9629437e-06)
      ),
    Stage97 =
      list(
        label = "RC Tumor Pathology",
        levels = c("pT0", "pTa", "pTis", "pT1", "pT2", "pT3", "pT4"),
        weights = c(0, 0.87060903, 0.55456587, 1.0188265, 1.2332424, 1.8741757, 2.4566641)
      ),
    Histology =
      list(
        label = "RC Tumor Histology",
        levels = c("ADENOCARCINOMA", "SCC", "TCC"),
        weights = c(0, 0.34940226, 0.72706351)
      ),
    Grade =
      list(
        label = "RC Tumor Grade",
        levels = c("GX", "High", "Low"),
        weights = c(0, 0.17941245)
      ),
    NodeResult =
      list(
        label = "Lymph Node Status",
        levels = c("NX", "Negative", "Positive"),
        weights = c(0, 0.29095514, 0.87448703, 0.69780658)
      ),
    DxToRC =
      list(
        label = "Days Between Dx and RC (Days)",
        range = c(0, 100000),
        x_trans =
          list(
            \(x)x,
            \(x)max(x - 0.45996875, 0)**3,
            \(x)max(x - 3.5483304, 0)**3,
            \(x)max(x - 27.808397, 0)**3
           ),
        weights = c(0, 2.9994932e-05, 3.3813355e-05, 3.8184231e-06)
      )
  )

# Build outputs to display in the table
outputs <-
  list(
    res =
      list(
        label = "Percentage of 5-Year Recurrence-Free Survival",
        lp_trans = \(x) 100 * 0.7524126 ** exp(x) # Transformation for linear predictor
      )
  )

# Make risk calculator (doesn't work yet)
risk_calculator(
  inputs = inputs,
  outputs = outputs,
  title = "Predicting 5-Year Recurrence-Free Survival after Radical Cystectomy for Bladder Cancer",
  ...
)

The inputs represent the risk factors in which an input will be created for, as well as the weights from the risk factor that contribute to the linear combination. Other info in the list can imply what type of input to make (e.g., range implies it's a numeric factor)
The outputs represent what to display the table. In this case, we just want a single number (row), which is some transformation of the linear predictor.

From there we can define functionality within the package to:

Create the set of (shiny) _Input objects for each risk factor
Compute the linear predictor from the inputs
Compute the displayed output by performing the transformations
Add the shiny template that captures the general structure of the app (such that the arguments to risk_calculator are what customize it to the context)

zajichek commented 1 year ago

From last comment...

Creating the set of inputs

We can create an internal function that creates the object based on the structure of the input

create_input <-
  function(input, inputId) {
    if("range" %in% names(input)) {
      shiny::textInput(
        inputId = inputId,
        label = input$label,
        placeholder = paste(input$range, collapse = "-")
      )
    } else if("levels" %in% names(input)) {
      shiny::selectInput(
        inputId = inputId,
        label = input$label,
        choices = input$levels
      )
    } else {
      NULL
    }
  }

Then call this function iteratively to construct the list of inputs

shiny_inputs <- list()
for(i in seq_along(inputs))
  shiny_inputs[[i]] <- create_input(inputs[[i]], names(inputs)[i])

Finally, add these to the user interface:

do.call(
  shiny::sidebarPanel,
  shiny_inputs
)

zajichek commented 1 year ago

Computing the linear predictors from the inputs

A lot of ways to think about approaching this. One way is to think about constructing the expression for the linear predictor as a string, and then parsing it as R code once evaluated within the server. For example, this code renders the output of the first input by referencing its name from the list's name vector:

server <-
  function(input, output) {
    output$show_text <- shiny::renderText({eval(parse(text = paste0("input$", names(inputs)[[1]])))})
  }

We could iterate the inputs, build the string expression for each factor, concatenate with +, and then pass to the server. Something like that.

Here's an example of constructing the expression for a categorical input and a numeric input:

this_input_id <- names(inputs)[1] # Gender
this_input <- inputs[[this_input_id]]
this_input_expression <- c()
for(j in seq_along(this_input$weights))
  this_input_expression[j] <- paste0(this_input$weights[j], "*input$", this_input_id, "=='", this_input$levels[j], "'")
paste(this_input_expression, collapse = "+")
# [1] "0*input$Gender=='Female'+0.034072352*input$Gender=='Male'"

this_input_id <- names(inputs)[2] # AgeYr
this_input <- inputs[[this_input_id]]
this_input_expression <- c()
for(j in seq_along(this_input$weights))
  this_input_expression[j] <- paste0(this_input$weights[j], "*", "inputs[['", this_input_id, "']]$x_trans[[", j, "]](input$", this_input_id, ")")
paste(this_input_expression, collapse = "+")
# "0.0041362795*inputs[['AgeYr']]$x_trans[[1]](input$AgeYr)+7.4691198e-06*inputs[['AgeYr']]$x_trans[[2]](input$AgeYr)+1.6432063e-05*inputs[['AgeYr']]$x_trans[[3]](input$AgeYr)+8.9629437e-06*inputs[['AgeYr']]$x_trans[[4]](input$AgeYr)"

We would concatenate these strings across all inputs, and then they would be evaluated as R code within the server (so referencing the current input value in the app). For numeric variables, we reference transformation functions created in the inputs argument.

zajichek commented 1 year ago

Create output expression

For the outputs, we can iterate the supplied list and build the output expression like the following:

for(i in seq_along(outputs)) {
  this_output <- outputs[[i]]
  this_output_id <- names(outputs)[i]
  result_row_names[i] <- paste0("outputs$", this_output_id, "$label[", i, "]")
  result_row_values[i] <- paste0("outputs$", this_output_id, "$lp_trans(", <linear predictor>, ")")

}

These vectors can be concatenated and added to a data.frame call, which then encapsulates the full expression that the server needs for evaluation.

zajichek commented 1 year ago

Current package function and associated example reproduces the app referenced above (without some of the details incorporated).

  risk_calculator(
    inputs = inputs,
    outputs = outputs,
    title =
      paste(
        "Predicting 5-Year Recurrence-Free Survival",
        "after Radical Cystectomy for Bladder Cancer"
       ),
    intercept = -2.1264314
  )

This is no where near a finished product, but it's a starting point. Closing issue.

ClevelandClinicQHS / riskcalc

Create initial app building function #8