Skip to content

Commit

Permalink
Added est_metaphases_frac data frame to explicitly return f (1 - pi_e…
Browse files Browse the repository at this point in the history 
…st) in estimate_partial_body_dolphin() (closes #29)
  • Loading branch information
@aldomann
aldomann committed Jun 12, 2022
1 parent 6c8a2b5 commit 70bee83
Show file tree
Hide file tree
Showing 2 changed files with 52 additions and 9 deletions.
6 changes: 6 additions & 0 deletions R/calcs_estimation.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -364,6 +364,11 @@ estimate_partial_body_dolphin <- function(case_data, fit_coeffs, fit_var_cov_mat
cov_est <- get_cov_ZIP_ML(lambda_est, pi_est, cells)
lambda_est_sd <- sqrt(cov_est[1, 1])

est_metaphases_frac <- data.frame(
pi_estimate = 1 - pi_est,
pi_std_err = sqrt(cov_est[2, 2])
)

# Get confidence interval of lambda estimates
lambda_low <- lambda_est - stats::qnorm(conf_int + (1 - conf_int) / 2) * lambda_est_sd
lambda_upp <- lambda_est + stats::qnorm(conf_int + (1 - conf_int) / 2) * lambda_est_sd
Expand Down Expand Up @@ -451,6 +456,7 @@ estimate_partial_body_dolphin <- function(case_data, fit_coeffs, fit_var_cov_mat
results_list <- list(
est_doses = est_doses,
est_frac = est_frac,
est_metaphases_frac = est_metaphases_frac,
AIC = AIC,
conf_int = conf_int
)
Expand Down
55 changes: 46 additions & 9 deletions R/mod_estimation_server.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -755,6 +755,7 @@ mod_estimation_results_server <- function(input, output, session, stringsAsFacto
# Parse results
est_doses_partial <- results_partial[["est_doses"]]
est_frac_partial <- results_partial[["est_frac"]]
est_metaphases_frac_partial <- results_partial[["est_metaphases_frac"]]
AIC_partial <- results_partial[["AIC"]]
} else if (assessment == "hetero") {
# Input of the parameter gamma and its variance
Expand Down Expand Up @@ -846,6 +847,7 @@ mod_estimation_results_server <- function(input, output, session, stringsAsFacto
# Partial
est_doses_partial = NA,
est_frac_partial = NA,
est_metaphases_frac_partial = NA,
# Heterogeneous
est_mixing_prop_hetero = NA,
est_yields_hetero = NA,
Expand All @@ -870,6 +872,7 @@ mod_estimation_results_server <- function(input, output, session, stringsAsFacto
# Partial
est_results_list[["est_doses_partial"]] <- est_doses_partial
est_results_list[["est_frac_partial"]] <- est_frac_partial
est_results_list[["est_metaphases_frac_partial"]] <- est_metaphases_frac_partial
# Reset Heterogeneous
est_results_list[["est_mixing_prop_hetero"]] <- NA
est_results_list[["est_yields_hetero"]] <- NA
Expand All @@ -887,6 +890,7 @@ mod_estimation_results_server <- function(input, output, session, stringsAsFacto
# Reset Partial
est_results_list[["est_doses_partial"]] <- NA
est_results_list[["est_frac_partial"]] <- NA
est_results_list[["est_metaphases_frac_partial"]] <- NA
# AICs
est_results_list[["AIC_partial"]] <- NA
est_results_list[["AIC_hetero"]] <- AIC_hetero
Expand Down Expand Up @@ -1019,6 +1023,12 @@ mod_estimation_results_server <- function(input, output, session, stringsAsFacto
rHandsontableOutput(session$ns("est_doses_partial"))
),
br(),
h5("Observed fraction of cells scored which were irradiated"),
div(
class = "hot-improved",
rHandsontableOutput(session$ns("est_metaphases_frac_partial"))
),
br(),
h5("Initial fraction of irradiated cells"),
div(
class = "hot-improved",
Expand Down Expand Up @@ -1104,7 +1114,7 @@ mod_estimation_results_server <- function(input, output, session, stringsAsFacto
return(tagList(return_tabbox, hetero_modal))
})

# Estimated recieved doses (whole-body)
# Estimated yield (whole-body)
output$est_yields_whole <- renderRHandsontable({
if (input$button_estimate <= 0) {
return(NULL)
Expand All @@ -1123,7 +1133,7 @@ mod_estimation_results_server <- function(input, output, session, stringsAsFacto
hot_cols(format = "0.000")
})

# Estimated recieved doses (whole-body)
# Estimated recieved dose (whole-body)
output$est_doses_whole <- renderRHandsontable({
if (input$button_estimate <= 0) {
return(NULL)
Expand All @@ -1143,7 +1153,7 @@ mod_estimation_results_server <- function(input, output, session, stringsAsFacto
hot_cols(format = "0.000")
})

# Estimated recieved doses (partial-body)
# Estimated yield (partial-body)
output$est_yields_partial <- renderRHandsontable({
if (input$button_estimate <= 0 | data()[["assessment"]] != "partial-body") {
return(NULL)
Expand All @@ -1154,6 +1164,7 @@ mod_estimation_results_server <- function(input, output, session, stringsAsFacto
as.data.frame() %>%
# Fix possible NA values
dplyr::mutate(dplyr::across(where(is.logical), as.double)) %>%
# Rename columns and rows
`colnames<-`(c("lower", "estimate", "upper")) %>%
`row.names<-`("yield") %>%
# Convert to hot and format table
Expand All @@ -1166,7 +1177,7 @@ mod_estimation_results_server <- function(input, output, session, stringsAsFacto
hot_cols(format = "0.000")
})

# Estimated recieved doses (partial-body)
# Estimated recieved dose (partial-body)
output$est_doses_partial <- renderRHandsontable({
if (input$button_estimate <= 0 | data()[["assessment"]] != "partial-body") {
return(NULL)
Expand All @@ -1177,6 +1188,7 @@ mod_estimation_results_server <- function(input, output, session, stringsAsFacto
as.data.frame() %>%
# Fix possible NA values
dplyr::mutate(dplyr::across(where(is.logical), as.double)) %>%
# Rename columns and rows
`colnames<-`(c("lower", "estimate", "upper")) %>%
`row.names<-`("dose (Gy)") %>%
# Convert to hot and format table
Expand All @@ -1189,7 +1201,28 @@ mod_estimation_results_server <- function(input, output, session, stringsAsFacto
hot_cols(format = "0.000")
})

# Estimated fraction of irradiated blood for dose dose1 (partial-body)
# Estimated fraction of cells scored which were irradiated (partial-body)
output$est_metaphases_frac_partial <- renderRHandsontable({
if (input$button_estimate <= 0 | data()[["assessment"]] != "partial-body") {
return(NULL)
}
data()[["est_metaphases_frac_partial"]] %>%
# Fix possible NA values
dplyr::mutate(dplyr::across(where(is.logical), as.double)) %>%
# Rename columns and rows
`colnames<-`(c("estimate", "std.err")) %>%
`row.names<-`(c("fraction")) %>%
# Convert to hot and format table
rhandsontable(
width = 320,
height = "100%",
rowHeaderWidth = 80
) %>%
hot_cols(colWidths = 80) %>%
hot_cols(format = "0.000")
})

# Estimated fraction of irradiated blood (partial-body)
output$est_frac_partial <- renderRHandsontable({
if (input$button_estimate <= 0 | data()[["assessment"]] != "partial-body") {
return(NULL)
Expand All @@ -1199,6 +1232,7 @@ mod_estimation_results_server <- function(input, output, session, stringsAsFacto
as.data.frame() %>%
# Fix possible NA values
dplyr::mutate(dplyr::across(where(is.logical), as.double)) %>%
# Rename columns and rows
`colnames<-`(c("lower", "estimate", "upper")) %>%
`row.names<-`("fraction") %>%
# Convert to hot and format table
Expand All @@ -1211,15 +1245,15 @@ mod_estimation_results_server <- function(input, output, session, stringsAsFacto
hot_cols(format = "0.000")
})

# Estimated yields (heterogeneous)
# Estimated fractions of irradiated cells (heterogeneous)
output$est_mixing_prop_hetero <- renderRHandsontable({
if (input$button_estimate <= 0 | data()[["assessment"]] != "hetero") {
return(NULL)
}
data()[["est_mixing_prop_hetero"]] %>%
# Fix possible NA values
dplyr::mutate(dplyr::across(where(is.logical), as.double)) %>%
# `colnames<-`(c("y_estimate", "y_std_err", "f_estimate", "f_std_err")) %>%
# Rename columns and rows
`colnames<-`(c("yield", "yield.err", "frac", "frac.err")) %>%
`row.names<-`(c("dose1", "dose2")) %>%
# Convert to hot and format table
Expand All @@ -1232,7 +1266,7 @@ mod_estimation_results_server <- function(input, output, session, stringsAsFacto
hot_cols(format = "0.000")
})

# Estimated recieved doses (heterogeneous)
# Estimated yields (heterogeneous)
output$est_yields_hetero <- renderRHandsontable({
if (input$button_estimate <= 0 | data()[["assessment"]] != "hetero") {
return(NULL)
Expand All @@ -1242,6 +1276,7 @@ mod_estimation_results_server <- function(input, output, session, stringsAsFacto
as.data.frame() %>%
# Fix possible NA values
dplyr::mutate(dplyr::across(where(is.logical), as.double)) %>%
# Rename columns and rows
`colnames<-`(c("lower", "estimate", "upper")) %>%
`row.names<-`(c("yield1", "yield2")) %>%
# Convert to hot and format table
Expand All @@ -1264,6 +1299,7 @@ mod_estimation_results_server <- function(input, output, session, stringsAsFacto
as.data.frame() %>%
# Fix possible NA values
dplyr::mutate(dplyr::across(where(is.logical), as.double)) %>%
# Rename columns and rows
`colnames<-`(c("lower", "estimate", "upper")) %>%
`row.names<-`(c("dose1 (Gy)", "dose2 (Gy)")) %>%
# Convert to hot and format table
Expand All @@ -1276,14 +1312,15 @@ mod_estimation_results_server <- function(input, output, session, stringsAsFacto
hot_cols(format = "0.000")
})

# Estimated fraction of irradiated blood for dose dose1 (heterogeneous)
# Estimated fractions of irradiated blood (heterogeneous)
output$est_frac_hetero <- renderRHandsontable({
if (input$button_estimate <= 0 | data()[["assessment"]] != "hetero") {
return(NULL)
}
data()[["est_frac_hetero"]] %>%
# Fix possible NA values
dplyr::mutate(dplyr::across(where(is.logical), as.double)) %>%
# Rename columns and rows
`colnames<-`(c("estimate", "std.err")) %>%
`row.names<-`(c("dose1", "dose2")) %>%
# Convert to hot and format table
Expand Down

0 comments on commit 70bee83

Please sign in to comment.