shiny.Rmd

---
output: html_document
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(
  echo = FALSE,
  message = FALSE,
  warning = FALSE)
```




```{r load packages, echo=FALSE, message=FALSE, warning=FALSE}
library(pacman)

pacman::p_load(shiny,
               ggplot2,
               shinythemes,
               shinyWidgets,
               shinydashboard,
               quanteda,
               seededlda,
               dplyr,
               tidyr
               )
```

```{r}
load(file = "outputs.RData")

slda1_topics <- slda1_topics <- terms(slda1, 50) %>% as.data.frame()

topic_names <- colnames(slda1_topics) %>% sort()

terms_lists <- slda1_topics %>%
  mutate(Rank = row_number()) %>% pivot_longer(col=-Rank, names_to = "Topic", 
                              values_to = "Terms")

topic_proportions_long <- topic_proportions %>% 
  mutate(ProjectReference = row.names(.)) %>% pivot_longer(col=-ProjectReference,
                                                          names_to = "Topic",
                                                          values_to = "Proportion")


# UI

header <-  dashboardHeader(title = "AHRC Awards Topic Browser",
                           titleWidth = "30%",
                           tags$li(class = "dropdown", 
                                  actionButton("about_btn", "About",
                                               class = "btn btn-secondary",
                                               style = "margin-top: 5px; margin-right: 5px;")
                          )
                          )

sidebar <- dashboardSidebar(
  radioButtons(inputId = "topic", label = "Select Topic",
                   choices = topic_names, selected = NULL)
  
)
  
body <- dashboardBody(
  fluidRow(
        box(
          title = "Topic Proportions by Value of the Award*",
          width = 6,
          plotOutput("topic_per_band"),
          tags$h5("*Award values have been adjusted for inflation using 2023 CPI base year.")
        ),
        box(
          title = "Topic Proportions by Start Year",
          width = 6,
          plotOutput("selected_plot"),
          checkboxInput("checkbox", "Weighted by value of the award")
        )
      ),  
      
      fluidRow(
        column(
          width = 3,
          tags$h4("Most Frequent Words"),
          tableOutput("terms")
        ),
        column(
          width = 8,
          tags$h4("Most Relevant Projects"),
          uiOutput("textboxes")
          )
        
      )
    )  
  

    
ui <- dashboardPage(header, sidebar, body)




# Server
server <- function(input, output) {
  
  observeEvent(input$about_btn, {
    showModal(
      modalDialog(
        title = "About this Data Project",
      HTML("
        <p>The AHRC Awards Topic Browser is built upon the findings of topic analysis conducted on research grant applications that have been awarded funding by the Arts and Humanities Research Council (AHRC) between 2013 and 2023. The analysis used a semi-supervised topic modelling approach (seeded LDA) to identify 32 prominent topics within the corpus. For a detailed description of the methodology and model, please refer to the project's <a href=https://github.com/kuslitsanna/AHRC_awards>GitHub repository</a>.</p>
        
        <h4>Data Source</h4>
        <p>The data analysed here is sourced from publicly available information provided by the UK Research and Innovation (UKRI) available at <a href=https://gtr.ukri.org/>Gateway to Research (GtR)</a>. The analysis focused on research grant applications, excluding studentships, fellowships, and training grants awarded by the AHRC.</p>
        
        <h4>Credits</h4>
        <p>
        - Author: Anna Kuslits<br>
        - Acknowledgments: The analysis was performed using the <a href=http://quanteda.io/>quanteda</a> and <a href=https://koheiw.github.io/seededlda/>seededLDA</a> R packages, developed by Kenneth Benoit and Kohei Watanabe.
        </p>
      "),
        footer = modalButton("Close")
      )
    )
  })
  
  # Define a reactive expression for filtered_per_band
  filtered_per_band <- reactive({
    topic_proportion_per_band %>% filter(Topic == input$topic)
  })
  
  # Define a reactive expression for filtered_per_year
  filtered_per_year <- reactive({
    topic_proportion_per_year %>% filter(Topic == input$topic)
  })
  # Reactive for filtered_terms
  filtered_terms <- reactive({
    terms_lists %>% filter(Topic==input$topic) %>% select(-Topic)
  })
  
  # Define a reactive expression for filtered_abstracts
  filtered_abstracts <- reactive({
    topic_proportions_long %>% filter(Topic == input$topic) %>%
      arrange(desc(Proportion)) %>%
      inner_join(master_df, by = "ProjectReference") %>%
      filter(Proportion >= 0.1) %>% mutate(Proportion=round(Proportion, 2))
  })
  
  # Render the topic_per_band plot
  output$topic_per_band <- renderPlot({
    ggplot(filtered_per_band(), aes(x = AwardPoundsBand, y = Proportion)) +
      geom_bar(stat = "identity", fill = "lightblue") +
      labs(
        #title = "Topic Proportions by Value of the Award",
        x = "Value of Award (thousand pounds)",
        y = "Topic Proportion"
      ) +
      theme_minimal()
  })
  
  # Render the selected plot based on the switch value
  selected_plot <- reactive({
    if (input$checkbox) {
      ggplot(filtered_per_year(), aes(x = Year, y = Proportion)) +
        geom_bar(stat = "identity", fill = "lightblue") +
        labs(
          x = "Year",
          y = "Topic Proportion"
        ) +
        theme_minimal()
    } else {
      ggplot(filtered_per_year(), aes(x = Year, y = WeightedProportion)) +
        geom_bar(stat = "identity", fill = "lightblue") +
        labs(
          x = "Year",
          y = "Topic Proportion"
        ) +
        theme_minimal()
    }
  })
  
  # Render the selected plot
  output$selected_plot <- renderPlot({
    selected_plot()
  })
  
  # Render the terms table
  output$terms <- renderTable(
    filtered_terms(),
    colnames = FALSE
  )
  
  # Render the text boxes
  output$textboxes <- renderUI({
    text_boxes <- lapply(1:nrow(filtered_abstracts()), function(i) {
      text <- paste(
        "<b>", "Topic relevance:", "</b>"," ", filtered_abstracts()$Proportion[i]*100, "%", "<br>",
        "<b>","Title:","</b>"," ", filtered_abstracts()$Title[i],"<br>",
        "<b>","Start date:","</b>"," ", filtered_abstracts()$StartDate[i],"<br>",
        "<b>","End date:","</b>"," ", filtered_abstracts()$EndDate[i],"<br>",
        "<b>","Lead organisation:","</b>"," ", filtered_abstracts()$LeadROName[i],"<br>",
        "<b>","PI:","</b>"," ", filtered_abstracts()$PI[i],"<br>",
        "<b>", "Award:","</b>"," £", filtered_abstracts()$AwardPounds[i],"<br>",
        "<a href=", filtered_abstracts()$url[i],">Open in browser</a>", "<br>",
        "<b>","Abstract:","</b>","<br>", filtered_abstracts()$abstract[i],"<br>",
        "<b>","Impact:","</b>","<br>", filtered_abstracts()$impact[i],
        sep=""
      )
       div(
        style = "width: 100%; height: 200px; overflow-y: scroll; border: 1px solid #ccc; padding: 10px; margin-bottom: 10px;",
        HTML(text)
      )
    })
    div(text_boxes)
  })
}




# Run the Shiny app
shinyApp(ui, server)

```


```