blob: 19f8615da5e95816ad22823b4229a391461a3f61 [file] [log] [blame]
Marc Kupietzdcc1de62019-10-04 09:10:36 +02001#' Add confidence interval and relative frequency variables
2#'
Marc Kupietz67edcb52021-09-20 21:54:24 +02003#' Using [prop.test()], `ci` adds three columns to a data frame:
4#' 1. relative frequency (`f`)
5#' 2. lower bound of a confidence interval (`ci.low`)
Marc Kupietz3f575282019-10-04 14:46:04 +02006#' 3. upper bound of a confidence interval
7#'
Marc Kupietz97a1bca2019-10-04 22:52:09 +02008#'
Marc Kupietz3f575282019-10-04 14:46:04 +02009#' @seealso
Marc Kupietz67edcb52021-09-20 21:54:24 +020010#' `ci` is already included in [frequencyQuery()]
Marc Kupietzdcc1de62019-10-04 09:10:36 +020011#'
12#' @param df table with columns for absolute and total frequencies.
13#' @param x column with the observed absolute frequency.
Marc Kupietz43a6ade2020-02-18 17:01:44 +010014#' @param N column with the total frequencies
Marc Kupietzdcc1de62019-10-04 09:10:36 +020015#' @param conf.level confidence level of the returned confidence interval. Must
16#' be a single number between 0 and 1.
17#'
Marc Kupietza6e4ee62021-03-05 09:00:15 +010018#' @rdname misc-functions
19#'
Marc Kupietzdcc1de62019-10-04 09:10:36 +020020#' @export
21#' @importFrom stats prop.test
Marc Kupietz3f575282019-10-04 14:46:04 +020022#' @importFrom tibble remove_rownames
Marc Kupietz97a1bca2019-10-04 22:52:09 +020023#' @importFrom dplyr enquo rename starts_with
Marc Kupietzdcc1de62019-10-04 09:10:36 +020024#' @examples
Marc Kupietz6ae76052021-09-21 10:34:00 +020025#' \dontrun{
26#'
Marc Kupietzdcc1de62019-10-04 09:10:36 +020027#' library(ggplot2)
28#' kco <- new("KorAPConnection", verbose=TRUE)
29#' expand_grid(year=2015:2018, alternatives=c("Hate Speech", "Hatespeech")) %>%
30#' bind_cols(corpusQuery(kco, .$alternatives, sprintf("pubDate in %d", .$year))) %>%
Marc Kupietz71d6e052019-11-22 18:42:10 +010031#' mutate(total=corpusStats(kco, vc=vc)$tokens) %>%
Marc Kupietzdcc1de62019-10-04 09:10:36 +020032#' ci() %>%
33#' ggplot(aes(x=year, y=f, fill=query, color=query, ymin=conf.low, ymax=conf.high)) +
34#' geom_point() + geom_line() + geom_ribbon(alpha=.3)
Marc Kupietz05b22772020-02-18 21:58:42 +010035#' }
Marc Kupietz53c1b502020-02-03 22:48:30 +010036ci <- function(df,
37 x = totalResults,
38 N = total,
39 conf.level = 0.95) {
Marc Kupietzdcc1de62019-10-04 09:10:36 +020040 x <- enquo(x)
41 N <- enquo(N)
Marc Kupietz53c1b502020-02-03 22:48:30 +010042 nas <- df %>%
Marc Kupietza4675722022-02-23 23:55:15 +010043 dplyr::filter(is.na(total) | total <= 0) %>%
Marc Kupietz53c1b502020-02-03 22:48:30 +010044 mutate(f = NA, conf.low = NA, conf.high = NA)
Marc Kupietza4675722022-02-23 23:55:15 +010045
46 if (nrow(df) == nrow(nas))
47 return(nas)
48
Marc Kupietzdcc1de62019-10-04 09:10:36 +020049 df %>%
Marc Kupietz53c1b502020-02-03 22:48:30 +010050 dplyr::filter(total > 0) %>%
Marc Kupietzdcc1de62019-10-04 09:10:36 +020051 rowwise %>%
Marc Kupietz53c1b502020-02-03 22:48:30 +010052 mutate(tst = list(
53 broom::tidy(prop.test(!!x,!!N, conf.level = conf.level)) %>%
54 select(estimate, conf.low, conf.high) %>%
55 rename(f = estimate)
Marc Kupietzdcc1de62019-10-04 09:10:36 +020056 )) %>%
Marc Kupietz53c1b502020-02-03 22:48:30 +010057 tidyr::unnest(tst) %>%
58 bind_rows(nas)
Marc Kupietzdcc1de62019-10-04 09:10:36 +020059}
60
Marc Kupietz7d613872019-10-04 22:47:20 +020061## Mute notes: "Undefined global functions or variables:"
Marc Kupietz71d6e052019-11-22 18:42:10 +010062globalVariables(c("totalResults", "total", "estimate", "tst"))
Marc Kupietzdcc1de62019-10-04 09:10:36 +020063
64
Marc Kupietz71d6e052019-11-22 18:42:10 +010065# ci.old <- function(df, x = totalResults, N = total, conf.level = 0.95) {
Marc Kupietzdcc1de62019-10-04 09:10:36 +020066# x <- deparse(substitute(x))
67# N <- deparse(substitute(N))
68# df <- data.frame(df)
69# df$f <- df[,x] / df[,N]
70# df[, c("conf.low", "conf.high")] <- t(sapply(Map(function(a, b) prop.test(a, b, conf.level = conf.level), df[,x], df[,N]), "[[","conf.int"))
71# return(df)
72# }