## ---- include = FALSE---------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

## ----setup, echo=T,warning=F,message=F----------------------------------------
library(afdx)

## ----echo = F, result = 'markup'----------------------------------------------
library(dplyr)
library(tidyr)
library(magrittr)
library(knitr)
library(kableExtra)

kable(
  head(malaria_df1, n = 6),
       caption = "head(malaria_df1) first 6 observations", 
       format = "html") %>%
kable_styling( position = "left")

## ----echo = F-----------------------------------------------------------------
cutoffs <- c(0,1,100,200,400,800,1600,3200,6400,12800,25600,51200, 102400, 204800)
data <- 
  malaria_df1 %>%
  mutate(k = cut(density,c(cutoffs,Inf), include.lowest =T, labels = cutoffs)) %>%
  group_by(k,fever) %>%
  tally() %>%
  mutate(category = ifelse(fever ==1,"n (fever)","m (no fever)")) %>%
  select(-fever) %>%
  pivot_wider(names_from = "category", values_from = "n", values_fill = list(n = 0)) %>%
  rename(`k (category lower limit)` = k)

kable(data, "html", caption="Distribution of fevers by density categories") %>%
kable_styling(position = "left")  

## -----------------------------------------------------------------------------
model <- get_latent_model()
cat(model)

## ---- eval=FALSE--------------------------------------------------------------
#  library(rjags)
#  library(coda)
#  
#  # compile the model
#  af_latent <-
#    jags.model(
#      textConnection(get_latent_model()),
#      data = list(n = data$`n (fever)`,
#                  m = data$`m (no fever)`),
#      n.chains = 4,
#      n.adapt = 1000,
#      inits = list(
#        list(.RNG.name = "base::Wichmann-Hill", .RNG.seed = 1111),
#        list(.RNG.name = "base::Wichmann-Hill", .RNG.seed = 2222),
#        list(.RNG.name = "base::Wichmann-Hill", .RNG.seed = 3333),
#        list(.RNG.name = "base::Wichmann-Hill", .RNG.seed = 4444)
#      )
#    )
#  
#  # Simulate the posterior
#  latent_sim <-
#    coda.samples(
#      model = af_latent,
#      variable.names = c('lambda','sens','spec','ppv','npv'),
#      n.thinning = 5,
#      n.iter =  10000 )
#  
#  # Extract and Analyze the posterior
#  latent_sum <-  summary(latent_sim)
#  latent_eff <-  effectiveSize(latent_sim)

## ---- echo=FALSE, include=FALSE-----------------------------------------------
# Load results from the model
library(coda)
latent_sum <- readRDS(system.file("vignette_data/latent_sum.RDS", package = "afdx"))
latent_eff <- readRDS(system.file("vignette_data/latent_eff.RDS", package = "afdx"))

## -----------------------------------------------------------------------------
# reformat to present the results
summary_table <-
  data.frame(latent_sum[[1]]) %>%
  bind_cols(data.frame(latent_sum[[2]])) %>%
  mutate(varname = row.names(latent_sum[[1]])) %>%
  mutate(cutoff  = c(NA, rep(cutoffs,4))) %>%
  select(varname, cutoff,Mean, X2.5., X50., X97.5.,Naive.SE ) %>%
  mutate(eff_size = floor(latent_eff)) %>%
  filter(is.na(cutoff) | cutoff != 0) 


mean_table <- summary_table %>%
  rename(point = Mean) %>%
  rename(lci = `X2.5.`) %>%
  rename(uci = `X97.5.`) %>%
  mutate(varname = gsub("\\[.*\\]","",varname)) %>%
  filter(varname != "lambda") %>%
  select(cutoff,varname, lci, uci,point) %>%
  pivot_longer(-c("cutoff","varname"),names_to = "xxv", values_to = "value") %>%
  unite("varx",varname,xxv ) %>%
  pivot_wider(names_from = "varx", values_from = "value") %>%
  select(cutoff,
         sens_point, 
         sens_lci, 
         sens_uci, 
         spec_point,
         spec_lci, 
         spec_uci,
         ppv_point, 
         ppv_lci, 
         ppv_uci,
         npv_point,
         npv_lci,
         npv_uci) %>%
  rename(sensitivity = sens_point) %>%
  rename(specificity = spec_point) %>%
  rename(ppv = ppv_point) %>%
  rename(npv = npv_point) %>%
  mutate_if(is.numeric, round,3)

# Lambda corresponds to the attributable fraction
afrow <- 
  summary_table %>%
  filter(varname == "lambda") %>% 
  mutate_if(is.numeric, round,3)

## ---- echo = F, result = 'markup', out.width= "90%"---------------------------
kable(mean_table, caption = "Summary of diagnostic characteristics at selected cutoff points") %>% kable_styling()