inst/rigaps_dashboard/server.R

In jomuller/rigaps: R Interface to Generate Analysis like the Program SIGAPS

library(shiny)
library(shinydashboard)

options(shiny.maxRequestSize = 30*1024^2)

affiliation_helper <- function(affiliation_input) {
  if (affiliation_input == "") r <- NA
  else {
    r <- unlist(strsplit(affiliation_input, ";"))
    r <- gsub("^[[\\] ]+|[[\\] ]+$|[[\\]]| +([[\\]]+)?(?= )", "", r, perl = TRUE)
  }

  r
}

#server
server <- function(input, output) {

  # Init reactive values
  rv <- reactiveValues(
    scores = integer(0),
    nb_articles_imported = as.integer(0),
    df_sigaps = NULL
    )

  output$infobox_df_sigaps <- renderInfoBox({
    if (is.null(rv$df_sigaps)) {
      txt <- "No Sigaps DB"
      color <- "red"
      icons <- icon("exclamation-triangle")
      subt <- ""
    }
    else {
      txt <- length(unique(rv$df_sigaps$nlm_id))
      color <- "green"
      icons <- icon("check-circle-o")
      subt <- "publications"
    }

    infoBox(
      title = "DB SIGAPS",
      value = txt,
      icon =  icons,
      color = color,
      subtitle = subt
    )
  })

  output$download_csv <- downloadHandler(
    filename = function() {
      paste0(format(Sys.time(), "%Y%m%dT%H%M"), "rigaps", ".csv")
    },
    content = function(con) {
      write.csv(x = publi_table(), con)
    }
  )

  # pour les tests
  output$search_button_text <- renderText(
    if (is.null(input$xml_file))
      "Chercher dans Medline"
    else
      paste("Importer", input$xml_file$name)
  )

  observeEvent(input$sigaps_html_file, {
    rv$df_sigaps <- rigaps:::import_sigaps_html(input$sigaps_html_file$datapath)
    print(rv$df_sigaps)
  })

  publi_table <- eventReactive(input$submit, {
    #if (is.null(rv$df_sigaps)) stop("No Data of publication rank")
    print("Mise à jour...")
    tb <- rigaps::get_sigaps_by_paper(
      author_lastname = input$author_lastname,
      author_firstname = input$author_firstname,
      affiliation = affiliation_helper(input$affiliation),
      year_end = input$year_range[2],
      year_start = input$year_range[1],
      xml_path = input$xml_file$datapath,
      other_query = input$other_pubmed_query,
      df_sigaps = rv$df_sigaps
    )

    print(paste("Lignes : ", nrow(tb)))
    rv$scores <- tb$sigaps_score
    # rv$nb_articles_imported <- nrow(tb)
    print(rv$scores)
    rv$nb_articles_imported <- nrow(tb)
    tb

  } )

  observeEvent(publi_table(),
               rv$nb_articles_imported <- nrow(publi_table()))
  output$info_nb_imported <- renderInfoBox({
    infoBox(
      title = "Articles",
      value = rv$nb_articles_imported,
      icon = icon("book"),
      color = ifelse(rv$nb_articles_imported, "green", "orange")
    )
  })

  output$infobox_score <- renderInfoBox({
    infoBox(
      title = "Score",
      value = sum(rv$scores, na.rm = TRUE),
      icon = icon("diamond"),
      color = ifelse(rv$nb_articles_imported, "green", "orange")
    )
  })

  output$sigaps_score <- renderText({
    print(rv$scores)
    sum(rv$scores, na.rm = TRUE)
  })


  output$pubmed_query <- renderText(
    make_pubmed_query(
      author_lastname = input$author_lastname,
      author_firstname = input$author_firstname,
      affiliation = affiliation_helper(input$affiliation),
      year_end = input$year_range[2],
      year_start = input$year_range[1],
      other_query = input$other_pubmed_query
    )
  )

  output$paper_dt <- DT::renderDataTable({

    table_formated <- rigaps:::format_publication_table(publi_table())
    DT::datatable(
      data = table_formated,
      escape = FALSE,
      filter = "top")
  })

  output$dt_author_ranks <- DT::renderDataTable({
    print("Calulate rank table...")
    DT::datatable(
      rigaps:::author_rank_table(publi_table()),
      selection = "none",
      filter = "none",
      options = list(paging = FALSE, searching = FALSE)
    )
    })

  output$dt_paper_ranks <- DT::renderDataTable({
    DT::datatable(
      rigaps:::paper_rank_table(publi_table()),
      selection = "none",
      filter = "none",
      options = list(paging = FALSE, searching = FALSE)
    )
    })
}