app.R

library(tidyverse)
library(dplyr)
library(shiny)
library(leaflet)
library(rairtable)
library(sf)
library(shinydashboard)


## Read in contributor data from airtable
## ------- note: airtable API key is set locally in .Renviron ---------


# MB Contributors (public)
contrib_table <- airtable('tblxNS2o3vGoE4KoU', 'appRoqMKzcK3NsXt4', view='viwc4dLAuIcaQ8Bp6') 
contrib_data <- read_airtable(contrib_table)
# Institutions list
inst_table <- airtable('tblFyNVgzp8PY56Dg', 'appRoqMKzcK3NsXt4')
inst_data <- read_airtable(inst_table)

# Projects list
proj_table <- airtable('tblAgaZDEx8hhksar', 'appRoqMKzcK3NsXt4')
proj_data <- read_airtable(proj_table)
proj_data <- proj_data[order(proj_data$Project),]
project_list <- unique(proj_data$Project) |> sort()

# contrib_data <- contrib_data %>% 
#   rename("inst_id" = "Primary Affiliation")

inst_data <- inst_data %>% 
  rename("Primary Affiliation" = "airtable_record_id")

inst_data <- subset(contrib_data, select=-c(Longitude))
inst_data <- subset(contrib_data, select=-c(Latitude))

contributors <- left_join(contrib_data, inst_data) |>
  as_tibble() |>
  filter(map2_lgl(Longitude, Latitude, \(long, lat) !is.null(long) && !is.null(lat))) |>
  mutate(Longitude = unlist(Longitude),
         Latitude = unlist(Latitude))

contrib_output <- select(contributors, Name, '🌍 Country', 'Primary Affiliation', 'Secondary Affiliation(s)', Projects, '🟢 ORCiD', Longitude, Latitude)

# Set value for the minZoom and maxZoom settings.
leaflet(options = leafletOptions(minZoom = 0, maxZoom = 18))

dropdownHack <- function(...,badgeStatus = NULL, .list = NULL, menuname=NULL){
  if (!is.null(badgeStatus)){
    shinydashboard:::validateStatus(badgeStatus)
  }
  items <- c(list(...), .list)
  lapply(items, shinydashboard:::tagAssert, type = "li")
  dropdownClass <- paste0("dropdown ", "text-menu")
  numItems <- length(items)
  if (is.null(badgeStatus)) {
    badge <- NULL
  }
  else {
    badge <- span(class = paste0("label label-", badgeStatus), numItems)
  }
  tags$li(class = dropdownClass, a( href="#", class="dropdown-toggle", 
                                    `data-toggle`="dropdown", menuname, badge),
          tags$ul(class = "dropdown-menu",  items  )
  )
}

menuitemHack <- function(text,href){
  notificationItem(text=text,href=href,icon=shiny::icon("link") )
}


ui <- dashboardPage(
  # note: copied code to add dropdown menu with links from: 
  # https://stackoverflow.com/questions/43302784/shinydashboard-header-dropdown-add-group-links
  dashboardHeader(title = "ManyBabies Contributor Dashboard", titleWidth = 350, 
                  dropdownHack(menuname="LINKS",
                               menuitemHack(text='manybabies.org',href="https://manybabies.org/"),
                               menuitemHack(text='MB contributors',href="https://airtable.com/appRoqMKzcK3NsXt4/shrmAhZCMC9Bno7vF/tblxNS2o3vGoE4KoU?backgroundColor=blueDusty&viewControls=on"),
                               menuitemHack(text='Dashboard ADD form',href="https://airtable.com/appRoqMKzcK3NsXt4/shrglw1TM1HxDfbYG"),
                               menuitemHack(text='Dashboard UPDATE form',href="https://airtable.com/appRoqMKzcK3NsXt4/shrBx1vEakEkyeYbg")
                  )),
  dashboardSidebar(disable = TRUE),
  dashboardBody(
    tags$head(
      tags$link(rel = "stylesheet", type = "text/css", href = "styles.css")
    ),
    tags$head(tags$style(HTML('
        .skin-blue .main-header .logo {
          background-color: #3c8dbc;
        }
        .skin-blue .main-header .logo:hover {
          background-color: #3c8dbc;
        }
      '))),
    # fluidRow(
    #   column(1, img(src = "MB_logo.png", height = 70, width = 70)),
    #   column(8, h2(" ManyBabies Contributor Dashboard"))
    # ),
    # br(),
    
    # fluidRow(
    #   box("Project", br(),
    #       uiOutput("project_filter"),
    #       status = "primary",  width = 3),
    #   valueBoxOutput("contribsBox", width = 3),
    #   valueBoxOutput("instBox", width = 3),
    #   valueBoxOutput("countriesBox", width = 3)
    # ),
    
    fluidRow(
      box(title = "Project", background = "orange",
          uiOutput("project_filter"), width = 3),
      valueBoxOutput("contribsBox", width = 3),
      valueBoxOutput("instBox", width = 3),
      valueBoxOutput("countriesBox", width = 3)
    ),
    
    leafletOutput(outputId = "leafletMap", height = 450),
    
    DT::dataTableOutput("table"),
    
    br()
    
  )
)

box(
  title = "Inputs", status = "warning", solidHeader = TRUE,
  "Box content here", br(), "More box content",
  sliderInput("slider", "Slider input:", 1, 100, 50),
  textInput("text", "Text input:")
)


green_clusters <- JS("function (cluster) {    
                    var childCount = cluster.getChildCount(); 
                    var c = ' marker-cluster-';  
                    c += 'small';
                    return new L.DivIcon({ html: '<div><span>' + childCount + '</span></div>', className: 'marker-cluster' + c, iconSize: new L.Point(40, 40) });
                    }")

all_val <- "[All projects]"





server <- function(input, output) {
  
  data <- reactive({
    message(input$project)
    contrib_output %>%
      mutate(INFO = paste(sep = "<br/>", Name, " | ", 'Primary Affiliation', ", ", `🌍 Country`, " | ", Projects)) |>
      filter(input$project == all_val | str_detect(Projects, paste0(input$project, "(?![-A-Za-z0-9])")))
  })
  
  global_popups <- reactive({
    paste0("<b>", data()$Name, "</b>", "<br/>",
           "<i>", data()$'Primary Affiliation', "</i>", "<br/>",
           data()$Projects
    )
  })
  
  output$project_filter <- renderUI({
    selectInput("project", label = NULL, choices = c(all_val, project_list))
  })
  
  output$leafletMap <- renderLeaflet({
    leaflet(data(),
            options = leafletOptions(zoomControl = TRUE)
    ) %>%
      addTiles() %>%
      # overlay groups
      addCircleMarkers(~Longitude, ~Latitude,
                       label = purrr::map(global_popups(), htmltools::HTML),
                       labelOptions = labelOptions(textsize = "12px"),
                       group = "MB Contributors",
                       color = ~ "#6ecc39",
                       radius = 7,
                       fillOpacity = 0.8,
                       clusterOptions = markerClusterOptions(maxClusterRadius = 30,
                                                             iconCreateFunction = green_clusters)
      )
  })
  
  # Filter table data based on project selection
  output$table <- DT::renderDataTable(DT::datatable({
    table_temp <- data()
    table_disp <- select(table_temp, Name, '🌍 Country', 'Primary Affiliation', 'Secondary Affiliation(s)', Projects, '🟢 ORCiD')
    table_disp
  }))
  
  output$contribsBox <- renderValueBox({
    valueBox(
      length(data()$Name), "Contributors", icon = icon("users"),
      color = "blue"
    )
  })
  
  output$instBox <- renderValueBox({
    valueBox(
      length(unique(data()$'Primary Affiliation')), "Institutions", icon = icon("university"),
      color = "maroon"
    )
  })
  
  output$countriesBox <- renderValueBox({
    valueBox(
      length(unique(data()$`🌍 Country`)), "Countries", icon = icon("globe"),
      color = "green"
    )
  })
  
}

shinyApp(ui = ui, server = server)