##################################################
# UI
##################################################
#' @import shiny
#' @import shinydashboard
#' @import leaflet
#' @import shiny
#' @import ggplot2
#' @import gt
app_ui <- function(request) {
options(scipen = '999')
tagList(
mobile_golem_add_external_resources(),
dashboardPage(
dashboardHeader (title = "SAINT"),
dashboardSidebar(
sidebarMenu(
menuItem(
text="Main",
tabName="main"),
menuItem(
text="Raw data",
tabName="raw_data"),
menuItem(
text = 'About',
tabName = 'about'),
fluidRow(
column(12,
actionButton('update', 'UPDATE DATA'))),
fluidRow(column(12,
uiOutput('ts_ui'))
)
)),
dashboardBody(
passwordInput('password', 'Password'),
actionButton('submit_password', 'Submit'),
# tags$head(
# tags$link(rel = "stylesheet", type = "text/css", href = "custom.css")
# ),
tabItems(
tabItem(
tabName="main",
# navbarPage(title = '',
# collapsible = TRUE,
# tabPanel(title = "Overview",
fluidPage(
fluidRow(
# column(4,
# h3('Most recent submissions'),
# helpText('Blue = already submitted today. Yellow = not yet submitted today. Red = never submitted'),
# gt_output('dt_missing')),
column(12,
h3('Symptoms table'),
helpText('The below table shows the number of consecutive days a patient has had a given symptom, as of the most recent observation. Click on the symptom to order by number of days. NOTE: this table will be empty if there are no ivermectin-associated symptoms reported by any patient ever.'),
h5('Click a PIN to get more details below on that patient'),
DT::dataTableOutput('dt_symptoms'),
h3('Ivermectin symptoms table'),
helpText('The below table shows the number of consecutive days a patient has had a given symptom, as of the most recent observation. Click on the symptom to order by number of days.'),
DT::dataTableOutput('dt_ivermectin'))
),
fluidRow(
uiOutput('participant_ui')
)
)
# ),
# navbarMenu("Data",
# tabPanel("Raw data"),
# tabPanel("Meta-data"))
# )
),
tabItem(
tabName = 'raw_data',
fluidPage(
h1('Raw data'),
helpText('The below table is the data as it appears on the ODK server'),
DT::dataTableOutput('dt_raw')
)
),
tabItem(
tabName = 'about',
fluidPage(
fluidRow(
div(img(src='www/logo_clear.png', align = "center"), style="text-align: center;"),
h4('Built in partnership with ',
a(href = 'http://databrew.cc',
target='_blank', 'Databrew'),
align = 'center'),
p('Empowering research and analysis through collaborative data science.', align = 'center'),
div(a(actionButton(inputId = "email", label = "info@databrew.cc",
icon = icon("envelope", lib = "font-awesome")),
href="mailto:info@databrew.cc",
align = 'center')),
style = 'text-align:center;'
),
fluidRow(column(12,
actionButton('action', 'Quick data reload')))
)
)
)
)
)
)
}
#' Add external Resources to the Application
#'
#' This function is internally used to add external
#' resources inside the Shiny application.
#'
#' @import shiny
#' @importFrom golem add_resource_path activate_js favicon bundle_resources
#' @noRd
mobile_golem_add_external_resources <- function(){
addResourcePath(
'www', system.file('app/www', package = 'saint')
)
# share <- list(
# title = "Databrew's COVID-19 Data Explorer",
# url = "https://datacat.cc/covid19/",
# image = "http://www.databrew.cc/images/blog/covid2.png",
# description = "Comparing epidemic curves across countries",
# twitter_user = "data_brew"
# )
tags$head(
# # Facebook OpenGraph tags
# tags$meta(property = "og:title", content = share$title),
# tags$meta(property = "og:type", content = "website"),
# tags$meta(property = "og:url", content = share$url),
# tags$meta(property = "og:image", content = share$image),
# tags$meta(property = "og:description", content = share$description),
#
# # Twitter summary cards
# tags$meta(name = "twitter:card", content = "summary"),
# tags$meta(name = "twitter:site", content = paste0("@", share$twitter_user)),
# tags$meta(name = "twitter:creator", content = paste0("@", share$twitter_user)),
# tags$meta(name = "twitter:title", content = share$title),
# tags$meta(name = "twitter:description", content = share$description),
# tags$meta(name = "twitter:image", content = share$image),
#
# # golem::activate_js(),
# # golem::favicon(),
# # Add here all the external resources
# # Google analytics script
# includeHTML(system.file('app/www/google-analytics-mini.html', package = 'covid19')),
# includeScript(system.file('app/www/script.js', package = 'covid19')),
# includeScript(system.file('app/www/dtselect.js', package = 'saint')),
# includeScript('inst/app/www/script.js'),
# includeScript('www/google-analytics.js'),
# If you have a custom.css in the inst/app/www
tags$link(rel="stylesheet", type="text/css", href="www/custom.css")
# tags$link(rel="stylesheet", type="text/css", href="www/custom.css")
)
}
##################################################
# SERVER
##################################################
#' @import shiny
#' @import leaflet
#' @import yaml
#' @import lubridate
#' @import gt
app_server <- function(input, output, session) {
# Get into reactive object
data_list <- reactiveValues(data = data.frame(),
ts = as.character(Sys.time()),
participant = NA)
logged_in <- reactiveVal(value = FALSE)
observeEvent(input$submit_password,{
print('Submitting password')
password <- yaml::read_yaml('credentials/credentials.yaml')$app_password
message('Password is ', password)
ipx <- input$password
message('Input password is ', ipx)
ok <- ipx == password
if(ok){
message('Logged in')
logged_in(TRUE)
} else {
message('Not logged in')
}
})
# Observe the action button (or app start) to load data
observeEvent(input$action, {
get_data_aws(s3_csv_path = 'credentials/s3.csv')
message('Got new df')
data_list$data <- df
message('Stuck new df in reactive list')
data_list$ts <- NA # as.character(Sys.time())
message('Got time stamp')
# message('data_list$data looks like:')
# print(head(data_list$data))
# x <- data_list$data
# save(x, file = '/tmp/tmp.RData')
}, ignoreNULL = FALSE)
# Refetch from ODK too
# Observe the action button (or app start) to load data
observeEvent(input$update, {
message('Getting most recent data from ODK...')
message('...Loading up current data')
old_df <- df <- data_list$data
message('......', nrow(df), ' rows')
message('...Fetching ODK data (if any)')
df <- update_data_aws(s3_csv_path = 'credentials/s3.csv',
df = df,
creds_path = 'credentials/credentials.yaml')
message('......', nrow(df), ' rows')
data_list$data <- df
if(nrow(old_df) < nrow(df)){
message('...NEW ROWS. Updating AWS')
write_data_aws(s3_csv_path = 'credentials/s3.csv',
df = df)
} else {
message('...NO NEW ROWS ROWS. LEAVING AWS ALONE')
}
data_list$ts <- as.character(Sys.time())
})
output$dt_raw <- DT::renderDataTable({
li <- logged_in()
if(li){
out <- data_list$data
prettify(out, download_options = TRUE, nrows = nrow(out))
} else {
NULL
}
},
options = list(scrollX = TRUE))
output$ts_ui <- renderUI({
li <- logged_in()
if(li){
ts <- data_list$ts
if(!is.na(ts)){
out <- as.POSIXct(Sys.time())# + hours(2) # this will be wrong locally, correct on server
out <- as.character(with_tz(out, 'UTC'))
out <- paste0(out, ' UTC')
done <- fluidPage(
helpText('Updated at:'),
p(out)
)
} else {
done <- fluidPage(
h6('CLICK ABOVE'),
h6('TO UPDATE')
)
}
} else {
done <- fluidPage(h6('Please'),
h6('enter'),
h6('password'))
}
done
})
output$dt_missing <- render_gt({
li <- logged_in()
pd <- data_list$data
# save(pd, file = '/tmp/tmp.RData')
ok <- FALSE
if(!is.null(pd)){
if(nrow(pd) > 0){
if('end_time' %in% names(pd)){
ok <- T
}
}
}
if(ok & li){
out <- pd %>%
arrange(end_time) %>%
group_by(pin = as.character(pin)) %>%
summarise(x = dplyr::last(end_time)) %>%
filter(!is.na(pin)) %>%
ungroup %>%
mutate(x = as.POSIXct(x, tz = 'Europe/Paris'))
left <- tibble(pin = as.character(1:24))
out <- left_join(left, out)
out <- out %>%
mutate(`Hours ago` = round(interval(x, as.POSIXct(Sys.time(), tz = 'Europe/Paris')) / hours(1), digits = 1)) %>%
mutate(#x = ifelse(is.na(x), '(never)', x),
`Hours ago` = ifelse(is.na(`Hours ago`), ' ', `Hours ago`)) %>%
# mutate(ja = NA) %>%
mutate(x = as.character(x)) %>%
dplyr::rename(`Last form` = x)
# Define formatter functions
hide_na <- function(.x){
out <- as.POSIXct(.x)
out <- as.character(out)
out <- ifelse(is.na(out), '(never)', out)
out
}
gt(out) %>%
# Color rows
tab_style(
style = cell_fill(color = "#F7EFB2"),
locations = cells_body(
# rows = `Hours ago` > 24
rows = as.Date(`Last form`) != Sys.Date()
)
) %>%
tab_style(
style = cell_fill(color = "#66CCFF"),
locations = cells_body(
# rows = `Hours ago` > 24
rows = as.Date(`Last form`) == Sys.Date()
)
) %>%
tab_style(
style = cell_fill(color = "#FF6347"),
locations = cells_body(
# rows = `Hours ago` > 24
rows = is.na(`Last form`)
)
) %>%
# Mark as done those who are done
tab_style(
style = cell_fill(color = "#000000"),
locations = cells_body(
rows = as.numeric(as.character(pin)) %in% c(1, 2, 5, 6, 7, 11, 17, 18, 20, 21, 22, 24)
)
) %>%
# Bolden pin
tab_style(
style = cell_text(size = px(15), weight = "bold", font = "arial"),
locations = cells_body(vars(pin))
) %>%
tab_style(
style = cell_text(
size = px(12),
# color = "#999",
font = "arial",
indent = px(65)
),
locations = cells_body(vars(`Last form`))
) %>%
# Hide NA
fmt("Last form", fns = hide_na) %>%
# Align columns
cols_align(align = 'right',
columns = vars(`Last form`)) %>%
cols_align(align = 'right',
columns = vars(`Hours ago`))
} else {
NULL
}
}#, rownames= FALSE
)
data_symptoms <- reactive({
pd <- data_list$data
# save(pd, file = '/tmp/pd.RData')
pd <- pd %>%
mutate(date = as.Date(fecha)) %>%
arrange(pin,
date) %>%
filter(!is.na(pin)) %>%
# Remove the old ones
filter(!pin %in% c(1, 2, 5, 6, 7, 11, 17, 18, 20, 21, 22, 24)) %>%
# Keep only the most recent one for each date
mutate(dummy = 1) %>%
group_by(pin, date) %>%
mutate(cs = cumsum(dummy)) %>%
filter(dummy == max(dummy)) %>%
ungroup %>%
dplyr::select(-dummy)
# Get the missing dates too
left <- expand.grid(date = seq(min(pd$date, na.rm = TRUE),
max(pd$date, na.rm = TRUE),
by = 1),
pin = sort(unique(pd$pin)))
pd <- left_join(left, pd)
pd <- pd %>% arrange(pin, date)
pd <- pd %>%
group_by(pin) %>%
mutate(max_date = max(date[!is.na(instanceID)])) %>%
ungroup %>%
# Don't keep anything after max date
filter(date <= max_date) %>%
group_by(pin) %>%
summarise(max_date = max(date[!is.na(instanceID)]),
congestion_last = dplyr::last(congestion_si_no),
congestion_days = dplyr::last(sequence(rle(as.character(congestion_si_no))$lengths)),
congestion_days = ifelse(congestion_last == 'No', 0, congestion_days),
diarrea_last = dplyr::last(diarrea_si_no),
diarrea_days = dplyr::last(sequence(rle(as.character(diarrea_si_no))$lengths)),
diarrea_days = ifelse(diarrea_last == 'No', 0, diarrea_days),
fatiga_last = dplyr::last(fatiga_si_no),
fatiga_days = dplyr::last(sequence(rle(as.character(fatiga_si_no))$lengths)),
fatiga_days = ifelse(fatiga_last == 'No', 0, fatiga_days),
malestar_last = dplyr::last(malestar_si_no),
malestar_days = dplyr::last(sequence(rle(as.character(malestar_si_no))$lengths)),
malestar_days = ifelse(malestar_last == 'No', 0, malestar_days),
medicacion_last = dplyr::last(medicacion_si_no),
medicacion_days = dplyr::last(sequence(rle(as.character(medicacion_si_no))$lengths)),
medicacion_days = ifelse(medicacion_last == 'No', 0, medicacion_days),
temp_last = dplyr::last(temp_si_no),
temp_days = dplyr::last(sequence(rle(as.character(temp_si_no))$lengths)),
temp_days = ifelse(temp_last == 'No', 0, temp_days),
tos_last = dplyr::last(tos_si_no),
tos_days = dplyr::last(sequence(rle(as.character(tos_si_no))$lengths)),
tos_days = ifelse(tos_last == 'No', 0, tos_days),
vomitos_last = dplyr::last(vomitos_si_no),
vomitos_days = dplyr::last(sequence(rle(as.character(vomitos_si_no))$lengths)),
vomitos_days = ifelse(vomitos_last == 'No', 0, vomitos_days),
) %>%
ungroup %>%
# Remove column names with "last"
dplyr::select(-contains('_last')) %>%
# Rename column
dplyr::rename(`Last observation` = max_date)
# Remove the "days" from column names
names(pd) <- gsub('_days', '', names(pd))
# save(pd, file = '/tmp/tmp2.RData')
pd
})
data_ivermectin <- reactive({
pd <- data_list$data
pd <- pd %>%
mutate(date = as.Date(fecha)) %>%
arrange(pin,
date) %>%
filter(!is.na(pin)) %>%
# Remove the old ones
filter(!pin %in% c(1, 2, 5, 6, 7, 11, 17, 18, 20, 21, 22, 24)) %>%
# Keep only the most recent one for each date
mutate(dummy = 1) %>%
group_by(pin, date) %>%
mutate(cs = cumsum(dummy)) %>%
filter(dummy == max(dummy)) %>%
ungroup %>%
dplyr::select(-dummy)
# Get the missing dates too
left <- expand.grid(date = seq(min(pd$date, na.rm = TRUE),
max(pd$date, na.rm = TRUE),
by = 1),
pin = sort(unique(pd$pin)))
pd <- left_join(left, pd)
pd <- pd %>% arrange(pin, date)
# Generate new variables
# sintomas <- unique(c(pd$sintomas_1, pd$sintomas_2, pd$sintomas_3))
sintomas <- c('Confusion',
'Mareos',
'Somnolencia',
'Vertigo',
'Temblores',
'vision_borrosa',
'dificultad_para_enfocar_objetos',
'vision_de_tunel',
'colores_formas_anormales',
'puntos_ciegos',
'puntos_flotantes',
'prurito',
'sarpullido')
sintomas <- sintomas[!is.na(sintomas)]
sintomas <- paste0(sort(unique(sintomas)), collapse = ' ')
sintomas <- sort(unique(unlist(strsplit(sintomas, ' '))))
if(length(sintomas) > 0){
for(j in 1:length(sintomas)){
this_sintoma <- sintomas[j]
var_name <- paste0(this_sintoma, '_iver')
pd[,var_name] <- NA
for(i in 1:nrow(pd)){
has_sintoma <-
this_sintoma %in% pd[i,'sintomas_1'] |
this_sintoma %in% pd[i,'sintomas_2'] |
this_sintoma %in% pd[i,'sintomas_3']
pd[i,var_name] <- has_sintoma
}
}
pd <- pd %>%
group_by(pin) %>%
mutate(max_date = max(date[!is.na(instanceID)])) %>%
ungroup %>%
# Don't keep anything after max date
filter(date <= max_date) %>%
group_by(pin) %>%
summarise(max_date = max(date[!is.na(instanceID)]),
colores_formas_anormales_iver_last = dplyr::last(colores_formas_anormales_iver),
colores_formas_anormales_iver_days = dplyr::last(sequence(rle(as.character(colores_formas_anormales_iver))$lengths)),
colores_formas_anormales_iver_days = ifelse(!colores_formas_anormales_iver_last, 0, colores_formas_anormales_iver_days),
Confusion_iver_last = dplyr::last(Confusion_iver),
Confusion_iver_days = dplyr::last(sequence(rle(as.character(Confusion_iver))$lengths)),
Confusion_iver_days = ifelse(!Confusion_iver_last, 0, Confusion_iver_days),
dificultad_para_enfocar_objetos_iver_last = dplyr::last(dificultad_para_enfocar_objetos_iver),
dificultad_para_enfocar_objetos_iver_days = dplyr::last(sequence(rle(as.character(dificultad_para_enfocar_objetos_iver))$lengths)),
dificultad_para_enfocar_objetos_iver_days = ifelse(!dificultad_para_enfocar_objetos_iver_last, 0, dificultad_para_enfocar_objetos_iver_days),
Mareos_iver_last = dplyr::last(Mareos_iver),
Mareos_iver_days = dplyr::last(sequence(rle(as.character(Mareos_iver))$lengths)),
Mareos_iver_days = ifelse(!Mareos_iver_last, 0, Mareos_iver_days),
prurito_iver_last = dplyr::last(prurito_iver),
prurito_iver_days = dplyr::last(sequence(rle(as.character(prurito_iver))$lengths)),
prurito_iver_days = ifelse(!prurito_iver_last, 0, prurito_iver_days),
puntos_ciegos_iver_last = dplyr::last(puntos_ciegos_iver),
puntos_ciegos_iver_days = dplyr::last(sequence(rle(as.character(puntos_ciegos_iver))$lengths)),
puntos_ciegos_iver_days = ifelse(!puntos_ciegos_iver_last, 0, puntos_ciegos_iver_days),
puntos_flotantes_iver_last = dplyr::last(puntos_flotantes_iver),
puntos_flotantes_iver_days = dplyr::last(sequence(rle(as.character(puntos_flotantes_iver))$lengths)),
puntos_flotantes_iver_days = ifelse(!puntos_flotantes_iver_last, 0, puntos_flotantes_iver_days),
sarpullido_iver_last = dplyr::last(sarpullido_iver),
sarpullido_iver_days = dplyr::last(sequence(rle(as.character(sarpullido_iver))$lengths)),
sarpullido_iver_days = ifelse(!sarpullido_iver_last, 0, sarpullido_iver_days),
Somnolencia_iver_last = dplyr::last(Somnolencia_iver),
Somnolencia_iver_days = dplyr::last(sequence(rle(as.character(Somnolencia_iver))$lengths)),
Somnolencia_iver_days = ifelse(!Somnolencia_iver_last, 0, Somnolencia_iver_days),
Temblores_iver_last = dplyr::last(Temblores_iver),
Temblores_iver_days = dplyr::last(sequence(rle(as.character(Temblores_iver))$lengths)),
Temblores_iver_days = ifelse(!Temblores_iver_last, 0, Temblores_iver_days),
Vertigo_iver_last = dplyr::last(Vertigo_iver),
Vertigo_iver_days = dplyr::last(sequence(rle(as.character(Vertigo_iver))$lengths)),
Vertigo_iver_days = ifelse(!Vertigo_iver_last, 0, Vertigo_iver_days),
vision_borrosa_iver_last = dplyr::last(vision_borrosa_iver),
vision_borrosa_iver_days = dplyr::last(sequence(rle(as.character(vision_borrosa_iver))$lengths)),
vision_borrosa_iver_days = ifelse(!vision_borrosa_iver_last, 0, vision_borrosa_iver_days),
vision_de_tunel_iver_last = dplyr::last(vision_de_tunel_iver),
vision_de_tunel_iver_days = dplyr::last(sequence(rle(as.character(vision_de_tunel_iver))$lengths)),
vision_de_tunel_iver_days = ifelse(!vision_de_tunel_iver_last, 0, vision_de_tunel_iver_days)
) %>%
ungroup %>%
# Remove column names with "last"
dplyr::select(-contains('_last')) %>%
# Rename column
dplyr::rename(`Last observation` = max_date)
# Remove the "days" from column names
names(pd) <- gsub('_iver', '', names(pd))
names(pd) <- gsub('_days', '', names(pd))
# save(pd, file = '/tmp/tmp2.RData')
names(pd) <- gsub('_', ' ', names(pd))
names(pd) <- tolower(names(pd))
pd
} else {
NULL
}
})
output$dt_symptoms <- DT::renderDataTable({
li <- logged_in()
message('DT SYMPTOMS LOGGED IN IS: ', li)
if(li){
pd <- data_symptoms()
pd
} else {
NULL
}
},
selection = 'single',
rownames= FALSE,
options = list(scrollX = TRUE))
observeEvent(input$dt_symptoms_rows_selected,{
row = input$dt_symptoms_rows_selected
# print(row)
pd <- data_symptoms()
the_participant <- pd$pin[row]
data_list$participant <- the_participant
})
output$dt_ivermectin <- DT::renderDataTable({
li <- logged_in()
if(li){
pd <- data_ivermectin()
return(pd)
} else {
return(NULL)
}
},
selection = 'single',
rownames= FALSE,
options = list(scrollX = TRUE))
observeEvent(input$dt_ivermectin_rows_selected,{
row = input$dt_ivermectin_rows_selected
if(!is.null(row)){
# print(row)
pd <- data_ivermectin()
the_participant <- pd$pin[row]
data_list$participant <- the_participant
}
})
output$participant_ui <- renderUI({
pin <- data_list$participant
if(is.na(pin)){
fluidPage(h4('Click a row in the table above to view more details.'))
} else {
the_pin <- pin
full_data <- data_list$data
# save(full_data, file = '~/Desktop/temp.RData')
# load('~/Desktop/temp.RData')
temp_data <-
full_data <-
full_data %>%
filter(pin == the_pin)
# Medication data
if(nrow(full_data) > 0){
med_data <- full_data %>%
arrange(fecha) %>%
mutate(medicacion_cual = ifelse(is.na(medicacion_cual), 'None', medicacion_cual)) %>%
summarise(`All medications taken` = paste0(sort(unique(medicacion_cual)), collapse = ', '),
`Medications taken, most recent form` = dplyr::last(medicacion_cual))
} else {
med_data <- data.frame()
}
# Temperature data
temp_data <- temp_data %>%
dplyr::select(date = fecha, temp) %>%
mutate(date = as.Date(date))
full_data <- full_data %>%
# dplyr::select(date = start_time, contains('si_no')) %>%
dplyr::select(date = fecha,
malestar_si_no,
temp_si_no,
fiebre,
tos_si_no,
olores,
mal_sabor,
dolor_cabeza,
dolor_garganta,
congestion_si_no,
fatiga_si_no,
vomitos_si_no,
diarrea_si_no,
medicacion_si_no,
sintomas_1,
sintomas_2,
sintomas_3) %>%
mutate(date = as.Date(date))
names(full_data) <- gsub('_si_no', '', names(full_data))
# Get ivermectin symptoms in table too
sintomas <- c('Confusion',
'Mareos',
'Somnolencia',
'Vertigo',
'Temblores',
'vision_borrosa',
'dificultad_para_enfocar_objetos',
'vision_de_tunel',
'colores_formas_anormales',
'puntos_ciegos',
'puntos_flotantes',
'prurito',
'sarpullido')
for(j in 1:length(sintomas)){
this_sintoma <- sintomas[j]
full_data[,this_sintoma] <- 'No'
}
for(i in 1:nrow(full_data)){
for(j in 1:length(sintomas)){
this_sintoma <- sintomas[j]
this_sub_row <- full_data[i,grepl('sintomas_', names(full_data))]
this_sub_value <- paste0(this_sub_row, collapse = ' ')
out <- grepl(this_sintoma, this_sub_value)
if(out){
full_data[i,this_sintoma] <- 'Si'
}
}
}
full_data <- full_data %>%
dplyr::select(!contains('sintomas_'))
names(full_data) <- gsub('_', ' ', names(full_data))
full_data <- full_data %>%
tidyr::gather(key, value, malestar:sarpullido)
left <- expand.grid(date = seq(min(full_data$date), max(full_data$date), 1),
key = sort(unique(full_data$key)))
joined <- left_join(left, full_data)
joined$key <- Hmisc::capitalize(joined$key)
ivermectin_symptoms <- Hmisc::capitalize(gsub('_', ' ', sintomas))
non_ivermectin_symptoms <- sort(unique(joined$key))[!sort(unique(joined$key)) %in% ivermectin_symptoms]
joined$value <- ifelse(is.na(joined$value),
'No contesta', joined$value)
joined$value <- ifelse(joined$key %in% ivermectin_symptoms &
joined$value == 'Si',
'Si (síntoma ivermectina)',
joined$value)
levs <- (c((sort(ivermectin_symptoms)),
(sort(non_ivermectin_symptoms))))
joined$key <- factor(joined$key,
levels = levs)
# print(sort(unique(joined$value)))
joined$value <- factor(joined$value,
levels = c('No',
'No contesta',
'Si',
'Si (síntoma ivermectina)'))
joined$iver <- ifelse(joined$key %in% ivermectin_symptoms,
'Ivermectin', 'Covid-19')
output$plot_grid <- renderPlot({
ggplot(data = joined,
aes(x = date,
y = key,
fill = value)) +
geom_tile(color = 'black', size = 0.1) +
scale_fill_manual(name = '',
values = c('lightblue', 'white',
'darkorange', 'red'),
drop=TRUE,
limits = levels(joined$value)) +
theme_saint() +
# facet_wrap(~iver, scales = 'free',
# ncol = 1) +
labs(x = 'Date',
y = 'Symptom',
title = paste0('Symptoms over time'),
subtitle = paste0('participant ', data_list$participant)) +
scale_y_discrete(limits = rev(sort(unique(joined$key)))) +
theme(legend.position = 'bottom')
})
output$plot_temperature <-
renderPlot({
ok <- FALSE
if(!is.null(temp_data)){
temp_range <- range(temp_data$temp, na.rm = TRUE)
print(temp_range)
if(!all(is.na(temp_range))){
if(!all(is.infinite(temp_range))){
ok <- TRUE
}
}
}
if(!ok){
ggplot() +
theme_saint() +
labs(title = paste0('No temperature data for participant ', data_list$participant))
} else {
lower <- floor(temp_range)
upper <- ceiling(temp_range)
temp_seq <- lower:upper
ggplot(data = temp_data,
aes(x = date,
y = temp)) +
geom_hline(yintercept = temp_seq, alpha = 0.3) +
geom_point(color = 'red', size = 3) +
geom_line() +
theme_saint() +
labs(x = 'Date',
y = 'Celcius',
title = paste0('Temperature over time for participant ', data_list$participant))
}
})
output$plot_time <- renderPlot({
the_pin <- pin
# save(full_data, file = '~/Desktop/temp.RData')
# load('~/Desktop/temp.RData')
if(is.null(the_pin)){
NULL
} else {
full_data <- data_list$data
pd <- full_data %>% filter(pin == the_pin)
# Deal with date
date_var <- input$date_var
if(date_var == 'Fecha de referencia'){
pd$date <- pd$fecha
} else {
pd$date <- pd$end_time
}
right <- pd %>%
group_by(date = as.Date(date)) %>%
tally
left <- data.frame(date = seq(min(right$date), Sys.Date(), by = 1))
pd <- left_join(left, right) %>% mutate(n = ifelse(is.na(n), 0, n))
ggplot(data = pd,
aes(x = date,
y = n)) +
geom_bar(stat = 'identity', fill = 'black') +
geom_text(aes(label = n),
nudge_y = 0.1) +
labs(x = 'Fecha',
y = 'Formularios',
title = paste0('Formularios por dia'),
subtitle = paste0('Participant ', the_pin)) +
scale_x_date(breaks = sort(unique(pd$date))) +
theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5))
}
})
output$medication_table <-
render_gt({
med_data
})
# pd <- data_symptoms()
# pd <- pd %>% filter(pin == the_pin)
fluidPage(
fluidRow(
column(6,
plotOutput('plot_grid')),
column(6,
plotOutput('plot_temperature'))
),
fluidRow(column(12, align = 'center',
selectInput('date_var', '¿Qué tipo de fecha?',
choices = c('Fecha de referencia', 'Fecha de cuando se acabó el formulario'),
selected = 'Fecha de referencia'),
plotOutput('plot_time'))),
fluidRow(
column(12, align = 'center',
h3('Medication'),
gt_output('medication_table'))
)
)
}
})
output$plot_forms <- renderPlot({
pd <- data_list$data
pd <- pd %>%
group_by(date = as.Date(fecha),
pin) %>%
tally %>%
ungroup %>%
filter(!is.na(pin),
!is.na(date))
cols <- colorRampPalette(RColorBrewer::brewer.pal(n = 9, name = 'Spectral'))(length(unique(pd$pin)))
ggplot(data = pd,
aes(x = date,
y = n,
fill = factor(pin))) +
geom_bar(stat = 'identity',
color = 'black',
size = 0.2) +
scale_fill_manual(name = 'ID',
values = cols) +
labs(x = 'Date',
y = 'Forms filled out',
title = 'Forms filled out by date') #+
# guides(fill = guide_legend(reverse = TRUE))
})
}
app <- function(){
# Detect the system. If on AWS, don't launch browswer
is_aws <- grepl('aws', tolower(Sys.info()['release']))
shinyApp(ui = app_ui,
server = app_server,
options = list('launch.browswer' = !is_aws))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.