Non-centrality behavior

app.R

library(shiny)
library(dplyr)
library(ggplot2)
library(data.table)
library(tidyr)
library(plotly)


ncp <- function(K, OR, N, R2) {
  b_MR <- K * (OR / (1 + K * (OR - 1)) - 1)
  v_MR <- (K * (1 - K) - b_MR ^ 2) / (N * R2)
  (b_MR ^ 2 / v_MR)
}


params <- data.table::CJ(
  OR = seq(0.1, 3.0, 0.01),
  R2 = c(0.012, 0.019, 0.035, 0.036, 0.048, 0.05)
) 


server <- function(input, output) {
  
  mat <- reactive({
    wide <- params %>% mutate(ncp = ncp(
      K = input$k, OR = OR, N = input$n, R2 = R2
    )) %>% spread(R2, ncp)
    mat <- wide %>% select(-OR) %>% as.matrix()
    rownames(mat) <- wide$OR
    colnames(mat) <- colnames(wide[-1])
    mat
    
  })
  
  output$plot <- renderPlotly({
    NCP <- mat()
    K <- colnames(NCP)
    OR <- rownames(NCP)
    plot_ly(x = ~K, y = ~OR, z = ~NCP) %>% add_surface()
  })
  
}


ui <- fluidPage(
  titlePanel("Non-centrality parameter"),
  
  fluidRow(
    column(6, sliderInput(
        "n",
        "Sample size:",
        min = 0,
        max = 1e8,
        value = 1e3,
        step = 1e2
      )
    ),

    column(6, sliderInput(
      "k",
      "K (Proportion of cases)",
      min = 0.0,
      max = 1.0,
      value = 0.75,
      step = 0.001
    ))
  ),
  
  # Show a plot of the generated distribution
  fluidRow(column(12, plotlyOutput("plot")))
)


shinyApp(ui, server)