https://github.com/mrc-ide/human_tsol_FoI_modelling
Raw File
Tip revision: b3eb4c05a42a882c13fb755c3e50dfda0f3e4ef3 authored by Matt on 09 February 2022, 19:33:21 UTC
updated readme - data availability
Tip revision: b3eb4c0
diagnostic_parameter_functions.R
#=============================================================================================================================#
#                                Estimating diagnostic (prior) parameters                                                     #
#=============================================================================================================================#

estimate_alpha_beta_par_diagnostic <-
  function(input_alpha, input_beta, target_l, target_u) {
    
    # Define targets we want to fit to
    #test_alpha <- 84.5 # original
    #test_beta <- 15.5 # original
    
    # mean (of beta prior distribution given by alpha and beta shape parameter as:)
    target_mean <- input_alpha / (input_alpha + input_beta)
    
    # Lower CI
    #target_l <- qbeta(0.025, input_alpha, input_beta)
    # Upper CI
    #target_u <- qbeta(0.975, input_alpha, input_beta)
    
    # Actual upper and low targets to calibrate on for below #
    target_l <- target_l
    target_u <- target_u
    
    # Find parameters
    # Vector of possible alphas
    alpha <- seq(0, 100, 0.1)
    # Vector of corresponding betas, such that alpha / (alpha + beta) = m
    beta <- (alpha - (alpha * target_mean)) / target_mean
    # Lower CI | alpha, beta
    l <- qbeta(0.025, alpha, beta)
    # Upper CI | alpha, beta
    u <- qbeta(0.975, alpha, beta)
    # Best fit
    best <- which.min(abs(l - target_l) + abs(u - target_u))
    
    # Recover input parameters
    alpha[best]
    beta[best]
    
    actual_alpha <- alpha[best] # updated, best fit
    actual_beta <- beta[best] # updated, best fit
    
    actual_mean <- actual_alpha / (actual_alpha + actual_beta) # mean
    actual_mean
    actual_lower <- qbeta(0.025, actual_alpha, actual_beta)
    actual_lower
    actual_upper <- qbeta(0.975, actual_alpha, actual_beta)
    actual_upper
    
    # 0.6592385 (l) and  0.9939759 (u) # given by 11 for alpha and 1.2612613 for beta
    # p = seq(0, 1, length = 100)
    # #par(mfrow = c(1, 1)) #
    # 
    # a <- plot(
    #   p,
    #   dbeta(p, actual_alpha, actual_beta),
    #   ylab = "density",
    #   type = "l",
    #   col = 4
    # ) #
    
    

    return(list(actual_alpha, actual_beta))
  }
back to top