Marc Kupietz | 23daf5b | 2019-11-27 10:28:07 +0100 | [diff] [blame] | 1 | library(RKorAPClient) |
| 2 | library(rCharts) |
| 3 | |
| 4 | plotHighchart <- function(query = "Schlumpf", |
| 5 | years = c(2000:2010), |
| 6 | as.alternatives = length(query) > 1, |
| 7 | vc = "textType = /Zeit.*/ & availability!=QAO-NC-LOC:ids & pubDate in", |
| 8 | kco = new("KorAPConnection", verbose=T) ) { |
| 9 | palette <- c("#1f77b4", "#ff7f0e", "#2ca02c", "#d62728", "#9467bd", "#8c564b", "#e377c2", "#7f7f7f", "#bcbd22", "#17becf") |
| 10 | h1 <- Highcharts$new() |
| 11 | df <- |
| 12 | frequencyQuery(kco, query, paste(vc, years), as.alternatives=as.alternatives) %>% |
| 13 | { if(! as.alternatives) ipm(.) else percent(.) } %>% |
| 14 | mutate(year=as.numeric(queryStringToLabel(vc))) |
| 15 | |
| 16 | ylabel = if(as.alternatives) "%" else "ipm" |
| 17 | for(q in query) { |
| 18 | dat <- df[df$query==q,] |
| 19 | h1$series( |
| 20 | marker = list(radius = 2), |
| 21 | name = q, |
| 22 | data = toJSONArray(data.frame(x=dat$year, |
| 23 | y = if (as.alternatives) dat$f else dat$ipm, |
| 24 | percentage = dat$f , |
| 25 | count = dat$totalResults, |
| 26 | click=dat$webUIRequestUrl), json = F), |
| 27 | type = 'line', |
| 28 | color = palette[1+length(h1$params$series)/2], |
| 29 | zIndex = 1 |
| 30 | ) |
| 31 | h1$series( |
| 32 | name = "ci", |
| 33 | data = toJSONArray2(dat[,c('year', 'conf.low', 'conf.high')], names = F, json = F), |
| 34 | type = 'arearange', |
| 35 | fillOpacity = 0.3, |
| 36 | lineWidth = 0, |
| 37 | marker = list(enabled = F), |
| 38 | enableMouseTracking = F, |
| 39 | linkedTo= ':previous', |
| 40 | color = palette[1+(length(h1$params$series)-1)/2], |
| 41 | zIndex = 0 |
| 42 | ) |
| 43 | } |
| 44 | h1$plotOptions(line = list(cursor = 'pointer', point = list( |
| 45 | events = list(click = "#! function() { window.open(this.click, 'korap'); } !#") |
| 46 | ))) |
| 47 | h1$set( |
| 48 | credits = list(text="KorAP R Client Pakckage", href="//github.com/KorAP/RKorAPClient/"), |
| 49 | zoomType = "Y", |
| 50 | # xAxis = list(title = list(text="year")), |
| 51 | yAxis = if (as.alternatives) |
| 52 | list(ceiling=100, floor=0, labels = list(format="{value}\U2009%")) |
| 53 | else |
| 54 | list(title = list(text=ylabel), floor=0), |
| 55 | tooltip = list( |
| 56 | formatter = paste0("#! function (tooltip) { |
| 57 | var str = tooltip.defaultFormatter.call(this, tooltip); |
| 58 | if(Array.isArray(str)) { |
| 59 | str = str.join(''); |
| 60 | } |
| 61 | for (var i = 0; i < this.points.length; i++) { |
| 62 | str = str.replace(/([0-9.,]+.?)", ylabel, "/, this.points[i].point.count+' ($1@)'); |
| 63 | } |
| 64 | return str.replace(/@/g, '", ylabel, "') |
| 65 | } !#"), |
| 66 | crosshairs = T, |
| 67 | valueDecimals = 2, |
| 68 | shared = T, |
| 69 | valueSuffix = paste0('\U2009', ylabel) |
| 70 | ) |
| 71 | ) |
| 72 | print(h1) |
| 73 | h1 |
| 74 | } |
| 75 | |
| 76 | saveHPlot <- function(h, fname, local = F) { |
| 77 | capture.output(h$show('inline', include_assets = TRUE, cdn = TRUE)) %>% |
| 78 | paste(collapse = '\n') %>% |
| 79 | { if (local) gsub("=//", "=https://", .) else . } %>% |
| 80 | cat(file=fname) |
| 81 | } |
| 82 | |
| 83 | #h1 <-plotHighchart(c("macht []{0,3} Sinn", "ergibt []{0,3} Sinn"), c(1980:2018)) |
| 84 | h1 <- plotHighchart(c("Leser | Lesern | Lesers", 'Leserin | Leserinnen', 'LeserIn | LeserInnen', '"Leser[_\\*]in.*"'), c(1985:2018)) |
| 85 | #plotHighchart(c("Tollpatsch", "Tolpatsch"), c(1991:2018)) |
| 86 | |