Use TRUE and FALSE instead of T and F
Change-Id: I4f419313d56a9b58a96879ff6df7c9f2d873dfb4
diff --git a/R/highcharter-helper.R b/R/highcharter-helper.R
index c9c9ac1..76ebdc7 100644
--- a/R/highcharter-helper.R
+++ b/R/highcharter-helper.R
@@ -33,25 +33,25 @@
#' hc_freq_by_year_ci()
#' }
#'
-hc_freq_by_year_ci <- function(df, as.alternatives = F, ylabel = if(as.alternatives) "%" else "ipm") {
+hc_freq_by_year_ci <- function(df, as.alternatives = FALSE, ylabel = if(as.alternatives) "%" else "ipm") {
title <- ""
df <- df %>%
{ if(! as.alternatives) ipm(.) else RKorAPClient::percent(.) }
if (!"year" %in% colnames(df)) {
- df <- df %>% mutate(year = as.integer(queryStringToLabel(df$vc, pubDateOnly = T)))
+ df <- df %>% mutate(year = as.integer(queryStringToLabel(df$vc, pubDateOnly = TRUE)))
}
if (!"condition" %in% colnames(df)) {
if (length(base::unique(df$query)) > 1) {
df <- df %>% mutate(condition = query)
- if(length(base::unique(queryStringToLabel(df$vc, excludePubDate = T ))) > 1) {
+ if(length(base::unique(queryStringToLabel(df$vc, excludePubDate = TRUE ))) > 1) {
df <- df %>% mutate(condition = paste(condition, " & ",
- queryStringToLabel(vc, excludePubDate = T )))
+ queryStringToLabel(vc, excludePubDate = TRUE )))
}
} else {
title <- base::unique(df$query)
- if(length(base::unique(queryStringToLabel(df$vc, excludePubDate = T ))) > 1) {
- df <- df %>% mutate(condition = queryStringToLabel(vc, excludePubDate = T ))
+ if(length(base::unique(queryStringToLabel(df$vc, excludePubDate = TRUE ))) > 1) {
+ df <- df %>% mutate(condition = queryStringToLabel(vc, excludePubDate = TRUE ))
}
}
}
@@ -66,17 +66,17 @@
floor = 0,
labels = if(as.alternatives) list(format = paste0("{value}\U2009", ylabel)) else NULL
) %>%
- hc_xAxis(allowDecimals=F) %>%
+ hc_xAxis(allowDecimals=FALSE) %>%
hc_add_theme(hc_theme_google(colors=palette)) %>%
hc_plotOptions(
- series = list(enabled = T),
+ series = list(enabled = TRUE),
line = list(cursor = 'pointer', point = list(events = list(
click = JS("function() { window.open(this.click, 'korap'); }")
)))) %>%
- hc_credits(enabled = T,
+ hc_credits(enabled = TRUE,
text = "KorAP R Client Pakckage",
href = "//github.com/KorAP/RKorAPClient/") %>%
- hc_exporting(enabled = T) %>%
+ hc_exporting(enabled = TRUE) %>%
hc_tooltip(
formatter = JS(paste0("function (tooltip) {
var str = tooltip.defaultFormatter.call(this, tooltip);
@@ -88,9 +88,9 @@
}
return str.replace(/@/g, '", ylabel, "')
} ")),
- crosshairs = T,
+ crosshairs = TRUE,
valueDecimals = 2,
- shared = T,
+ shared = TRUE,
valueSuffix = paste0('\U2009', ylabel)
) %>%
hc_add_series_korap_frequencies(df, as.alternatives)
@@ -99,7 +99,7 @@
## Mute notes: "no visible binding for global variable:"
globalVariables(c("value", "query", "condition", "vc"))
-hc_add_series_korap_frequencies <- function(hc, df, as.alternatives = F) {
+hc_add_series_korap_frequencies <- function(hc, df, as.alternatives = FALSE) {
index <- 0
for(q in unique(df$condition)) {
dat <- df[df$condition==q,]
@@ -124,8 +124,8 @@
type = 'arearange',
fillOpacity = 0.3,
lineWidth = 0,
- marker = list(enabled = F),
- enableMouseTracking = F,
+ marker = list(enabled = FALSE),
+ enableMouseTracking = FALSE,
linkedTo= ':previous',
colorIndex = index,
zIndex = 0
diff --git a/R/misc.R b/R/misc.R
index 75697d3..a39ef21 100644
--- a/R/misc.R
+++ b/R/misc.R
@@ -26,7 +26,7 @@
#' Convert corpus frequency table of alternatives to percent
#'
#' Convenience function for converting frequency tables of alternative variants
-#' (generated with \code{as.alternatives=T}) to percent.
+#' (generated with \code{as.alternatives=TRUE}) to percent.
#'
#' @param df table returned from \code{\link{frequencyQuery}}
#'
@@ -67,7 +67,7 @@
#' @importFrom PTXQC lcsCount
#'
#' @export
-queryStringToLabel <- function(data, pubDateOnly = F, excludePubDate = F) {
+queryStringToLabel <- function(data, pubDateOnly = FALSE, excludePubDate = FALSE) {
if (pubDateOnly) {
data <-substring(data, regexpr("pubDate", data)+7)
} else if(excludePubDate) {
diff --git a/demo/highcharter-example.R b/demo/highcharter-example.R
index 4d312ba..e2947ea 100644
--- a/demo/highcharter-example.R
+++ b/demo/highcharter-example.R
@@ -4,7 +4,7 @@
years = c(2000:2010),
as.alternatives = length(query) > 1,
vc = "textType = /Zeit.*/ & availability!=QAO-NC-LOC:ids & pubDate in",
- kco = new("KorAPConnection", verbose=T) ) {
+ kco = new("KorAPConnection", verbose=TRUE) ) {
hc <-
frequencyQuery(kco, query, paste(vc, years), as.alternatives=as.alternatives) %>%
hc_freq_by_year_ci(as.alternatives)
@@ -13,11 +13,11 @@
}
saveHCPlot <- function(hc, fname) {
- htmlwidgets::saveWidget(hc, file=fname, selfcontained = T)
+ htmlwidgets::saveWidget(hc, file=fname, selfcontained = TRUE)
}
#h1 <-plotHighchart(c("macht []{0,3} Sinn", "ergibt []{0,3} Sinn"), c(1980:2018))
-h1 <- plotHighchart(c("Leser | Lesern | Lesers", 'Leserin | Leserinnen', 'LeserIn | LeserInnen', '"Leser[_\\*]in.*"'), c(1985:2018), as.alternatives = F)
+h1 <- plotHighchart(c("Leser | Lesern | Lesers", 'Leserin | Leserinnen', 'LeserIn | LeserInnen', '"Leser[_\\*]in.*"'), c(1985:2018), as.alternatives = FALSE)
#plotHighchart(c("Tollpatsch", "Tolpatsch"), c(1991:2018))
diff --git a/demo/writtenVsSpoken.R b/demo/writtenVsSpoken.R
index 6e63399..87b93b4 100644
--- a/demo/writtenVsSpoken.R
+++ b/demo/writtenVsSpoken.R
@@ -2,7 +2,7 @@
# install_github("KorAP/RKorAPClient")
library(RKorAPClient)
library(ggplot2)
-g <- new("KorAPConnection", verbose=T) %>%
+g <- new("KorAPConnection", verbose=TRUE) %>%
frequencyQuery("sozusagen/i", vc=c("corpusSigle=FOLK", "corpusSigle!=FOLK")) %>%
ipm() %>%
mutate(corpus=c("FOLK", "DeReKo")) %>%
diff --git a/man/hc_freq_by_year_ci.Rd b/man/hc_freq_by_year_ci.Rd
index d50dab0..273b06f 100644
--- a/man/hc_freq_by_year_ci.Rd
+++ b/man/hc_freq_by_year_ci.Rd
@@ -6,7 +6,7 @@
\usage{
hc_freq_by_year_ci(
df,
- as.alternatives = F,
+ as.alternatives = FALSE,
ylabel = if (as.alternatives) "\%" else "ipm"
)
}
diff --git a/man/percent.Rd b/man/percent.Rd
index 13a1673..1e40204 100644
--- a/man/percent.Rd
+++ b/man/percent.Rd
@@ -14,7 +14,7 @@
}
\description{
Convenience function for converting frequency tables of alternative variants
-(generated with \code{as.alternatives=T}) to percent.
+(generated with \code{as.alternatives=TRUE}) to percent.
}
\examples{
\donttest{
diff --git a/man/queryStringToLabel.Rd b/man/queryStringToLabel.Rd
index 67d138c..8dedafe 100644
--- a/man/queryStringToLabel.Rd
+++ b/man/queryStringToLabel.Rd
@@ -4,7 +4,7 @@
\alias{queryStringToLabel}
\title{Convert query or vc strings to plot labels}
\usage{
-queryStringToLabel(data, pubDateOnly = F, excludePubDate = F)
+queryStringToLabel(data, pubDateOnly = FALSE, excludePubDate = FALSE)
}
\arguments{
\item{data}{string or vector of query or vc definition strings}