R/mod_start.R

Defines functions mod_start_server mod_start_ui

#' start UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd 
#'
#' @importFrom shiny NS tagList 
mod_start_ui <- function(id){
  ns <- NS(id)
  tagList(
    div(
      class = "two-cards",
      makeCard(
        size = 12,
        title = "About PsychTopics",
        style = "background-color: #c6cf78ff",
        content = tagList(
          bodyText(
            tagList("With this tool, you can explore current and past ",
                    tags$b("research trends in psychology"),
                    " from the ",  tags$b("German-speaking countries."),
                    " Topics are identified in ", tags$a("PSYNDEX", href = "http://www.psyndex.de", target = "_blank"),
                    ", the comprehensive literature database produced by the ",
                    tags$a("Leibniz Institute for Psychology (ZPID)", href = "https://www.leibniz-psychology.org/en/", target = "_blank"),
                    "."
            )
          ),
          br(),
          bodyText(uiOutput(ns("last_update"))),
          br(),
          bodyText(
            "PsychTopics is ", tags$b("open-source software"), ".", br(),
            " See the ",
            tags$a("GitHub repo", href = "https://github.com/leibniz-psychology", target = "_blank"),
            " for a list of contributors and the code."
          ),
          br(),
          bodyText(
            tagList(
              "How to cite: ",
              shiny.fluent::TooltipHost(
                content = tagList(
                  tags$div(
                    style = "margin: 11px",
                    shiny.fluent::Text("Bittermann, A. (2019). Development of a user-friendly app for exploring and analyzing research topics in psychology.",
                                       br(),
                                       "In G. Catalano, C. Daraio, M. Gregori, H. F. Moed & G. Ruocco (Eds.), Proceedings of the 17th Conference of the International Society for Scientometrics and Informetrics (2634–2635).",
                                       br(),
                                       "Rome: Edizioni Efesto."),
                    br(),
                    tags$a("http://dx.doi.org/10.23668/psycharchives.2521", href = "http://dx.doi.org/10.23668/psycharchives.2521", target = "_blank")
                  )
                ),
                delay = 0,
                tags$a("Bittermann (2019)")

              )
            )
          )
          
          # bodyText(
          #   tagList(
          #     "Shiny App Developed by: ",
          #     shiny.fluent::TooltipHost(
          #       content = tagList(
          #         shiny.fluent::Text("R Shiny Developer"),
          #         br(),
          #         tags$a("the way we R", href = "http://dx.doi.org/10.23668/psycharchives.2521", target = "_blank")
          #       ),
          #       delay = 0,
          #       tags$a("Zauad Shahreer Abeer")
          #       
          #     )
          #   )
          # ),
          # bodyText(
          #   tagList(
          #     "PsychTopics is open-source software ",
          #     tags$a("(explore the code)", href = "https://www.google.com", target = "_blank")
          #   )
          # )
          
        )
      ),
      div(
        
      ),
      makeCard(
        size = 12,
        title = tagList(
          div(
            style = "float:right",
            shiny.fluent::TooltipHost(
              delay = 0,
              content = div(
                style = "margin: 13px",
                shiny.fluent::Text(
                  "Throughout PsychTopics, you will find more of these information boxes.",
                  br(),
                  "Hovering over the ", tags$i("info buttons"),
                  #shiny.fluent::Icon(iconName = "Info"),
                  " should open the box."
                )
              ),
              shiny.fluent::IconButton.shinyInput(inputId = ns("help1"), iconProps = list(iconName = "Info", className = "icon-help"), class = "button-help-green")
            )
          ),
          "How To Use PsychTopics"
        ),
        style = "background-color: #c6cf78ff",
        content = tagList(
          
          
          bodyText(
            tags$ol(tags$b(
              tags$li("Use the menu for different topic views."),
              tags$li(
                "Click on the      icons in the top right corner of the boxes for more information."
              ),
              tags$li("Draw conclusions carefully*")
            )),
            br(),
            "*PsychTopics is designed for exploratory purposes.
            Topics are derived from scientific publications ", tags$i("automatically"),
            " using machine learning algorithms.
            Thus, PsychTopics makes no claim to completeness and cannot replace specific search strategies.",
            " For more information, click “Methods” on the left."
            
            
          )
          
        )
      )
    ),
    
    #br(),
    
    div(
      class = "two-cards",
      style = "margin-bottom: 0",
      makeCard(
        size = 12,
        
        title = title_with_help(
          id = ns("help2"),
          title = uiOutput(ns("title_box3")),
          content = tagList(
            shiny.fluent::Text(
              "These are the - ", tags$b("preliminary"), " - most popular topics in the current year.",
              br(),
              br(),
              "Each topic has a numeric id. See ", tags$i("Browse Topics"), " in the menu for more topic details.",
              br(),
              br(),
              "The larger the bar, the more publications address the topic.",
              br(),
              "A publication in counted as addressing a topic, if at least 50% of its contents are related to this topic.",
              br(),
              br(),
              tags$b("Please note: "), " These preliminary topics might change with updates throughout the year,", br(),
              " since publications of the current year may not be recorded yet.", br(),
              " Moreover, journals, books, and reports on specific topics may be published in waves (e.g., quarterly issues)."
            )
            
          )
        ),
          
        content = tagList(
          
          div(
            class = "grid-p1-b3-b4",
            div(
              class = "text",
              style = "margin-top: 11px",
              bodyText(text = "Please note that these topics are preliminary!")
            ),
            div(
              class = "dropdown",
              
              shiny.fluent::Dropdown.shinyInput(
                inputId = ns("dropdown_most_popular1"),
                style = list(textAlign = "center"),
                label = "Show top",
                options = list(
                  list(key = 5, text = "5"),
                  list(key = 10, text = "10"),
                  list(key = 15, text = "15"),
                  list(key = 20, text = "20")
                ),
                value = 5
              ),
            )
          ),
          
          br(),
          echarts4r::echarts4rOutput(ns("plot_box3"), height = 550)
          #highcharter::highchartOutput(ns("plot_box3"), height = 650)
        )
      ),
      
      div(
        
      ),
      
      makeCard(
        size = 12,
        title = title_with_help(
          id = ns("help3"),
          title = "Overall Most Popular Topics in PSYNDEX",
          content = tagList(
            shiny.fluent::Text(
              "These are the most popular topics in PSYNDEX across all years since 1980.",
              br(),
              br(),
              "Each topic has a numeric id. See ", tags$i("Browse Topics"), " in the menu for more details on topics.",
              br(),
              br(),
              "The larger the bar, the more publications address the topic.",
              br(),
              br(),
              "A publication in counted as addressing a topic,", br(),
              " if at least 50% of its contents are related to this topic."
            )
          )
        ),
          
        #   
        #   tagList(
        #   div(
        #     style = "float:right",
        #     shiny.fluent::IconButton.shinyInput(inputId = ns("help3"), iconProps = list(iconName = "Info", className = "icon-help-grey"), class = "button-help-grey")
        #   ),
        #   "Overall Most Popular Topics in PSYNDEX"
        # ),
        content = tagList(
          
          div(
            class = "grid-p1-b3-b4",
            div(
              class = "text"
              #style = "margin-top: 11px",
              #bodyText(text = "Please note that these topics are preliminary!")
            ),
            div(
              class = "dropdown",
              
              shiny.fluent::Dropdown.shinyInput(
                inputId = ns("dropdown_most_popular2"),
                style = list(textAlign = "center"),
                label = "Show top",
                options = list(
                  list(key = 5, text = "5"),
                  list(key = 10, text = "10"),
                  list(key = 15, text = "15"),
                  list(key = 20, text = "20")
                ),
                value = 5
              )
            )
          ),
          br(),
          echarts4r::echarts4rOutput(ns("plot_box4"), height = 550)
          #highcharter::highchartOutput(ns("plot_box4"), height = 650)
          #plotOutput(ns("plot_box4"))
        )
      )
      
    )
  )
}
    
#' start Server Functions
#' 
#' @import echarts4r
#'
#' @noRd 
mod_start_server <- function(id, r){
  moduleServer( id, function(input, output, session){
    ns <- session$ns
    
    output$last_update = renderUI({
      req(r$last_updated)

      glue::glue("Last update (quarterly): {r$last_updated}")
    })
    # 
    # observeEvent(input$dropdown_most_popular1, {
    #   shiny.fluent::updateDropdown.shinyInput(inputId = "dropdown_most_popular2", value = 5)
    # }, once = TRUE)
    
    output$title_box3 = renderUI({
      req(r$current_year)
      #x = 2019
      glue::glue("Popular PSYNDEX Topics in {r$current_year}")
    })
    
    

    output$plot_box3 = echarts4r::renderEcharts4r({
      req(r$n_doc_year, r$topic, r$current_year, input$dropdown_most_popular1)

      # d1 = as.data.frame(as.table(r$n_doc_year)) %>%
      #   dplyr::mutate(year = as.numeric(as.character(Var1)), label = Var2)
      #print(str(d1))
      
      
      d1 = r$n_doc_year
      
      color <- "#953386"
      
      

      top = input$dropdown_most_popular1

      df = d1 %>%

        #dplyr::arrange(-Freq) %>%
        #dplyr::slice_head(n = top) %>%
        #dplyr::mutate(Freq = round(Freq * 100, 2)) %>%
        dplyr::left_join(r$topic, by = c("id" = "ID")) %>% 
        dplyr::filter(year == r$current_year) %>%
        dplyr::arrange(-Freq) %>% 
        dplyr::slice_head(n = top) %>% 
        dplyr::mutate(
          id2 = as.factor(id),
          tooltip = glue::glue("{TopTerms};{Label}"),
        )
      
      
      #print(str(df))
      
      df %>% 
        echarts4r::e_charts(id2) %>% 
        echarts4r::e_bar(Freq, name = "n-docs", bind = tooltip) %>% 
        echarts4r::e_title(text = glue::glue("Popular topics in {r$latest_year}")) %>% 
        echarts4r::e_flip_coords() %>% 
        echarts4r::e_x_axis(name = "essential publications", nameLocation = "center", nameGap = 27) %>% 
        echarts4r::e_y_axis(name = "ID", nameLocation = "center", nameRotate = 0, nameGap = 35, inverse = TRUE) %>% 
        echarts4r::e_tooltip(
          confine = TRUE,
          formatter = htmlwidgets::JS("
            function(params){
              var vals = params.name.split(';');
              return('ID: ' + params.value[1] +
                      '<br/> Label: ' + vals[1] +
                      '<br/> Essential Publications: ' + params.value[0]) + 
                      '<br/> Top Terms: ' + vals[0]
                      }
          ")
        ) %>% 
        echarts4r::e_labels(
          position = "insideLeft",
          fontSize = 15,
          color = "#fff",
          formatter = htmlwidgets::JS("
            function(params){
              return(params.name.split(';')[1])
              }
          ")
        ) %>% 
        echarts4r::e_color(color = color) %>% 
        echarts4r::e_legend(show = FALSE)
      
      
    })
    
    output$plot_box4 = echarts4r::renderEcharts4r({
      req(r$n_doc_year, r$topic, input$dropdown_most_popular2)

      # d1 = as.data.frame(as.table(r$n_doc_year)) %>%
      #   dplyr::mutate(year = as.numeric(as.character(Var1)), label = Var2)
      #print(str(d1))
      
      d1 = r$n_doc_year
      
      color <- "#953386"

      top = input$dropdown_most_popular2
      


      df = r$topic %>%
        #dplyr::filter(year == 2019) %>%
        #dplyr::arrange(-Freq) %>%
        #dplyr::slice_head(n = top) %>%
        #dplyr::mutate(Freq = round(Freq * 100, 2)) %>%
        #dplyr::left_join(r$topic, by = c("id" = "ID")) %>%
        #tibble::glimpse(.) %>% 
        dplyr::arrange(-n_docs) %>% 
        dplyr::slice_head(n = top) %>% 
        #tibble::glimpse(.) %>% 
        dplyr::mutate(
          id2 = as.factor(ID),
          tooltip = glue::glue("{TopTerms};{Label}"),
        )
      
      #print(tail(df))
      
      #r$browse_top_3 = unique(df$id)[1:3]

      #print(str(df))
      
      df %>% 
        echarts4r::e_charts(id2, reorder = FALSE) %>% 
        echarts4r::e_bar(n_docs, name = "n-docs", bind = tooltip) %>% 
        # echarts4r::e_title(text = "Popular topics overall") %>% 
        echarts4r::e_flip_coords() %>% 
        echarts4r::e_x_axis(name = "essential publications", nameLocation = "center", nameGap = 27) %>% 
        echarts4r::e_y_axis(inverse = TRUE) %>% 
        echarts4r::e_tooltip(
          confine = TRUE,
          formatter = htmlwidgets::JS("
            function(params){
              var vals = params.name.split(';');
              return('ID: ' + params.value[1] +
                      '<br/> Label: ' + vals[1] +
                      '<br/> Essential Publications: ' + params.value[0]) + 
                      '<br/> Top Terms: ' + vals[0]
                      }
          ")
        ) %>% 
        echarts4r::e_labels(
          position = "insideLeft",
          fontSize = 15,
          color = "#fff",
          formatter = htmlwidgets::JS("
            function(params){
              return(params.name.split(';')[1])
              }
          ")
        ) %>% 
        echarts4r::e_color(color = color) %>% 
        echarts4r::e_legend(show = FALSE)
      

      # hch2 = df %>%
      #   highcharter::hchart(
      #     "bar",
      #     highcharter::hcaes(x = "id2", y = "Freq", topic = "Thema", topicSplit = "topic_split", id = "id", year = "year"),
      #     name = "Prevalence",
      #     #colorByPoint = TRUE,
      #     borderColor = "black",
      #     dataLabels = list(
      #       enabled = TRUE,
      #       align = "right",
      #       x = -33,
      #       color = "#fff",
      #       style = list(fontSize = 13),
      #       formatter = JS('
      #       function() {
      #         return this.point.topicSplit.slice(0, 2);
      #       }'
      #       )
      #     )
      #   ) %>%
      #   highcharter::hc_chart(
      #     plotBorderColor = "#aaa",
      #     plotBorderWidth = 2
      #   ) %>%
      #   highcharter::hc_colors(color) %>%
      #   highcharter::hc_xAxis(title = list(text = ""), labels = list(style = list(fontSize = "17px")), gridLineColor = 'transparent') %>%
      #   highcharter::hc_yAxis(title = list(text = "Prevalence"), gridLineColor = 'transparent') %>%
      #   #highcharter::hc_add_theme(highcharter::hc_theme_google()) %>%
      #   highcharter::hc_title(text = glue::glue("Popular topics overall"), style = list(fontSize = "21px")) %>%
      #   highcharter::hc_tooltip(
      #     pointFormat = "ID: {point.id} <br/> Year: {point.year} <br/> Prevalence: {point.y} <br/> Topic: {point.topic}",
      #     headerFormat = "",
      #     style = list(fontSize = "15px", opacity = 1),
      #     borderWidth = 2,
      #     backgroundColor = "#fff",
      #     hideDelay = 333
      #   ) %>%
      #   highcharter::hc_size(height = height)



    })
    
    # output$plot_box4 = renderPlot({
    #   shinipsum::random_ggplot()
    # })
    # 
    
  })
}
    
## To be copied in the UI
# mod_start_ui("start_ui_1")
    
## To be copied in the server
# mod_start_server("start_ui_1")
shahreyar-abeer/leibniz-psychology_psychtopics documentation built on March 18, 2022, 12:09 a.m.