Make shiny frequency curves run as a proper R demo
Change-Id: I75dbfd97c98cd586f012e4d6409ed71d7745a201
diff --git a/demo/00Index b/demo/00Index
index f2e526a..4a9a3c8 100644
--- a/demo/00Index
+++ b/demo/00Index
@@ -5,4 +5,5 @@
regional Map plot regional frequencies of query expression
mosaicplot Visualize frequencies of alternative query terms in relation to other variables
highcharter-example Visualize frqequencies of optionally alternative terms over time with interactive HTML and JavaScript elements using the package highcharter as wrapper for Highcharts
+shiny-frequency-curves Web application that plots frequency curves with highcharts and shiny
writtenVsSpoken Compare frequencies in written vs. spoken corpora
diff --git a/demo/shiny-apps/frequency_curves/server.R b/demo/shiny-apps/frequency_curves/server.R
deleted file mode 100644
index 8de9272..0000000
--- a/demo/shiny-apps/frequency_curves/server.R
+++ /dev/null
@@ -1,92 +0,0 @@
-rsr <- new("KorAPConnection", verbose = TRUE)
-vc <- "(textType = /Zeit.*/ | textTypeRef=Plenarprotokoll) & availability!=QAO-NC-LOC:ids & creationDate in"
-years <- c(2005:2020)
-from <- 2005
-to <- 2020
-query <- "Aluhut"
-logfile <- file("frequency_curves.log", open = "a")
-
-# override log.info in RKorAPClient to get some progress info
-log.info <- function(v, ...) {
- original = paste0(...)
- detail <- if (str_detect(original, "Searching.*in ([0-9]{4})")) {
- str_replace(original, ".*in ([0-9]{4}).*", "Suche in \\1")
- } else if (str_detect(original, "Getting size.*in ([0-9]{4})")) {
- str_replace(original, ".*in ([0-9]{4}).*", "Korpusgröße \\1")
- } else {
- "Randverteilung"
- }
- incProgress(1 / (2 * length(query) * length(years) + length(years)), detail = detail)
- cat(original, file = logfile)
- flush(logfile)
-}
-
-assignInNamespace("log.info", log.info, "RKorAPClient")
-
-plotHighchart <- function(query = c("Tolpatsch", "Tollpatsch"),
- vc = "(textType = /Zeit.*/ | textTypeRef=Plenarprotokoll) & availability!=QAO-NC-LOC:ids & creationDate in"
-,
- years = years,
- as.alternatives = F,
- conf.level = 0.95,
- kco = rsr) {
- hc <- frequencyQuery(kco,
- query,
- paste(vc, years),
- as.alternatives = as.alternatives) %>%
- hc_freq_by_year_ci(as.alternatives, smooth = T) %>%
- hc_yAxis(title = list(text = "Instanzen pro Million Wörter")) %>%
- hc_add_theme(hc_theme_ids_light()) %>%
- hc_caption(text = paste(
- "Frequenzverläufe (mit 95%-Konfidenzbändern) im",
- "<a href='http://www.dereko.de'>Deutschen Referenzkorpus DeReKo</a>",
- "(virtuelles Korpus: <a href='https://korap.ids-mannheim.de/doc/corpus'>DeReKo-KorAP-2021-I</a>",
- "eingegrenzt auf Zeitungen, Zeitschriften und Plenarprotokolle).",
- "Klicken sie die einzelnen Datenpunkte an, um entsprechende KorAP-Suchen zu starten."
- ))
-
- hc
-}
-
-generateHighchart <- function(wordParam, from=2005, to=2020) {
- years <<- c(from:to)
- if (wordParam != "") {
- query <<- str_split(wordParam, " *, *", simplify = TRUE)
- withProgress(message = 'Berechnung läuft: ', value = 0, {
- hc <- plotHighchart(query, vc , years)
- })
- hc
- }
-}
-
-
-function(input, output, session) {
- observe({
- queryParams <- parseQueryString(session$clientData$url_search)
- if (!is.null(queryParams[['from']])) {
- from <- queryParams[['from']]
- updateSliderInput(session, "from", value = from)
- } else {
- from <- 2005
- }
- if (!is.null(queryParams[['to']])) {
- to <- queryParams[['to']]
- updateSliderInput(session, "to", value = to)
- } else {
- to <- 2020
- }
- if (!is.null(queryParams[['q']])) {
- paramWord <- queryParams[['q']]
- updateTextInput(session, "q", value = paramWord)
- output$hcontainer <-
- renderHighchart(generateHighchart(paramWord, from, to))
- }
- })
-
- observeEvent(input$goButton,
- {
- output$hcontainer <-
- renderHighchart(generateHighchart(isolate(input$q), isolate(input$from), isolate(input$to)))
- })
-
-}
diff --git a/demo/shiny-apps/frequency_curves/theme-ids-dark.R b/demo/shiny-apps/frequency_curves/theme-ids-dark.R
deleted file mode 100644
index 1ff03d2..0000000
--- a/demo/shiny-apps/frequency_curves/theme-ids-dark.R
+++ /dev/null
@@ -1,228 +0,0 @@
-#' Dark IDS theme for highcharts
-#'
-#' @param ... Named argument to modify the theme
-#'
-#' @examples
-#'
-#' highcharts_demo() %>%
-#' hc_add_theme(hc_theme_ids_dark())
-#' @export
-hc_theme_ids_dark <- function(...) {
- theme <-
- list(
- colors = c('#EB7C31', "#1F77B4", "#2CA02C", "#D62728", "#9467BD", "#8C564B", "#E377C2", "#7F7F7F", "#BCBD22", "#17BECF", "#AEC7E8", "#FFBB78", "#98DF8A", "#FF9896", "#C5B0D5", "#C49C94", "#F7B6D2", "#C7C7C7", "#DBDB8D", "#9EDAE5"),
-# colors = c(
-# '#EB7C31', "#9BAD0B", "#2b908f", "#90ee7e", "#f45b5b", "#7798BF",
-# "#aaeeee", "#ff0066", "#eeaaee", "#55BF3B"
-# ),
- chart = list(
- backgroundColor = list(
- linearGradient = list(x1 = 0, y1 = 1, x2 = 1, y2 = 0),
- stops = list(
- list(0, "#2a2a2b"),
- list(1, "#3e3e3e")
- )
- ),
- style = list(
- fontFamily = "Roboto Condensed",
- fontFamily = '"Univers LT Std 47 Cn Lt", "Roboto Condensed", "Unica One", sans-serif-condensed, sans',
- fontSize = "12pt"
- ),
- plotBorderColor = "#606063"
- ),
- title = list(
- style = list(
- color = "#E0E0E3",
- fontSize = "20px"
- )
- ),
- subtitle = list(
- style = list(
- color = "#E0E0E3",
- fontSize = "14pt"
- )
- ),
- xAxis = list(
- gridLineColor = "#707073",
- labels = list(
- style = list(
- color = "#E0E0E3",
- fontSize = "12pt"
- )
- ),
- lineColor = "#707073",
- minorGridLineColor = "#505053",
- tickColor = "#707073",
- title = list(
- style = list(
- color = "#A0A0A3",
- fontSize = "12pt"
- )
- )
- ),
- yAxis = list(
- gridLineColor = "#707073",
- labels = list(
- style = list(
- color = "#E0E0E3",
- fontSize = "12pt"
- )
- ),
- lineColor = "#707073",
- minorGridLineColor = "#505053",
- tickColor = "#707073",
- tickWidth = 1,
- title = list(
- style = list(
- color = "#A0A0A3",
- fontSize = "12pt"
- )
- )
- ),
- tooltip = list(
- backgroundColor = "rgba(0, 0, 0, 0.85)",
- style = list(
- color = "#E0E0E0",
- fontSize = "11pt"
- )
- ),
- plotOptions = list(
- series = list(
- dataLabels = list(
- color = "#B0B0B3",
- fontSize = "13pt"
- ),
- marker = list(
- lineColor = "#333"
- )
- ),
- boxplot = list(
- fillColor = "#505053"
- ),
- candlestick = list(
- lineColor = "white"
- ),
- errorbar = list(
- color = "white"
- )
- ),
- legend = list(
- itemStyle = list(
- color = "#E0E0E3"
- ),
- itemHoverStyle = list(
- color = "#FFF"
- ),
- itemHiddenStyle = list(
- color = "#606063"
- )
- ),
- credits = list(
- style = list(
- color = "#666"
- )
- ),
- labels = list(
- style = list(
- color = "#707073"
- )
- ),
-
- drilldown = list(
- activeAxisLabelStyle = list(
- color = "#F0F0F3"
- ),
- activeDataLabelStyle = list(
- color = "#F0F0F3"
- )
- ),
-
- navigation = list(
- buttonOptions = list(
- symbolStroke = "#DDDDDD",
- theme = list(
- fill = "#505053"
- )
- )
- ),
-
- rangeSelector = list(
- buttonTheme = list(
- fill = "#505053",
- stroke = "#000000",
- style = list(
- color = "#CCC"
- ),
- states = list(
- hover = list(
- fill = "#707073",
- stroke = "#000000",
- style = list(
- color = "white"
- )
- ),
- select = list(
- fill = "#000003",
- stroke = "#000000",
- style = list(
- color = "white"
- )
- )
- )
- ),
- inputBoxBorderColor = "#505053",
- inputStyle = list(
- backgroundColor = "#333",
- color = "silver"
- ),
- labelStyle = list(
- color = "silver"
- )
- ),
-
- navigator = list(
- handles = list(
- backgroundColor = "#666",
- borderColor = "#AAA"
- ),
- outlineColor = "#CCC",
- maskFill = "rgba(255,255,255,0.1)",
- series = list(
- color = "#7798BF",
- lineColor = "#A6C7ED"
- ),
- xAxis = list(
- gridLineColor = "#505053"
- )
- ),
-
- scrollbar = list(
- barBackgroundColor = "#808083",
- barBorderColor = "#808083",
- buttonArrowColor = "#CCC",
- buttonBackgroundColor = "#606063",
- buttonBorderColor = "#606063",
- rifleColor = "#FFF",
- trackBackgroundColor = "#404043",
- trackBorderColor = "#404043"
- ),
-
- legendBackgroundColor = "rgba(0, 0, 0, 0)",
- background2 = "#233238",
- dataLabelsColor = "#233238",
- textColor = "#34495e",
- maskColor = "rgba(255,255,255,0.3)",
- contrastTextColor = "#F0F0F3"
- )
-
- theme <- structure(theme, class = "hc_theme")
-
- if (length(list(...)) > 0) {
- theme <- hc_theme_merge(
- theme,
- hc_theme(...)
- )
- }
-
- theme
-}
diff --git a/demo/shiny-apps/frequency_curves/ui.R b/demo/shiny-apps/frequency_curves/ui.R
deleted file mode 100644
index 82fe9c2..0000000
--- a/demo/shiny-apps/frequency_curves/ui.R
+++ /dev/null
@@ -1,44 +0,0 @@
-library(shiny)
-library(highcharter)
-library(RKorAPClient)
-library(utils)
-library(stringr)
-library(idsThemeR)
-#source("theme-ids-dark.R")
-options(shiny.autoreload = TRUE)
-
-shinyUI(
- fluidPage(
- title = "Wortfrequenzverläufe in DeReKo",
- tags$link(rel = "stylesheet", type = "text/css", href = "frequency_curves.css"),
- tags$head(tags$script(src = "enter-button.js")),
- fluidPage(
- titlePanel("Wortfrequenzverläufe im Deutschen Referenzkorpus"),
- fluidRow(
- height = 2,
- class = "panel",
- column(width = 4, textInput("q", label = "Wortform oder Suchausdruck",
- placeholder = "Mit Komma getrennte Liste")),
- column(
- width = 1,
- offset = 0,
- style = "margin-top: 25px;",
- actionButton("goButton", "Mit KorAP suchen", icon("search"), class = "btn btn-primary")
- ),
- column(width = 2, offset=3,
- sliderInput("from", "Von", sep = "",
- min = 1949, max = 2020,
- value = 2005)
- ),
- column(width = 2, offset=0,
- sliderInput("to", "Bis", sep = "",
- min = 1949, max = 2020,
- value = 2020)
- )
-
- ),
- fluidRow(height = 10,
- highchartOutput("hcontainer", height = "600px"))
- )
- )
-)
diff --git a/demo/shiny-apps/frequency_curves/www/enter-button.js b/demo/shiny-apps/frequency_curves/www/enter-button.js
deleted file mode 100644
index d5138fa..0000000
--- a/demo/shiny-apps/frequency_curves/www/enter-button.js
+++ /dev/null
@@ -1,5 +0,0 @@
-$(document).keyup(function(event) {
- if ($("#q").is(":focus") && (event.key == "Enter")) {
- $("#goButton").click();
- }
-});
diff --git a/demo/shiny-apps/frequency_curves/www/frequency_curves.css b/demo/shiny-apps/frequency_curves/www/frequency_curves.css
deleted file mode 100644
index 1a6e82c..0000000
--- a/demo/shiny-apps/frequency_curves/www/frequency_curves.css
+++ /dev/null
@@ -1,34 +0,0 @@
-@import url('https://fonts.googleapis.com/css2?family=Fira+Sans+Condensed:wght@300;400;700;800&family=Fira+Sans:wght@300;400;700&display=swap');
-
-body, input {
- font-family: 'Fira Sans', sans-serif;
- font-size: 11pt;
-}
-
-.btn-primary {
- background-color: #9BAD09;
- border-color: #626F06
-
-}
-
-.btn-primary:hover {
- background-color: #626F06
-}
-
-.shiny-notification {
- position: fixed;
- top: 50%;
- left: 50%;
- width: 250px;
- margin-top: -100px;
- margin-left: -125px;
-}
-
-.highcharts-anchor {
- fill: blue;
- color: blue;
-}
-
-.progress-bar {
- background-color: #9BAD09
-}
diff --git a/demo/shiny-frequency-curves.R b/demo/shiny-frequency-curves.R
new file mode 100644
index 0000000..ea8b43d
--- /dev/null
+++ b/demo/shiny-frequency-curves.R
@@ -0,0 +1 @@
+shiny::runApp(system.file("shiny-apps", "frequency_curves", package="RKorAPClient"))