shinyCorpusComposition.R

library(shiny)
library(shinythemes)
library(highcharter)
library(RKorAPClient)
library(tidyverse)
library(idsThemeR)

ui <- fluidPage(

  theme = shinytheme("paper"),
  fluidRow(
    column(width = 6, highchartOutput("country")),
    column(width = 6, highchartOutput("domain")),
    column(width = 6, highchartOutput("decade")),
    column(width = 6, highchartOutput("texttype")),
  ) %>% tagAppendAttributes(class="hc-link-legend")

)

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

  observe({
    query <- parseQueryString(session$clientData$url_search)
    if (!is.null(query[['cq']])) {
      message(query[['cq']])
    }
  })

  sharelegend = JS('function(event){
    var vis = this.visible;
    var conall = $(this.chart.container).parents(".hc-link-legend").find("div.highchart");
    for(var i = 0; i < conall.length; i++){
      var hc = $(conall[i]).highcharts();
      var series = hc.series[this.index];
      if(series){
        if(vis){
          series.hide();
        } else{
          series.show();
        }
      }
    }
    return false;
  }')

  corpus=c("", "referTo ratskorpus-2023-1 & ", "referTo drukola.20180909.1b_words & ")
  kco <- new("KorAPConnection", verbose=TRUE)
  highchart <- function(...) {
    highcharter::highchart() %>%
      hc_add_theme(hc_theme_ids_light()) %>%
      hc_add_onclick_korap_search() %>%
      hc_plotOptions(series = list(events = list(legendItemClick = sharelegend)))
  }

  prettifyCorpusNames <- function(df) {
    rownames(df) = NULL
    df %>%
      mutate(corpus = corpus %>% str_replace("referTo *", "") %>% str_replace(" *& *$", "") |> str_replace("^ *$", "DeReKo-KorAP"))

  }


  output$country <- renderHighchart({

    countries <- c("DE", "AT", "CH", "IT", "BE", "LU") %>% sort()

    df <- expand_grid(corpus=corpus, country=countries) %>%
      mutate(vc = sprintf("%spubPlaceKey=%s", corpus, country)) %>%
      prettifyCorpusNames() %>%
      bind_cols(corpusStats(kco, .$vc) %>% select(-vc))

    highchart() %>%
      hc_add_series(type = "column", data = df, hcaes(x=country, y=tokens, group=corpus)) %>%
      hc_xAxis(categories = df$country) %>%
      hc_yAxis(type = "logarithmic") %>%
      hc_legend(enabled=T) %>%
      hc_title(text="Land")

  })

  output$domain <- renderHighchart({
    topics <-
      c(
        "freizeit-unterhaltung",
        "gesundheit-ernaehrung",
        "kultur",
        "politik",
        "sport",
        "staat-gesellschaft",
        "technik-industrie",
        "wissenschaft",
        "wirtschaft-finanzen",
        "natur-umwelt",
        "fiktion"
      )

    df <- expand_grid(corpus=corpus, domain=topics) %>%
      mutate(vc = sprintf("%stextClass=%s", corpus, domain)) %>%
      bind_cols(corpusStats(kco, .$vc)%>% select(-vc)) %>%
      prettifyCorpusNames()

    highchart() %>%
      hc_add_series(type = "bar", data = df, hcaes(domain, tokens, group=corpus)) %>%
      hc_xAxis(categories = df$domain %>% str_to_title(locale = "en") )%>%
      hc_yAxis(type = "logarithmic") %>%
      hc_legend(enabled=F) %>%
      hc_title(text="Thema")

  })

  output$decade <- renderHighchart({
    decades <-
      c(1951, 1961, 1971, 1981, 1991, 2001, 2011, 2021)
    decade_labels <- function(start_year) {
      sprintf("%d-%d", start_year, start_year+9)
    }

    df <- expand_grid(corpus=corpus, decade=decades) %>%
      mutate(vc = sprintf("%spubDate since %d & pubDate until %d", corpus, decade, decade+9)) %>%
      bind_cols(corpusStats(kco, .$vc) %>% select(-vc)) %>%
      mutate(decade = decade_labels(decade)) %>%
      prettifyCorpusNames()

    highchart() %>%
      hc_add_series(type = "bar", data = df, hcaes(decade, tokens, group=corpus)) %>%
      hc_xAxis(categories = df$decade )%>%
      hc_yAxis(type = "logarithmic") %>%
      hc_legend(enabled=F) %>%
      hc_title(text="Dekade")
  })

  output$texttype <- renderHighchart({
    texttypes <-
      c("/Zeitung.*/", "/(Zeitschrift|Magazin).*/", "/Agenturmeldung.*/", "/Enzyklopädie.*/", "/.*Diskussion.*/", "/Roman.*/", "/Newsgroup.*/", "/Tagebuch.*/", "/Sachbuch.*/")

    df <- expand_grid(corpus=corpus, texttype=texttypes) %>%
      mutate(vc = sprintf("%stextType=%s", corpus, texttype)) %>%
      bind_cols(corpusStats(kco, .$vc) %>% select(-vc)) %>%
      prettifyCorpusNames()

    hc <- highchart() %>%
      hc_add_series(type = "bar", data = df, hcaes(texttype, tokens, group=corpus)) %>%
      hc_xAxis(categories = df$texttype %>% str_replace_all("[/.*)()]", "") %>% str_replace_all("\\|", "/")) %>%
      hc_yAxis(type = "logarithmic") %>%
      hc_legend(enabled=F) %>%
      hc_title(text="Texttyp")
    hc
  })

}

shinyApp(ui, server)