#' Link to DiVA portal at KTH
#'
#' @import htmltools
#' @export
abm_ui_button_diva <- function() {
# library(magick)
#
# "https://kth.diva-portal.org/dream/diva2image/kth/favicon.ico" %>%
# image_read() %>%
# image_convert(format = "png") %>%
# image_resize("x20")
# image_transparent(color = "white", fuzz = 15) %>%
# image_write("~/Pictures/diva-logo.png")
#
# base64data <- sprintf("data:image/png;base64,%s", base64enc::base64encode("~/Pictures/diva-logo.png"))
# cat(base64data)
base64data <- "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAMAAAAoLQ9TAAAABGdBTUEAALGPC/xhBQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAANlBMVEUAAAAZVKYZVKYZVKYZVKYZVKYZVKYZVKYZVKYZVKYZVKYZVKYZVKYZVKYZVKYZVKYZVKb///8zlazLAAAAEHRSTlMAj0DvMCDPcN9Qn2Cvv4AQUwCY1wAAAAFiS0dEEeK1PboAAAAHdElNRQfkBQsTBA1aXV/VAAAAYElEQVQY041PWw7AIAhDUVCZs/c/7VziNDNZsn40lEcBoi+4TXveGxBmHEUDJTjKZcwFBps/gPL0ZPjOVZZDven0UxuUqCVpU3Mtp1SMTHR9o8B6RZeLIr4PC2n/xegvLjd9AkBkaFDYAAAAJXRFWHRkYXRlOmNyZWF0ZQAyMDIwLTA1LTExVDE5OjA0OjEzKzAyOjAwX+Io9gAAACV0RVh0ZGF0ZTptb2RpZnkAMjAyMC0wNS0xMVQxOTowNDoxMyswMjowMC6/kEoAAAAASUVORK5CYII="
withTags(
div(class = "diva-button",
span(title = "Please register publications in DiVA as soon as possible for these to be included in the Annual Bibliometric Monitoring",
a(href = "https://kth.diva-portal.org/dream", class = "btn btn-sm btn-primary", target = "_blank",
img(src = base64data),
"Edit your publication data in DiVA"),
br()
)
)
)
}
#' Link to Altmetric Explorer for an organizational unit at KTH
#'
#' @param altmetric_count the count to include in a tooltip
#' @param altmetric_href the target of the link
#' @param unit_label the label for the organizational unit
#' @import htmltools
#' @export
abm_ui_button_altmetric <- function(altmetric_count, altmetric_href, unit_label) {
# img src value comes from embed_data("~/Pictures/altmetric-badge.png")
# altmetric_badge.png comes from https://badges.altmetric.com/?size=20&score=123456&types=dgmabvtf
HTML(sprintf('<div class="altmetric-button"><a href="%s" class="btn btn-sm btn-primary" target="_blank">
<img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAABQAAAAUEAYAAADdGcFOAAAABmJLR0QAAAAAAAD5Q7t/AAAACXBIWXMAAABIAAAASABGyWs+AAAKoUlEQVRIx4XWaVSV1RoH8P/e7/uekQPnMAiCiBOKiRAOJF2Q1CwLUZcjpKYllqKlZqaRSVamlqYWCWaWA4biQCqmCMqgqJgDgwIqkybjYT4C57zj/QB27+qu1n2+/Pbaa3/47+fD3g/BP9T6LVX726uAL9Z6LTB4gfl0zePXLKudfn9QdymkziFgc7588u7joJA51sD2Q+LB8OkkjYqk3WcJs4vcZHLVL6rnkB3sa81qzkxqGdMNZ7IfF8mV/a5CFRkqHk1tZe3wKoOuGYUR6XtCBuMfi/x9Y8mD3JHVfQE0wQ/12iR2NbuExs7eXXe0uG/bB1G7SjMuNNTe8zvQFl3T0BVncGAeyN6MH5nt1ir2Nk5Twjz+VAymOmWdg0jrNPUkQ7VCFUBzyCrc58IVR8tQ/SoulvU4ecE0XV2vSY7fzNqrZ8D15leyk5SAi9LkmAHHxpn+/E8e+mzx9u3Ms1V7AX6ELUVosn9T3qCkyoatTxvulQW0vbfHml+WIj4qCw4wB1YFWkba71R582+zPuga3tp+1CtUXhaQ1WHffyrp7VkmlDudo1GOp3DVMJccN+YRm24t/uXyE+XsNhgc7Q+xo7SLFkSQ1cwfZP1Zmdyk7sQndoVao2OQbf/WtktvhrVY/quD86alXXxYBIgV4hiple5VC+onnN1norSQv6Bsiplx50aS8OgsE16fWMq190KWJpM+VtkpNwN2WT4eZFOK+qTJGscv6SLmivoMPoVK8z3rbzEA+rFkwp/JgO4s4hoLAJUXGydtBWhvzX1DDSB72qW7jwHkTfaq3iulMnJU81RzaHc816jSKa+tPa4slbOR1/WYFeaLA5U4gH5NDsorA01iqWQnZSyNNC8qt7N8wywxx5cltm3FGfjgvMJC7NPSudSpnQS7lvDVRhM/EQdVojK/NEv1RDG3KOXTnHd0qNIGIdfOqlgflw68q/JgQE8OSecy2T3cUg3HJfAazglg1lgjtc+hTQqyzfdazBQ8vea2fxRZPEWYoQlzbbxVjT3iq8L5A4/ZqUcCXlr0m6YxbXbRpM9LlsR1BgoW1zed+abvqu5bGgD+nDVCdIWL5iZ1VX0H9LK3vWzMK0rhvLEQ578qpX9io3V3epJXQUdsjk/rykHOLV1x3mh8ss/52qTxxi/Z68zX+pSJ4EzkIzHok0o2gYDm+fZnZaaCnoCDfrWtrHoLJhgyzP62Oxpj6xV2RqAhKtmidfHwGZn6BVuT3qLzvzLlI0WRqTVy+hHbFj5dqkBs17K2u/xRQNkpxyk1gJKAhXJM4ZeiiKAur/kf/95Ht6tMKmTDwjrqvaOBFdfLmxZnAgDWAMAJ174N49ObYvRX8n/6rvNIDD/BJdvfp+QR1QvLOt0SI7HV8diwmb5JpMgjL+gwjJxGWtg5G1C903q/uH74NnUBVwzvgEJW2a6Uki8W+Fpf4d2pi+Gi0CycF3UAeHaWEgXIN+SLcj+bp20mNQoHN2VfPq979OBgIavZTnyVicDu8PJFQzL/93mYUZ//TcIJILsKDACwNvPigpcLvBAGCnwVAf9W57KkXwoRYdFU+Kr96JJh5XOjAc230jZ9vj2r72z6+W5lyEuUPUNcxKbAi/JuCUKpohcui3vFYEAd7FTPugBwpQQri1dL/cR18h8XbwkzzfPSFgDm8DsJEUMdeqL5jek28JNuvT27HZMROhES4Lji5Js0lvQCVPvYO1SVvkqVjv7KntKfVIp5Y+FwgJ34gD/pAHBxSi6/hnDaQjJaLJ1soVwonckfdzRoS9mNzVnEn/+RTxINgLbRbTjXFzCUeLmrd5cXW1KL1lfGtAy1ddZXpIx61ifj9W59i7ply7rtP6vHpz2OT9yESuUwYBTHf9gro+Wc+g27SA4VqdwtvA4AXHnd57dGQWY2mX2KFgDsOPaIOsxnM2W2kF+UddZg9xTjD49MkOVGMcvaHwrmqhOhBTwyQ++Z1mC5a0LYoMHHMER13TTSIflZwKdtPaZ163W02/rybtv3dasqIFEspbmAQ92cVUO2o1WX7G90zVJuqt/V1rDbAFWcnC9+BsrW1M67fQoMqyNNioMmg8qn5VC6rjTavdQYWEMBD71R+2gaCJ8tPJIIQMp0/TDGe6xn2auhpmjHc16Vc3TvGZ4F7OgJ8vD9bluO9Tyvjd1aVnf7IOidyqEW4yzA2pQR9aTEtIG96vq61n9gvKrK6ajWGVDldJ/kHj5NqX1FucVekWNtGc05rF4r95c3pVLrE2qSzgSIo6r79S64Rxj+lJBCHgJVyY1p7lk+BQIRAmividdMwcMNvvZJcGpZ0XmDsx5rMu3SBQolPT9SyZye5HKP40viow8PWgqZMdXOl2yAMh1+8o6JLeQqO43s91nErjPeVoUAuPWk+2qj5LOSldRQN/mk0PcGpSFR4sS6jy63OL8nf2h72+Ku16srrHuAsdlDFt+mQND4AQWFO9ReXkXOLrVuMa0eQdpe1fT50c7RfSM6HgAfbzvzMFbzV6BnojJhX45xEWRNXMdoiwKonUa0Ni97figzjCuSYmO0dAE9J3uq3ZgXVFHkNqDK6+lgAJevPdDuTu/TVhq+v5AOyJOs5rt3kkdmCrX12wrXGt+VQ/lPAPVzzAnpNFr9xnosrvwReGXL0M9v63yXhEQM9igekWh7Py2k5szCyHfddC6nrFOcUsPulcVnLGO4X+//3jG7ghmsSWPD4eL0oy5yrLFlVOQEdgCbyV86dJWUoFqK9+1NVtCf5XsAO9YWI1YAqpKegMXiQ6v9SUdUD6ucmnymmvBTr6e/sB3g2mkXBi0IrLuqjNAdTth46yVmhPsOTVPNPpJq8sRkMR+UZeCARowmMQAc5dN0m82TmSeXyOWl81z7dCbXlpXLAe71tlwFUXp0JTQvHnhQjhffEDx8vuF/KEvUfqa28pNqQu06AEUt9CdmNGpLsnIbGTizcXVu1jfMSfJnZCeNm7KCrFFWysuvm4m0Lm/1CwYAy8ly8r3WCTlisdCy1cvaIPkhLPqHunEYqC9nxjQUYpXhLtA1RenDWQFugDiBHwg4bLYObD4AOP/RaawJBzR51tC2/oB8SuwSTgJiW/1Fchvgjz18qssEpPXir6wKtdy4x/f4bzFDT3KmN2uk3bghTlA+3OTEDwCAjXuZcwAgf/HXPCh45NqN+AHACKIhYfYvKmvEYHH96iGYK7YIwdEbZL1wSdzs3E9KlKaIakA5L0znUwDlgrhUOA5IH4gGUQVF3mGLFY9DEb9suCtlgQpsZTSXDchTbHPZ+wCd1czLwwG7+TmD21OsHexrjWeF+B9LpM8B4NN5ZB0AtN83dP7DwGp7OWvO8L0AuUa302nMdtlP2CgcHhkhHWzt7AiN3qJMt80RMH2nvEOplesNVB4tXBLHKS3yb5YN4mziKdWZ6yRXPJQqm/5FnkdveS3/HfVVlrGTzL8oGyzFup03N3d1FVLV90+m8Xl7/WV7ADjWgGAA6DqsWf5/Juq/V1tbTBRjA3CZp0qJNhFJmhZ2x+R8pUqeSare+laOEkIRFaiWA4QgYnPklHHiy5RaJ8lhSi7zTuk1Umkx4OzpRAMuz7Iql42aK5UfCpPyY29dnt9qHN3028iQQ8bWPwDyD0n+DYPN6cDJnowoAAAAJXRFWHRkYXRlOmNyZWF0ZQAyMDIwLTA1LTExVDExOjI0OjI1KzAwOjAwGtu4CAAAACV0RVh0ZGF0ZTptb2RpZnkAMjAyMC0wNS0xMVQxMToyNDoyNSswMDowMGuGALQAAABYdEVYdHN2ZzpiYXNlLXVyaQBmaWxlOi8vL3Nydi9hbHRtZXRyaWMtYXBpL3JlbGVhc2VzLzQ0NTViMGE5YzMzMTY3MzljNWY4MWM2ZWIwZTdhNzNhOGJlOWE3M2RGnxTtAAAAAElFTkSuQmCC">
</img> Explore Altmetric Research Output for %s</a></div>',
altmetric_href, unit_label))
}
#' Link to Publication List download for KTH
#'
#' @param data dataset to make publication list from
#' @param is_loggedin boolean parameter indicating logged in status
#' @param unit_label the label for the organizational unit
#' @param unit_code the unit code for the organizational unit
#' @param unit_file_label the label for the download
#' @param is_authorbased indicates if the button is used for author based
#' data, default: FALSE
#' @import htmltools flexdashboard dplyr
#' @importFrom mime guess_type
#' @importFrom writexl write_xlsx
#' @importFrom rmarkdown html_dependency_font_awesome
#' @export
abm_ui_button_publist <- function(data, is_loggedin, unit_label, unit_code, unit_file_label,
is_authorbased = FALSE) {
if (missing(data)) {
data <- data.frame()
}
current_date <- format(Sys.Date(), "%Y%m%d")
if (is_loggedin == TRUE) {
# Do not include fields added to masterfile for other reasons than ABM
data <- data %>% select(-any_of(c("Ptop5", "Cf_log")))
embed_data <- function(path)
paste0("data:", mime::guess_type(path), ";base64,",
base64enc::base64encode(path))
embed_file_link <- function(path, .href = embed_data(path),
.name = basename(path), .text = paste("Download", .name), ...) {
withTags(p(a(.text, href = .href, download = .name, ...)))
}
icon_download <- htmltools::tagList(htmltools::tag("i", list(class = "fa fa-download")),
HTML(paste("Publication list for", unit_label)))
icon_download <- htmltools::attachDependencies(icon_download,
list(html_dependency_font_awesome()))
# export to xlsx format, into tempdir so we can embed a file link
# data that we want to export
if (!isTRUE(is_authorbased)) {
publications_kth <- abm_publications(data)
} else {
# we have publications for a "slug"
publications_kth <-
data %>%
arrange(Publication_Year, Publication_Type_DiVA, WoS_Journal, PID) %>%
mutate(Unit_code = unit_code) %>%
mutate(Unit_Name = unit_label) %>%
select(Unit_Name, Unit_code, everything())
}
# Create excel workbook
filename <- paste0("ABM_PubList_", unit_file_label, "_", current_date, ".xlsx")
excel_file <- file.path(tempdir(), filename)
writexl::write_xlsx(path = excel_file,
x = list(
Data = as.data.frame(publications_kth),
Attribution = data.frame(attribution = wos_attribution())
)
)
embed_file_link(excel_file,
.text = "Download Publication List in Excel format",
title = filename, #"Download Publication List in Excel format", # hover
class = "btn btn-sm btn-primary")
} else {
HTML("Publication data is available only after login.")
}
}
#' Summary valuebox for publications
#'
#' @param df_diva data frame with DiVA publication data in a specific format
#' @param lastyear previous year
#' @param start_year first year of total interval of years
#' @param stop_year last year of total interval of years
#' @param unit_label the unit label to use in case of no data
#' @import htmltools ktheme
#' @importFrom glue glue
#' @importFrom flexdashboard valueBox
#' @export
abm_ui_summary_pubs <- function(df_diva, lastyear,
start_year, stop_year, unit_label) {
if (nrow(df_diva) > 0) {
total_pubs <- sum(df_diva[, as.character(lastyear)], na.rm = TRUE)
vb1 <- flexdashboard::valueBox(
value = round(total_pubs, 1),
color = unname(ktheme::palette_kth(4)["blue"]),
icon = "fa-chart-bar",
href = "#publications-in-diva")
vb1
} else {
HTML(glue("<p><i>{unit_label} has no publications registered in DiVA {start_year} - {stop_year}</i></p>"))
}
}
#' Make ABM table have last rows bold with gray background, other rows with white background
#'
#' @param t the table to be formatted
#' @importFrom DT formatStyle styleEqual
#' @noRd
abm_format_rows <- function(t) {
DT::formatStyle(table = t,
columns = 1,
target = "row",
fontWeight = DT::styleEqual("Total", "bold"),
backgroundColor = DT::styleEqual("Total", "#DDDDDD", "#FFFFFF"))
}
#' @importFrom DT formatStyle
#' @noRd
abm_format_columns_divatable <- function(t, column_name, has_left_border) {
DT::formatStyle(table = t,
columns = column_name,
target = "cell",
fontWeight = "bold",
backgroundColor = "#EEEEEE",
borderLeft = ifelse(has_left_border, "1px solid #CCCCCC", "")
)
}
#' @importFrom DT formatStyle
#' @noRd
abm_format_header_divatable <- function(header) {
header %>%
sub("th\\('Publications', class = 'display dt-left', style = '",
"th('Total', class = 'display dt-left', style = 'background-color:#EEEEEE; border-left: 1px solid #CCCCCC; ", .) %>%
sub("th\\('WoS coverage', class = 'display dt-left', style = '",
"th('WoS coverage', class = 'display dt-left', style = 'background-color:#EEEEEE; ", .) %>%
sub("th\\('Scopus coverage', class = 'display dt-left', style = '",
"th('Scopus coverage', class = 'display dt-left', style = 'background-color:#EEEEEE; ", .)
}
getheader <- function(indics) {
getcell <- function(indic) {
indicrow <- get_indic_descriptions() %>%
filter(tolower(varname) == tolower(indic))
if(nrow(indicrow) == 1){
disp <- indicrow %>% pull(displayname)
popup <- indicrow %>% pull(description_short)
} else {
disp = indic
popup = ""
}
disp <- disp %>% nowrap_hyphen_sub()
glue("th('{disp}', class = 'display dt-left', style = 'padding-left: 10px; padding-right: 10px;', title = '{popup}')")
}
cells <- paste(lapply(indics, getcell), collapse = ",")
paste0("htmltools::withTags(table(class = 'display dt-right', thead(tr(", cells, "))))")
}
getcolnames <- function(indics) {
getname <- function(indic) {
newname <- get_indic_descriptions() %>%
filter(tolower(varname) == tolower(indic)) %>%
pull(displayname)
if(is_empty(newname)){
indic
} else {
newname
}
}
sapply(indics, getname)
}
#' Datatable for researchers
#'
#' @param data data frame with researchers in specific format
#' @param unit_file_label the filename presented when users make use of the download button
#' @param unit_title the label presented when users make use of the download button
#' @importFrom DT datatable
#' @export
abm_ui_datatable_researchers <- function(data, unit_file_label, unit_title) {
filename <- paste0("ABM_researchers_", unit_file_label, "_",
format(Sys.Date(), "%Y%m%d"))
header <- eval(parse(text = getheader(names(data))))
DT::datatable(
data,
container = header,
rownames = FALSE,
extensions = "Buttons",
plugins = "natural",
style = "bootstrap",
class = "compact",
width = "720",
options = list(
order = list(list(1, "asc"), list(0, "asc")),
ordering = TRUE,
columnDefs = list(list(type = 'natural', targets = list(0:length(data)-1))),
bPaginate = TRUE,
pageLength = 10,
scrollX = TRUE,
scrollY = FALSE,
dom = 'fltBp',
buttons = list(
list(extend = "copy", title = unit_title),
list(extend = "csv", filename = filename, title = unit_title),
list(extend = "excel", filename = filename, title = unit_title))
)) %>%
DT::formatRound(length(data), digits = 1)
}
#' Datatable for publication list
#'
#' @param data data frame with list of publications
#' @param unit_file_label the filename presented when users make use of the download button
#' @param unit_title the label presented when users make use of the download button
#' @import htmltools dplyr
#' @export
abm_ui_datatable_publications <- function(data, unit_title, unit_file_label){
if(nrow(data) > 0){
filename <- paste0("ABM_publications_", unit_file_label, "_",
format(Sys.Date(), "%Y%m%d"))
header <- eval(parse(text = getheader(names(data))))
DT::datatable(
data,
container = header,
rownames = FALSE,
extensions = "Buttons",
plugins = "natural",
style = "bootstrap",
class = "compact",
width = "720",
options = list(
order = list(list(1, "asc"), list(0, "asc")),
ordering = TRUE,
columnDefs = list(list(type = 'natural', targets = list(0:length(data)-1))),
bPaginate = TRUE,
pageLength = 10,
scrollX = TRUE,
scrollY = FALSE,
dom = 'fltBp',
buttons = list(
list(extend = "copy", title = unit_title),
list(extend = "csv", filename = filename, title = unit_title),
list(extend = "excel", filename = filename, title = unit_title))
))
} else {
withTags(p(style = "font-style: italic;", "There are no publications available for this table"))
}
}
#' Datatable for DiVA publications
#'
#' @param df_diva data frame with DiVA publication data in a specific format
#' @param unit_file_label the filename presented when users make use of the download button
#' @param unit_title the label presented when users make use of the download button
#' @import htmltools
#' @importFrom DT formatRound formatPercentage formatStyle
#' @export
abm_ui_datatable_diva <- function(df_diva, unit_file_label, unit_title) {
current_date <- format(Sys.Date(), "%Y%m%d")
if (nrow(df_diva) > 0) {
filename <- paste0("ABM_table1_", unit_file_label, "_", current_date)
diva_table <- df_diva
header <- eval(parse(text = getheader(names(diva_table)) %>% abm_format_header_divatable()))
DT::datatable(diva_table,
container = header,
rownames = FALSE,
extensions = "Buttons",
fillContainer = FALSE,
style = "bootstrap", class = "compact", width = "720",
options = list(
ordering = FALSE,
bPaginate = FALSE,
scrollX = TRUE,
scrollY = FALSE,
dom = 'tB',
buttons = list(
list(extend = "copy", title = unit_title),
list(extend = "csv", filename = filename, title = unit_title),
list(extend = "excel", filename = filename, title = unit_title))
)) %>%
DT::formatRound(2:(length(diva_table)-2), digits = 1, mark = "") %>%
DT::formatPercentage((length(diva_table)-1):length(diva_table), digits = 1) %>%
abm_format_rows() %>%
abm_format_columns_divatable("P_frac", has_left_border = TRUE) %>%
abm_format_columns_divatable("WoS_coverage", has_left_border = FALSE) %>%
abm_format_columns_divatable("Scopus_coverage", has_left_border = FALSE)
} else {
withTags(p(style = "font-style: italic;", "There are no publications available for this table"))
}
}
#' HTML table for DiVA publications
#'
#' @param df_diva data frame with DiVA publication data in a specific format
#' @import htmltools
#' @importFrom knitr kable
#' @importFrom kableExtra kable_styling scroll_box column_spec
#' @export
abm_ui_kable_diva <- function(df_diva) {
if (nrow(df_diva) > 0) {
df_diva %>%
mutate_at(vars(-"Publication_Type_DiVA", -"WoS_coverage", -"Scopus_coverage"), round, digits = 1) %>%
mutate_at(vars(ends_with("coverage")), function(x) sprintf("%3.1f%%", x * 100)) %>%
kable(col.names = getcolnames(names(df_diva)),
align = c("l", rep("r", ncol(df_diva) - 1))) %>%
# Note: include_thead = TRUE gives error in kableExtra versions > 1.1.0
column_spec(column = ncol(df_diva) - 2, background = "#EEEEEE", border_left = "solid 1px #CCCCCC", include_thead = FALSE) %>%
column_spec(column = (ncol(df_diva) -1):ncol(df_diva), background = "#EEEEEE", include_thead = FALSE) %>%
kable_styling(bootstrap_options = c("responsive")) %>%
scroll_box(width = "768px")
} else {
withTags(p(style = "font-style: italic;", "There are no publications available for this table"))
}
}
#' Datatable for DiVA publications, full counts
#'
#' @param df_diva_full data frame with DiVA publication data in a specific format
#' @param unit_file_label the filename presented when users make use of the download button
#' @param unit_title the label presented when users make use of the download button
#' @import htmltools
#' @importFrom DT formatRound formatPercentage formatStyle
#' @export
abm_ui_datatable_diva_full <- function(df_diva_full, unit_file_label, unit_title) {
current_date <- format(Sys.Date(), "%Y%m%d")
if (nrow(df_diva_full) > 0) {
filename <- paste0("ABM_table1_full_", unit_file_label, "_", current_date)
diva_table <- df_diva_full
header <- eval(parse(text = getheader(names(diva_table)) %>% abm_format_header_divatable()))
DT::datatable(diva_table,
container = header,
rownames = FALSE,
fillContainer = FALSE,
extensions = "Buttons",
style = "bootstrap", class = "compact", width = "100%",
options = list(
ordering = FALSE,
bPaginate = FALSE,
scrollX = TRUE,
scrollY = FALSE,
dom = 'tB',
buttons = list(
list(extend = "copy", title = unit_title),
list(extend = "csv", filename = filename, title = unit_title),
list(extend = "excel", filename = filename, title = unit_title))
)) %>%
DT::formatRound(2:(length(diva_table)-2), digits = 0, mark = "") %>%
DT::formatPercentage((length(diva_table)-1):length(diva_table), digits = 1) %>%
abm_format_rows() %>%
abm_format_columns_divatable("P_full", has_left_border = TRUE) %>%
abm_format_columns_divatable("WoS_coverage", has_left_border = FALSE) %>%
abm_format_columns_divatable("Scopus_coverage", has_left_border = FALSE)
} else {
withTags(p(style = "font-style: italic;", "There are no publications available for this table"))
}
}
#' HTML table for DiVA publications, full counts
#'
#' @param df_diva_full data frame with DiVA publication data in a specific format
#' @import htmltools
#' @importFrom knitr kable
#' @importFrom kableExtra kable_styling scroll_box column_spec
#' @export
abm_ui_kable_diva_full <- function(df_diva_full) {
df_diva <- df_diva_full
if (nrow(df_diva) > 0) {
df_diva %>%
mutate_at(vars(-"Publication_Type_DiVA", -"WoS_coverage", -"Scopus_coverage"), round, digits = 0) %>%
mutate_at(vars(ends_with("coverage")), function(x) sprintf("%3.1f%%", x * 100)) %>%
kable(col.names = getcolnames(names(df_diva)),
align = c("l", rep("r", ncol(df_diva) - 1))) %>%
# Note: include_thead = TRUE gives error in kableExtra versions > 1.1.0
column_spec(column = ncol(df_diva) - 2, background = "#EEEEEE", border_left = "solid 1px #CCCCCC", include_thead = FALSE) %>%
column_spec(column = (ncol(df_diva) -1):ncol(df_diva), background = "#EEEEEE", include_thead = FALSE) %>%
kable_styling(bootstrap_options = c("responsive")) %>%
scroll_box(width = "768px")
} else {
withTags(p(style = "font-style: italic;", "There are no publications available for this table"))
}
}
#' Datatable for 3 year citations
#'
#' @param df_city3y data frame with DiVA publication data in a specific format
#' @param unit_file_label the filename presented when users make use of the download button
#' @param unit_title the label presented when users make use of the download button
#' @import htmltools
#' @importFrom DT formatRound formatPercentage formatStyle
#' @export
abm_ui_datatable_city3y <- function(df_city3y, unit_file_label, unit_title) {
current_date <- format(Sys.Date(), "%Y%m%d")
if (nrow(df_city3y) > 0) {
filename <- paste0("ABM_table2_", unit_file_label, "_", current_date)
header <- eval(parse(text = getheader(names(df_city3y))))
DT::datatable(df_city3y,
container = header,
rownames = FALSE,
fillContainer = FALSE,
extensions = "Buttons",
options = list(
ordering = FALSE,
bPaginate = FALSE,
scrollX = TRUE,
scrollY = FALSE,
dom = 'tB',
buttons = list(
list(extend = "copy", title = unit_title),
list(extend = "csv", filename = filename, title = unit_title),
list(extend = "excel", filename = filename, title = unit_title))
)) %>%
DT::formatRound(2:5, digits = 1, mark = "") %>%
DT::formatPercentage(6, digits = 1) %>%
abm_format_rows()
} else {
withTags(p(style = "font-style: italic;", "There are no publications available for this table"))
}
}
#' HTML table for 3 year citations
#'
#' @param df_cit3y data frame with DiVA publication data in a specific format
#' @import htmltools
#' @importFrom knitr kable
#' @importFrom kableExtra kable_styling scroll_box
#' @export
abm_ui_kable_cit3y <- function(df_cit3y) {
if (nrow(df_cit3y) > 0) {
df_cit3y %>%
mutate_at(vars(2:5), function(x) sprintf("%.1f", x)) %>%
mutate_at(vars(6), function(x) sprintf("%.1f%%", x * 100)) %>%
kable(col.names = getcolnames(names(df_cit3y)),
align = c("l", rep("r", ncol(df_cit3y) - 1))) %>%
kable_styling(bootstrap_options = c("responsive")) %>%
scroll_box(width = "720px")
} else {
withTags(p(style = "font-style: italic;", "There are no publications available for this table"))
}
}
#' Datatable for 3 year citations (cf)
#'
#' @param df_cf data frame with DiVA publication data in a specific format
#' @param unit_file_label the filename presented when users make use of the download button
#' @param unit_title the label presented when users make use of the download button
#' @import htmltools
#' @importFrom DT formatRound formatPercentage formatStyle
#' @export
abm_ui_datatable_cf <- function(df_cf, unit_file_label, unit_title) {
current_date <- format(Sys.Date(), "%Y%m%d")
if (nrow(df_cf) > 0) {
filename <- paste0("ABM_table3_", unit_file_label, "_", current_date)
header <- eval(parse(text = getheader(names(df_cf))))
DT::datatable(df_cf,
container = header,
rownames = FALSE,
extensions = "Buttons",
options = list(
ordering = FALSE,
bPaginate = FALSE,
dom = 'tB',
scrollX = TRUE,
scrollY = FALSE,
buttons = list(
list(extend = "copy", title = unit_title),
list(extend = "csv", filename = filename, title = unit_title),
list(extend = "excel", filename = filename, title = unit_title))
)
) %>%
formatRound(c(2, 4), digits = 1, mark = "") %>%
formatRound(3, digits = 2, mark = "") %>%
formatPercentage(5, digits = 1) %>%
abm_format_rows()
} else {
withTags(p(style = "font-style: italic;", "There are no publications available for this table"))
}
}
#' HTML table for 3 year citations (cf)
#'
#' @param df_cf data frame with DiVA publication data in a specific format
#' @import htmltools
#' @importFrom knitr kable
#' @importFrom kableExtra kable_styling scroll_box
#' @export
abm_ui_kable_cf <- function(df_cf) {
if (nrow(df_cf) > 0) {
df_cf %>%
mutate_at(vars(2, 4), function(x) sprintf("%.1f", x)) %>%
mutate_at(vars(3), function(x) sprintf("%.2f", x)) %>%
mutate_at(vars(5), function(x) sprintf("%.1f%%", x * 100)) %>%
kable(col.names = getcolnames(names(df_cf)),
align = c("l", rep("r", ncol(df_cf) - 1))) %>%
kable_styling(bootstrap_options = c("responsive")) %>%
scroll_box(width = "720px")
} else {
withTags(p(style = "font-style: italic;", "There are no publications available for this table"))
}
}
#' Datatable for journal impact (jcf)
#'
#' @param df_jcf data frame with DiVA publication data in a specific format
#' @param unit_file_label the filename presented when users make use of the download button
#' @param unit_title the label presented when users make use of the download button
#' @import htmltools
#' @importFrom DT formatRound formatPercentage formatStyle
#' @export
abm_ui_datatable_jcf <- function(df_jcf, unit_file_label, unit_title) {
current_date <- format(Sys.Date(), "%Y%m%d")
if (nrow(df_jcf) > 0) {
filename <- paste0("ABM_table4_", unit_file_label, "_", current_date)
header <- eval(parse(text = getheader(names(df_jcf))))
DT::datatable(df_jcf,
container = header,
rownames = FALSE,
extensions = "Buttons",
options = list(
ordering = FALSE,
bPaginate = FALSE,
dom = 'tB',
scrollX = TRUE,
scrollY = FALSE,
buttons = list(
list(extend = "copy", title = unit_title),
list(extend = "csv", filename = filename, title = unit_title),
list(extend = "excel", filename = filename, title = unit_title))
)) %>%
formatRound(c(2, 4), digits = 1, mark = "") %>%
formatRound(3, digits = 2, mark = "") %>%
formatPercentage(5, digits = 1) %>%
abm_format_rows()
} else {
withTags(p(style = "font-style: italic;", "There are no publications available for this table"))
}
}
#' HTML table for journal impact (jcf)
#'
#' @param df_jcf data frame with DiVA publication data in a specific format
#' @import htmltools
#' @importFrom knitr kable
#' @importFrom kableExtra kable_styling scroll_box
#' @export
abm_ui_kable_jcf <- function(df_jcf) {
if (nrow(df_jcf) > 0) {
df_jcf %>%
mutate_at(vars(2, 4), function(x) sprintf("%.1f", x)) %>%
mutate_at(vars(3), function(x) sprintf("%.2f", x)) %>%
mutate_at(vars(5), function(x) sprintf("%.1f%%", x * 100)) %>%
kable(col.names = getcolnames(names(df_jcf)),
align = c("l", rep("r", ncol(df_jcf) - 1))) %>%
kable_styling(bootstrap_options = c("responsive")) %>%
scroll_box(width = "720px")
} else {
withTags(p(style = "font-style: italic;", "There are no publications available for this table"))
}
}
#' Datatable for co-publication (WoS)
#'
#' @param df_copub data frame with DiVA publication data in a specific format
#' @param unit_file_label the filename presented when users make use of the download button
#' @param unit_title the label presented when users make use of the download button
#' @import htmltools
#' @importFrom DT formatRound formatPercentage formatStyle
#' @export
abm_ui_datatable_copub <- function(df_copub, unit_file_label, unit_title) {
current_date <- format(Sys.Date(), "%Y%m%d")
if (nrow(df_copub) > 0) {
filename <- paste0("ABM_table5_", unit_file_label, "_", current_date)
header <- eval(parse(text = getheader(names(df_copub))))
DT::datatable(df_copub,
container = header,
rownames = FALSE,
fillContainer = FALSE,
extensions = "Buttons",
options = list(
ordering = FALSE,
bPaginate = FALSE,
dom = 'tB',
scrollX = TRUE,
scrollY = FALSE,
buttons = list(
list(extend = "copy", title = unit_title),
list(extend = "csv", filename = filename, title = unit_title),
list(extend = "excel", filename = filename, title = unit_title))
)) %>%
formatPercentage(c(4,6), digits = 1) %>%
abm_format_rows()
} else {
withTags(p(style = "font-style: italic;", "There are no publications available for this table"))
}
}
#' HTML table for co-publication (WoS)
#'
#' @param df_copub data frame with DiVA publication data in a specific format
#' @import htmltools
#' @importFrom knitr kable
#' @importFrom kableExtra kable_styling scroll_box
#' @export
abm_ui_kable_copub <- function(df_copub) {
if (nrow(df_copub) > 0) {
df_copub %>%
mutate_at(vars(4, 6), function(x) sprintf("%.1f%%", x * 100)) %>%
kable(col.names = getcolnames(names(df_copub)),
align = c("l", rep("r", ncol(df_copub) - 1))) %>%
kable_styling(bootstrap_options = c("responsive")) %>%
scroll_box(width = "720px")
} else {
withTags(p(style = "font-style: italic;", "There are no publications available for this table"))
}
}
#' Datatable for open access publications
#'
#' @param df_oa data frame with DiVA publication data in a specific format
#' @param unit_file_label the filename presented when users make use of the download button
#' @param unit_title the label presented when users make use of the download button
#' @import htmltools
#' @importFrom DT formatRound formatPercentage formatStyle
#' @export
abm_ui_datatable_oa <- function(df_oa, unit_file_label, unit_title) {
current_date <- format(Sys.Date(), "%Y%m%d")
if (nrow(df_oa) > 0) {
filename <- paste0("ABM_open_access_", unit_file_label, "_", current_date)
header <- eval(parse(text = getheader(names(df_oa))))
DT::datatable(df_oa,
container = header,
rownames = FALSE,
extensions = "Buttons",
options = list(
ordering = FALSE,
bPaginate = FALSE,
dom = 'tB',
scrollX = TRUE,
scrollY = FALSE,
buttons = list(
list(extend = "copy", title = unit_title),
list(extend = "csv", filename = filename, title = unit_title),
list(extend = "excel", filename = filename, title = unit_title))
)) %>%
formatPercentage(9, digits = 1) %>%
abm_format_rows()
} else {
withTags(p(style = "font-style: italic;", "There are no publications available for this table"))
}
}
#' HTML table for open access publications
#'
#' @param df_oa data frame with DiVA publication data in a specific format
#' @import htmltools
#' @importFrom knitr kable
#' @importFrom kableExtra kable_styling scroll_box
#' @export
abm_ui_kable_oa <- function(df_oa) {
if (nrow(df_oa) > 0) {
df_oa %>%
mutate_at(vars(9), function(x) sprintf("%.1f%%", x * 100)) %>%
kable(col.names = getcolnames(names(df_oa)),
align = c("l", rep("r", ncol(df_oa) - 1))) %>%
kable_styling(bootstrap_options = c("responsive")) %>%
scroll_box(width = "720px")
} else {
withTags(p(style = "font-style: italic;", "There are no publications available for this table"))
}
}
#' Datatable for Scopus citations
#'
#' @param df_scop_cit data frame with DiVA publication data in a specific format
#' @param unit_file_label the filename presented when users make use of the download button
#' @param unit_title the label presented when users make use of the download button
#' @import htmltools
#' @importFrom DT formatRound formatPercentage formatStyle
#' @export
abm_ui_datatable_scop_cit <- function(df_scop_cit, unit_file_label, unit_title) {
current_date <- format(Sys.Date(), "%Y%m%d")
if (nrow(df_scop_cit) > 0) {
filename <- paste0("ABM_scopus_citations_", unit_file_label, "_", current_date)
header <- eval(parse(text = getheader(names(df_scop_cit))))
DT::datatable(df_scop_cit,
container = header,
fillContainer = FALSE,
rownames = FALSE,
extensions = "Buttons",
options = list(
ordering = FALSE,
bPaginate = FALSE,
dom = 'tB',
scrollX = TRUE,
scrollY = FALSE,
buttons = list(
list(extend = "copy", title = unit_title),
list(extend = "csv", filename = filename, title = unit_title),
list(extend = "excel", filename = filename, title = unit_title))
)) %>%
DT::formatRound(2:5, digits = 1, mark = "") %>%
DT::formatPercentage(6, digits = 1) %>%
abm_format_rows()
} else {
withTags(p(style = "font-style: italic;", "There are no publications available for this table"))
}
}
#' HTML table for Scopus citations
#'
#' @param df_scop_cit data frame with DiVA publication data in a specific format
#' @import htmltools
#' @importFrom knitr kable
#' @importFrom kableExtra kable_styling scroll_box
#' @export
abm_ui_kable_scop_cit <- function(df_scop_cit) {
if (nrow(df_scop_cit) > 0) {
df_scop_cit %>%
mutate_at(vars(2:5), function(x) sprintf("%.1f", x)) %>%
mutate_at(vars(6), function(x) sprintf("%.1f%%", x * 100)) %>%
kable(col.names = getcolnames(names(df_scop_cit)),
align = c("l", rep("r", ncol(df_scop_cit) - 1))) %>%
kable_styling(bootstrap_options = c("responsive")) %>%
scroll_box(width = "720px")
} else {
withTags(p(style = "font-style: italic;", "There are no publications available for this table"))
}
}
#' Datatable for Scopus FWCI
#'
#' @param df_scop_normcit data frame with DiVA publication data in a specific format
#' @param unit_file_label the filename presented when users make use of the download button
#' @param unit_title the label presented when users make use of the download button
#' @import htmltools
#' @importFrom DT formatRound formatPercentage formatStyle
#' @export
abm_ui_datatable_scop_normcit <- function(df_scop_normcit, unit_file_label, unit_title) {
current_date <- format(Sys.Date(), "%Y%m%d")
if (nrow(df_scop_normcit) > 0) {
filename <- paste0("ABM_table_scop_normcit_", unit_file_label, "_", current_date)
header <- eval(parse(text = getheader(names(df_scop_normcit))))
DT::datatable(df_scop_normcit,
container = header,
fillContainer = FALSE,
rownames = FALSE,
extensions = "Buttons",
options = list(
ordering = FALSE,
bPaginate = FALSE,
dom = 'tB',
scrollX = TRUE,
scrollY = FALSE,
buttons = list(
list(extend = "copy", title = unit_title),
list(extend = "csv", filename = filename, title = unit_title),
list(extend = "excel", filename = filename, title = unit_title))
)
) %>%
formatRound(c(2, 4), digits = 1, mark = "") %>%
formatRound(3, digits = 2, mark = "") %>%
formatPercentage(5, digits = 1) %>%
abm_format_rows()
} else {
withTags(p(style = "font-style: italic;", "There are no publications available for this table"))
}
}
#' HTML table for Scopus FWCI
#'
#' @param df_scop_normcit data frame with DiVA publication data in a specific format
#' @import htmltools
#' @importFrom knitr kable
#' @importFrom kableExtra kable_styling scroll_box
#' @export
abm_ui_kable_scop_normcit <- function(df_scop_normcit) {
if (nrow(df_scop_normcit) > 0) {
df_scop_normcit %>%
mutate_at(vars(2, 4), function(x) sprintf("%.1f", x)) %>%
mutate_at(vars(3), function(x) sprintf("%.2f", x)) %>%
mutate_at(vars(5), function(x) sprintf("%.1f%%", x * 100)) %>%
kable(col.names = getcolnames(names(df_scop_normcit)),
align = c("l", rep("r", ncol(df_scop_normcit) - 1))) %>%
kable_styling(bootstrap_options = c("responsive")) %>%
scroll_box(width = "720px")
} else {
withTags(p(style = "font-style: italic;", "There are no publications available for this table"))
}
}
#' Datatable for Scopus journal impact (SNIP)
#'
#' @param df_scop_snip data frame with DiVA publication data in a specific format
#' @param unit_file_label the filename presented when users make use of the download button
#' @param unit_title the label presented when users make use of the download button
#' @import htmltools
#' @importFrom DT formatRound formatPercentage formatStyle
#' @export
abm_ui_datatable_scop_snip <- function(df_scop_snip, unit_file_label, unit_title) {
current_date <- format(Sys.Date(), "%Y%m%d")
if (nrow(df_scop_snip) > 0) {
filename <- paste0("ABM_table_scop_snip_", unit_file_label, "_", current_date)
header <- eval(parse(text = getheader(names(df_scop_snip))))
DT::datatable(df_scop_snip,
container = header,
rownames = FALSE,
extensions = "Buttons",
options = list(
ordering = FALSE,
bPaginate = FALSE,
dom = 'tB',
scrollX = TRUE,
scrollY = FALSE,
buttons = list(
list(extend = "copy", title = unit_title),
list(extend = "csv", filename = filename, title = unit_title),
list(extend = "excel", filename = filename, title = unit_title))
)) %>%
formatRound(c(2, 4), digits = 1, mark = "") %>%
formatRound(3, digits = 2, mark = "") %>%
formatPercentage(5, digits = 1) %>%
abm_format_rows()
} else {
withTags(p(style = "font-style: italic;", "There are no publications available for this table"))
}
}
#' HTML table for Scopus journal impact (SNIP)
#'
#' @param df_scop_snip data frame with DiVA publication data in a specific format
#' @import htmltools
#' @importFrom knitr kable
#' @importFrom kableExtra kable_styling scroll_box
#' @export
abm_ui_kable_scop_snip <- function(df_scop_snip) {
if (nrow(df_scop_snip) > 0) {
df_scop_snip %>%
mutate_at(vars(2, 4), function(x) sprintf("%.1f", x)) %>%
mutate_at(vars(3), function(x) sprintf("%.2f", x)) %>%
mutate_at(vars(5), function(x) sprintf("%.1f%%", x * 100)) %>%
kable(col.names = getcolnames(names(df_scop_snip)),
align = c("l", rep("r", ncol(df_scop_snip) - 1))) %>%
kable_styling(bootstrap_options = c("responsive")) %>%
scroll_box(width = "720px")
} else {
withTags(p(style = "font-style: italic;", "There are no publications available for this table"))
}
}
#' Datatable for co-publication (Scopus)
#'
#' @param df_scop_copub data frame with DiVA publication data in a specific format
#' @param unit_file_label the filename presented when users make use of the download button
#' @param unit_title the label presented when users make use of the download button
#' @import htmltools
#' @importFrom DT formatRound formatPercentage formatStyle
#' @export
abm_ui_datatable_scop_copub <- function(df_scop_copub, unit_file_label, unit_title) {
current_date <- format(Sys.Date(), "%Y%m%d")
if (nrow(df_scop_copub) > 0) {
filename <- paste0("ABM_table_scop_copub_", unit_file_label, "_", current_date)
header <- eval(parse(text = getheader(names(df_scop_copub))))
DT::datatable(df_scop_copub,
container = header,
fillContainer = FALSE,
rownames = FALSE,
extensions = "Buttons",
options = list(
ordering = FALSE,
bPaginate = FALSE,
dom = 'tB',
scrollX = TRUE,
scrollY = FALSE,
buttons = list(
list(extend = "copy", title = unit_title),
list(extend = "csv", filename = filename, title = unit_title),
list(extend = "excel", filename = filename, title = unit_title))
)) %>%
formatPercentage(c(4,6), digits = 1) %>%
abm_format_rows()
} else {
withTags(p(style = "font-style: italic;", "There are no publications available for this table"))
}
}
#' HTML table for co-publication (Scopus)
#'
#' @param df_scop_copub data frame with DiVA publication data in a specific format
#' @import htmltools
#' @importFrom knitr kable
#' @importFrom kableExtra kable_styling scroll_box
#' @export
abm_ui_kable_scop_copub <- function(df_scop_copub) {
if (nrow(df_scop_copub) > 0) {
df_scop_copub %>%
mutate_at(vars(4, 6), function(x) sprintf("%.1f%%", x * 100)) %>%
kable(col.names = getcolnames(names(df_scop_copub)),
align = c("l", rep("r", ncol(df_scop_copub) - 1))) %>%
kable_styling(bootstrap_options = c("responsive")) %>%
scroll_box(width = "720px")
} else {
withTags(p(style = "font-style: italic;", "There are no publications available for this table"))
}
}
#' Datatable for co-publication countries (WoS)
#'
#' @param df_copub_countries data frame with co-publication countries and number of publications
#' @param unit_file_label the filename presented when users make use of the download button
#' @param unit_title the label presented when users make use of the download button
#' @import htmltools
#' @importFrom dplyr arrange
#' @importFrom formattable formattable color_bar as.datatable proportion
#' @importFrom ktheme palette_kth_neo
#' @export
abm_ui_datatable_copub_countries <- function(df_copub_countries, unit_file_label, unit_title) {
current_date <- format(Sys.Date(), "%Y%m%d")
pal <- palette_kth_neo(17)
lightblue <- unname(pal["lightteal"])
lightgrey <- unname(pal["sand"])
if (nrow(df_copub_countries) > 0) {
filename <- paste0("ABM_copub_countries_", unit_file_label, "_", current_date)
# formattable version of df, to wrap as DT later
df <- formattable(df_copub_countries %>% rename(`Publications (frac)` = kth_frac),
list(
#area(col = p_10:p_50) ~ color_tile("transparent", "pink") # doesn't work: "unused argument (col = p_10:p_50)"-error
p = color_bar(lightgrey),
p_10 = color_bar(lightblue),
p_50 = color_bar(lightblue),
p_200 = color_bar(lightblue),
p_over200 = color_bar(lightblue)
))
header <- eval(parse(text = getheader(names(df))))
as.datatable(df,
container = header,
rownames = FALSE,
fillContainer = FALSE,
extensions = "Buttons",
options = list(
ordering = TRUE,
bPaginate = TRUE,
dom = 'ftpB',
scrollX = TRUE,
scrollY = FALSE,
buttons = list(
list(extend = "copy", title = unit_title),
list(extend = "csv", filename = filename, title = unit_title),
list(extend = "excel", filename = filename, title = unit_title))
))%>%
formatRound(7, digits = 1, mark = "")
} else {
withTags(p(style = "font-style: italic;", "There are no publications available for this table"))
}
}
#' HTML table for co-publication countries (WoS)
#'
#' @param df_copub_countries data frame with co-publication data in a specific format
#' @import htmltools
#' @importFrom knitr kable
#' @importFrom kableExtra kable_styling scroll_box
#' @export
abm_ui_kable_copub_countries <- function(df_copub_countries) {
if (nrow(df_copub_countries) > 0) {
df <- df_copub_countries %>% rename(`Publications (frac)` = kth_frac)
df %>%
mutate_at(vars(7), function(x) sprintf("%.1f", x)) %>%
kable(col.names = getcolnames(names(df)),
align = c("l", rep("r", ncol(df) - 1))) %>%
kable_styling(bootstrap_options = c("responsive")) %>%
scroll_box(width = "720px", height = "400px")
} else {
withTags(p(style = "font-style: italic;", "There are no publications available for this table"))
}
}
#' Datatable for co-publication organizations (WoS)
#'
#' @param df_copub_orgs data frame with co-publication organizations and number of publications
#' @param unit_file_label the filename presented when users make use of the download button
#' @param unit_title the label presented when users make use of the download button
#' @import htmltools
#' @importFrom dplyr select arrange
#' @importFrom formattable formattable color_bar as.datatable proportion
#' @importFrom ktheme palette_kth_neo
#' @export
abm_ui_datatable_copub_orgs <- function(df_copub_orgs, unit_file_label, unit_title) {
current_date <- format(Sys.Date(), "%Y%m%d")
df <- df_copub_orgs %>% select(-unified_org_id) %>% rename(`Publications (frac)` = kth_frac)
pal <- palette_kth_neo(17)
lightblue <- unname(pal["lightteal"])
lightgrey <- unname(pal["sand"])
df$org_type <- as.factor(df$org_type)
if (nrow(df) > 0) {
filename <- paste0("ABM_copub_orgs_", unit_file_label, "_", current_date)
header <- eval(parse(text = getheader(names(df))))
# formattable version of df, to wrap as DT later
df2 <- formattable(df, list(p = color_bar(lightgrey),
p_10 = color_bar(lightblue),
p_50 = color_bar(lightblue),
p_200 = color_bar(lightblue),
p_over200 = color_bar(lightblue)
))
as.datatable(df2,
container = header,
rownames = FALSE,
fillContainer = FALSE,
extensions = "Buttons",
filter='top',
options = list(
ordering = TRUE,
bPaginate = TRUE,
dom = 'ftpB',
scrollX = TRUE,
scrollY = FALSE,
#list(targets = 2, searchable = FALSE),
buttons = list(
list(extend = "copy", title = unit_title),
list(extend = "csv", filename = filename, title = unit_title),
list(extend = "excel", filename = filename, title = unit_title))
)) %>%
formatRound(9, digits = 1, mark = "")
} else {
withTags(p(style = "font-style: italic;", "There are no publications available for this table"))
}
}
#' HTML table for co-publication organizations (WoS)
#'
#' @param df_copub_orgs data frame with co-publication data in a specific format
#' @import htmltools
#' @importFrom dplyr select
#' @importFrom knitr kable
#' @importFrom kableExtra kable_styling scroll_box
#' @export
abm_ui_kable_copub_orgs <- function(df_copub_orgs) {
df <- df_copub_orgs %>% select(-unified_org_id) %>% rename(`Publications (frac)` = kth_frac)
if (nrow(df) > 0) {
df %>%
mutate_at(vars(9), function(x) sprintf("%.1f", x)) %>%
kable(col.names = getcolnames(names(df)),
align = c("l", rep("r", ncol(df) - 1))) %>%
kable_styling(bootstrap_options = c("responsive")) %>%
scroll_box(width = "720px", height = "400px")
} else {
withTags(p(style = "font-style: italic;", "There are no publications available for this table"))
}
}
#' A note to keep in mind when interpreting results
#'
#' @param data data frame with DiVA publication data in a specific format
#' @param df_coverage data frame with coverage data
#' @param unit_level an integer indicating organizational aggregation level
#' @param is_fractional logical indicating if fractional values, by default FALSE
#' @param is_wos logical indicating if using WoS data, by default TRUE
#' @importFrom stats na.omit
#' @export
abm_ui_note <- function(data, df_coverage, unit_level, is_fractional = FALSE, is_wos = TRUE) {
if (isTRUE(unit_level >= 0)) {
intervals <-
data %>%
filter(substr(interval, 1, 1) == "2") %>%
pull(interval)
if (is_wos) {
cov <-
df_coverage %>%
filter(Publication_Type == "Article, peer review")
} else {
cov <-
df_coverage %>%
filter(Publication_Type == "Peer reviewed")
}
is_ok <- function(x) is.finite(na.omit(x))
if (nrow(cov) > 0 && (is_ok(min(cov$Publication_Year)) &&
is_ok(max(cov$Publication_Year)))) {
si <- sliding_intervals(
min(cov$Publication_Year),
max(cov$Publication_Year), 3)
cov <-
cov %>%
inner_join(si, by = c("Publication_Year" = "x")) %>%
filter(interval %in% intervals)
if (is_fractional) {
if (is_wos) {
cov <-
cov %>%
group_by(interval) %>%
summarise(
woscov_frac = sum(sumwos_frac) / sum(p_frac),
sumwos_full = sum(sumwos_full)
)
mincov <- min(cov$woscov_frac)
minpubs <- min(cov$sumwos_full)
} else {
cov <-
cov %>%
group_by(interval) %>%
summarise(
scopcov_frac = sum(sumscop_frac) / sum(p_frac),
sumscop_full = sum(sumscop_full)
)
mincov <- min(cov$scopcov_frac)
minpubs <- min(cov$sumscop_full)
}
} else {
if (is_wos) {
cov <-
cov %>%
group_by(interval) %>%
summarise(woscov_full = sum(sumwos_full) / sum(p_full))
mincov <- min(cov$woscov_full)
minpubs <- min(data$P_full)
} else {
cov <-
cov %>%
group_by(interval) %>%
summarise(scopcov_full = sum(sumscop_full) / sum(p_full))
mincov <- min(cov$scopcov_full)
minpubs <- min(data$P_full)
}
}
cat(glue("<span title='Legend: 75% or above is good, 60% or above is moderate while lower than 60% is poor'>Rows are based on at least <b>{minpubs}</b> (full counted) publications with ",
"<b>{coveragetext(mincov)}</b> Web of Science coverage (at least <b>{round(100*mincov, 1)}%</b>).<br>",
"(DiVA publication type Article, peer review)<br></span>"))
if (minpubs < 50)
cat("<b>Indicators based on < 50 publications are considered unreliable</b>")
} else {
cat("<b>Bibliometric indicators based on a low number of publications are considered unreliable.</b>")
}
} else {
# this is for individuals (unit_level is null, unlike organizational units)
cat("<b>Bibliometric results for individual researchers should always be interpreted with caution.</b>")
}
}
#' Value box for number of publications in ABM
#'
#' @param df data frame with DiVA publications data in a specific format
#' @param lastyear last year with DiVA publications
#' @param vbcolor color of valueBox
#' @param unit_label label to display if no data is available
#' @importFrom flexdashboard valueBox
#' @export
abm_ui_valuebox_publications <- function(df, lastyear, vbcolor, unit_label) {
if (nrow(df) > 0) {
total_pubs <- sum(df[, lastyear], na.rm = TRUE)
valueBox(
value = round(total_pubs, 1),
color = vbcolor,
icon = "fa-chart-bar",
href = "#publications-in-diva")
} else {
shiny::HTML(glue("<p><i>{unit_label} has no publications registered in DiVA {abm_config()$start_year} - {abm_config()$stop_year}</i></p>"))
}
}
#' Value box for coverage in ABM
#'
#' @param df data frame with coverage data
#' @param vbcolor color of valueBox
#' @param db database for which coverage will be shown ("wos" or "scopus")
#' @param unit_label label to display if no data is available
#' @importFrom flexdashboard valueBox
#' @export
abm_ui_valuebox_coverage <- function(df, vbcolor, db = c("wos", "scopus"),
unit_label) {
if (nrow(df %>% filter(Publication_Type == "Peer reviewed")) > 0) {
type <- match.arg(db)
if(type=="wos"){
cov <- df %>%
filter(Publication_Type == "Peer reviewed") %>%
summarise(cov = sum(sumwos_frac) / sum(p_frac)) %>%
pull(cov)
} else {
cov <- df %>%
filter(Publication_Type == "Peer reviewed") %>%
summarise(cov = sum(sumscop_frac) / sum(p_frac)) %>%
pull(cov)
}
valueBox(
value = paste(100*round(cov, 3), "%"),
color = vbcolor,
icon = "fa-percent",
href = "#publications-in-diva")
} else {
shiny::HTML(glue("<p><i>{unit_label} has no peer reviewed publications registered in DiVA {abm_config()$start_year} - {abm_config()$stop_year}</i></p>"))
}
}
#' Bullet graph for citations in ABM
#'
#' @param df data frame with citation stats by year
#' @import patchwork
#' @export
abm_ui_bullet_citations <- function(df) {
if (df %>% filter(!is.na(P_frac)) %>% nrow() > 0) {
years <- as.numeric(nth(df$Publication_Year, -2))
years <- (years-2):years
summary <- df |>
filter(Publication_Year %in% years) |>
summarise(cf = weighted.mean(cf, P_frac, na.rm = TRUE),
top10_share = weighted.mean(top10_share, P_frac, na.rm = TRUE))
cit_bullet1 <- abm_bullet(label = "Cf, Field normalized citations",
value = summary$cf, reference = 1.0, roundto = 2)
cit_bullet2 <- abm_bullet(label = "Share Top10% publications",
value = summary$top10_share, reference = 0.10, pct = TRUE)
cit_bullet1 / cit_bullet2
} else {
shiny::HTML("<p><i>There are no publications available for this graph</i></p>")
}
}
#' Bullet graph for journal citations in ABM
#'
#' @param df data frame with journal citation stats by year
#' @import patchwork
#' @export
abm_ui_bullet_journal <- function(df) {
if (df %>% filter(!is.na(P_frac)) %>% nrow() > 0) {
years <- as.numeric(nth(df$Publication_Year, -2))
years <- (years-2):years
summary <- df |>
filter(Publication_Year %in% years) |>
summarise(jcf = weighted.mean(jcf, P_frac, na.rm = TRUE),
top20_share = weighted.mean(top20_share, P_frac, na.rm = TRUE))
jcit_bullet1 <- abm_bullet(label = "JCf, Field normalized citations",
value = summary$jcf, reference = 1.0, roundto = 2)
jcit_bullet2 <- abm_bullet(label = "Share in Top20% journals",
value = summary$top20_share, reference = 0.20, pct = TRUE)
jcit_bullet1 / jcit_bullet2
} else {
shiny::HTML("<p><i>There are no publications available for this graph</i></p>")
}
}
#' Waffle graph for co-publications in ABM
#'
#' @param df data frame with co-publications stats by year
#' @import patchwork
#' @export
abm_ui_waffle_copub <- function(df) {
if (df %>% filter(!is.na(P_full)) %>% nrow() > 0) {
years <- as.numeric(nth(df$Publication_Year, -2))
years <- (years-2):years
summary <- df |>
filter(Publication_Year %in% years) |>
summarise(nonuniv_share = weighted.mean(nonuniv_share, P_full, na.rm = TRUE),
int_share = weighted.mean(int_share, P_full, na.rm = TRUE))
nonuniv_lbl <- sprintf("Swedish non-university: %d%%", round(100 * summary$nonuniv_share))
waffle1 <- abm_waffle_pct(summary$nonuniv_share, label = nonuniv_lbl)
int_lbl <- sprintf("International: %d%%", round(100 * summary$int_share))
waffle2 <- abm_waffle_pct(summary$int_share, label = int_lbl)
waffle1 / waffle2
} else {
shiny::HTML("<p><i>There are no publications available for this graph</i></p>")
}
}
#' Datatable for SDG publicaitons by year
#'
#' @param df_sdg_year data frame with data on SDG pubs
#' @param unit_file_label the filename presented when users make use of the download button
#' @param unit_title the label presented when users make use of the download button
#' @import htmltools dplyr
#' @importFrom DT formatRound formatPercentage formatStyle
#' @export
abm_ui_datatable_sdg_year <- function(df_sdg_year, unit_file_label, unit_title) {
p_sdg_frac <- share_sdg_frac <- NULL
current_date <- format(Sys.Date(), "%Y%m%d")
if (nrow(df_sdg_year) > 0) {
filename <- paste0("ABM_table_sdg_year_", unit_file_label, "_", current_date)
df <- df_sdg_year %>% select(Publication_Year, p_frac, p_sdg_frac, share_sdg_frac)
header <- eval(parse(text = getheader(names(df))))
DT::datatable(df,
container = header,
rownames = FALSE,
extensions = "Buttons",
options = list(
columnDefs = list(list(className = 'dt-left', targets = 0)),
ordering = FALSE,
bPaginate = FALSE,
dom = 'tB',
buttons = list(
list(extend = "copy", title = unit_title),
list(extend = "csv", filename = filename, title = unit_title),
list(extend = "excel", filename = filename, title = unit_title))
)) %>%
formatRound(c(2, 3), digits = 1) %>%
formatPercentage(4, digits = 1) %>%
abm_format_rows()
} else {
withTags(p(style = "font-style: italic;", "There are no publications available for this table"))
}
}
#' HTML table for SDG publicaitons by year
#'
#' @param df_sdg_year data frame with data on SDG pubs
#' @import htmltools dplyr
#' @importFrom knitr kable
#' @importFrom kableExtra kable_styling scroll_box
#' @export
abm_ui_kable_sdg_year <- function(df_sdg_year) {
p_sdg_frac <- share_sdg_frac <- NULL
if (nrow(df_sdg_year) > 0) {
df <- df_sdg_year %>% select(Publication_Year, p_frac, p_sdg_frac, share_sdg_frac)
df %>%
mutate_at(vars(2:3), function(x) sprintf("%.1f", x)) %>%
mutate_at(vars(4), function(x) sprintf("%.1f%%", x * 100)) %>%
kable(col.names = getcolnames(names(df)),
align = c("l", rep("r", ncol(df) - 1))) %>%
kable_styling(bootstrap_options = c("responsive")) %>%
scroll_box(width = "720px")
} else {
withTags(p(style = "font-style: italic;", "There are no publications available for this table"))
}
}
#' Datatable for SDG publicaitons by goal
#'
#' @param df_sdg_table data frame with data on SDG pubs
#' @param unit_file_label the filename presented when users make use of the download button
#' @param unit_title the label presented when users make use of the download button
#' @import htmltools dplyr
#' @importFrom DT formatRound formatPercentage formatStyle
#' @export
abm_ui_datatable_sdg_table <- function(df_sdg_table, unit_file_label, unit_title) {
SDG_Displayname <- NULL
current_date <- format(Sys.Date(), "%Y%m%d")
if (nrow(df_sdg_table) > 0) {
filename <- paste0("ABM_table_sdg_", unit_file_label, "_", current_date)
df <- df_sdg_table %>% filter(SDG_Displayname != 'None') %>% select(SDG_Displayname, p_frac)
header <- eval(parse(text = getheader(names(df))))
DT::datatable(df,
container = header,
rownames = FALSE,
extensions = "Buttons",
options = list(
ordering = FALSE,
bPaginate = FALSE,
dom = 'tB',
buttons = list(
list(extend = "copy", title = unit_title),
list(extend = "csv", filename = filename, title = unit_title),
list(extend = "excel", filename = filename, title = unit_title))
)) %>%
formatRound(2, digits = 1) %>%
abm_format_rows()
} else {
withTags(p(style = "font-style: italic;", "There are no publications available for this table"))
}
}
#' HTML table for SDG publicaitons by goal
#'
#' @param df_sdg_table data frame with data on SDG pubs
#' @import htmltools
#' @importFrom knitr kable
#' @importFrom kableExtra kable_styling scroll_box
#' @export
abm_ui_kable_sdg_table <- function(df_sdg_table) {
share_sdg_frac <- SDG_Displayname <- NULL
if (nrow(df_sdg_table) > 0) {
df <- df_sdg_table %>% filter(SDG_Displayname != 'None') %>% select(SDG_Displayname, p_frac)
df %>%
mutate_at(vars(2), function(x) sprintf("%.1f", x)) %>%
kable(col.names = getcolnames(names(df)),
align = c("l", rep("r", ncol(df) - 1))) %>%
kable_styling(bootstrap_options = c("responsive")) %>%
scroll_box(width = "720px")
} else {
withTags(p(style = "font-style: italic;", "There are no publications available for this table"))
}
}
#' Graph of indicators by year, with or without moving average and/or reference line
#'
#' @param df data frame to read indicators etc from
#' @param indicator df column name to graph
#' @param ma set to true for moving averages
#' @param weight weight to use for moving average
#' @param ylabel y-axis label to use in graph
#' @param refline optional y-reference line
#' @param percent set to true for percentage value
#' @import dplyr ggplot2
#' @importFrom ktheme palette_kth_neo theme_kth_neo
#' @importFrom zoo rollmean
#' @return ggplot
#' @export
time_graph <- function(df, indicator, ma = FALSE, weight = NULL, ylabel = NULL, refline = NULL, percent = FALSE) {
Publication_Year <- value <- NULL
kth_cols <- palette_kth_neo(n = 17, type = "qual")
df <- df |>
filter(Publication_Year != 'Total') |>
rename(value = !!indicator)
# Fill up missing years
df <- data.frame(Publication_Year = as.character(min(df$Publication_Year):max(df$Publication_Year))) |>
left_join(df, by = "Publication_Year")
if(ma){
# Add moving average
df <- df |>
rename(weight = !!weight) |>
mutate(ma = rollmean(weight * value, k = 3, fill = NA, na.rm = TRUE) / rollmean(ifelse(!is.na(value), weight, NA), k = 3, fill = NA, na.rm = TRUE))
}
# Decide max for Y scale
maxval <- max(df$value, na.rm = TRUE)
if(percent) {
ymax <- if_else(is.null(refline),
ceiling(10*maxval)/10,
max(2*refline, ceiling(10*maxval)/10))
} else {
ymax <- if_else(is.null(refline),
ceiling(maxval),
max(2*refline, ceiling(maxval)))
}
res <- ggplot(data = df,
aes(x = Publication_Year, y = value, group = 1)) +
geom_point(color = kth_cols["blue"], size = 3) +
geom_line(color = kth_cols["blue"], linetype = "dashed", linewidth = .5) +
xlab("Publication year") +
ylab(ylabel) +
ylim(0, ymax) +
theme_kth_neo() +
theme(axis.title.y = element_text(vjust = 2.5),
panel.grid.major.x = element_blank(),
panel.grid.minor.y = element_blank())
if(!is.null(refline)) {
res <- res +
geom_hline(yintercept = refline, color = kth_cols["lightteal"], linewidth = .8)
}
if(ma) {
res <- res +
geom_line(aes(y = ma), color = kth_cols["darkred"], linewidth = 1.2)
}
if(percent) {
res <- res +
scale_y_continuous(labels = percent_format(accuracy = 5L), limits = c(0, ymax))
}
res
}
#' Graph to subheader of timegraph
#'
#' @param colors_vb a color set to use
#' @export
timegraph_header_legend<-function(colors_vb = ktheme::palette_kth_neo(17)){
paste0('*Yearly (<span style="color:', colors_vb['blue'],'">••</span>) and moving average (<span style="color:', colors_vb['darkred'],'">—</span>)*')
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.