load_title_data <- function(data){
x <- list(
data = list(
raw = NULL
),
progress = list(
order = NULL,
screening_page = NULL,
page = NULL,
n_current = NULL,
n_previous = NULL,
current = NULL
),
selector = list(
yes = c(0),
no = c(0),
maybe = c(0)
)
)
if(!is.null(data)){
# throw a warning if a known file type isn't given
accepted_inputs <- c("bibliography", "data.frame")
if(!any(accepted_inputs == class(data))){
stop("only classes 'bibliography' or 'data.frame' accepted by screen_titles")}
if(class(data) == "bibliography"){
data <- as.data.frame(data)
}
colnames(data) <- tolower(colnames(data))
# create citation
if(!any(colnames(data) == "citation")){
data$citation <- format_citation(
data = data,
details = FALSE,
add_html = TRUE
)
}
# add extra columns as needed
if(!any(colnames(data) == "screened_titles")){data$screened_titles <- NA}
if(!any(colnames(data) == "notes")){data$notes <- NA}
x$data$raw <- data
# store progress
x$progress$order <- seq_len(nrow(data))
x$progress$screening_page <- calc_pages(
n = nrow(data),
each = 8
)
x$progress$page <- 1
x$progress$n_previous <- 8
x$progress$n_current <- min(c(
8,
length(which(is.na(data$screened_titles)))
))
x$progress$current <- seq_len(x$progress$n_current)
# save selector info
rep_zeroes <- rep(0, x$progress$n_current)
x$selector$yes <- rep_zeroes
x$selector$no <- rep_zeroes
x$selector$maybe <- rep_zeroes
}
return(x)
}
# function to add 'page numbers' to screen_titles
calc_pages <- function(n, each){
rep(
seq_len(ceiling(n / each)),
each = each
)[seq_len(n)]
}
# function to add a single title + selector buttons to the ui
add_reference_ui <- function(
entry_number, # an index to record which entry these data are linked to
ui_selector # i.e. where in the UI should this go? Starts with a #
){
insertUI(
selector = paste0( # formerly '#placeholder',
"#", ui_selector
),
ui = div(
list(
br(),
div(
style = "
display: inline-block;
vertical-align: top;
width: 10px",
HTML("<br>")
),
div(
style = "
display: inline-block;
vertical-align: top;
width: 80px",
actionButton(
inputId = paste0(
"citation_",
entry_number,
"_yes"
),
label = "Select",
style = "
width: 80px;
background-color: #7c93c1;
color: #fff;"
)
),
div(
style = "
display: inline-block;
vertical-align: top;
width: 80px",
actionButton(
inputId = paste0(
"citation_",
entry_number,
"_no"
),
label = "Exclude",
style = "
display: inline-block;
vertical-align: top;
width: 80px;
background-color: #c17c7c;
color: #fff;"
)
),
div(
style = "
display: inline-block;
vertical-align: top;
width: 80px",
actionButton(
inputId = paste0(
"citation_",
entry_number,
"_maybe"
),
label = "Unknown",
style = "
display: inline-block;
vertical-align: top;
width: 83px;
background-color: #adadad;
color: #fff;"
)
),
div(
style = "
display: inline-block;
vertical-align: top;
width: 10px",
HTML("<br>")
),
div(
style = "
display: inline-block;
vertical-align: top;
width: 700px",
tableOutput(
outputId = paste0(
"citation_",
entry_number,
"_render"
)
)
)
),
id = paste0(
'citation_',
entry_number
)
)
)
}
# create a data.frame of the names & values of actionButtons
# that match a particular regex
input_tracker <- function(input, string){
object_check <- grepl(
string,
names(input),
perl = TRUE
)
object_names <- names(input)[which(object_check)]
result <- data.frame(
name = object_names,
id = as.integer(unlist(lapply(
strsplit(object_names, "_"),
function(a){a[2]}
))),
value = unlist(lapply(
object_names,
function(a){input[[a]]}
)),
stringsAsFactors = FALSE
)
result <- result[order(result$id), ]
return(result)
}
# function to add navigation buttons
navigation_buttons <- function(){
# div(
list(
div(
style = "
display: inline-block;
vertical-align: top;
width: 10px",
HTML("<br>")
),
div(
style = "
display: inline-block;
vertical-align: top;
width: 180px",
actionButton(
inputId = "page_first",
label = "<<",
width = "40px",
style = "background-color: #6b6b6b;"
),
actionButton(
inputId = "page_back",
label = "<",
width = "40px",
style = "background-color: #6b6b6b;"
),
actionButton(
inputId = "page_next",
label = ">",
width = "40px",
style = "background-color: #6b6b6b;"
),
actionButton(
inputId = "page_last",
label = ">>",
width = "40px",
style = "background-color: #6b6b6b;"
)
)
)
# )
}
# function to add 'select all' buttons to screen_titles
select_all_buttons <- function(){
div(
list(
br(),
div(
style = "
display: inline-block;
vertical-align: top;
width: 10px",
HTML("<br>")
),
div(
style = "
display: inline-block;
vertical-align: top;
width: 80px",
actionButton(
inputId = "all_yes",
label = HTML("Select<br>All"),
style = "
width: 80px;
height: 60px;
background-color: #405d99;
color: #fff;"
)
),
div(
style = "
display: inline-block;
vertical-align: top;
width: 80px",
actionButton(
inputId = "all_no",
label = HTML("Exclude<br>All"),
style = "
width: 80px;
height: 60px;
background-color: #993f3f;
color: #fff;"
)
),
div(
style = "
display: inline-block;
vertical-align: top;
width: 80px",
actionButton(
inputId = "all_maybe",
label = HTML("All<br>Unknown"),
style = "
width: 83px;
height: 60px;
background-color: #6d6d6d;
color: #fff;"
)
)
)
)
}
completeness_check <- function(
x # data$raw
){
if(all(!is.na(x$screened_titles))){
save_modal(
x = x,
title = "Screening Complete: Save results?"
)
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.