blob: a0c04f746f859a798c388bf4017e67b768011e63 [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 %>%
43 dplyr::filter(total <= 0) %>%
44 mutate(f = NA, conf.low = NA, conf.high = NA)
Marc Kupietzdcc1de62019-10-04 09:10:36 +020045 df %>%
Marc Kupietz53c1b502020-02-03 22:48:30 +010046 dplyr::filter(total > 0) %>%
Marc Kupietzdcc1de62019-10-04 09:10:36 +020047 rowwise %>%
Marc Kupietz53c1b502020-02-03 22:48:30 +010048 mutate(tst = list(
49 broom::tidy(prop.test(!!x,!!N, conf.level = conf.level)) %>%
50 select(estimate, conf.low, conf.high) %>%
51 rename(f = estimate)
Marc Kupietzdcc1de62019-10-04 09:10:36 +020052 )) %>%
Marc Kupietz53c1b502020-02-03 22:48:30 +010053 tidyr::unnest(tst) %>%
54 bind_rows(nas)
Marc Kupietzdcc1de62019-10-04 09:10:36 +020055}
56
Marc Kupietz7d613872019-10-04 22:47:20 +020057## Mute notes: "Undefined global functions or variables:"
Marc Kupietz71d6e052019-11-22 18:42:10 +010058globalVariables(c("totalResults", "total", "estimate", "tst"))
Marc Kupietzdcc1de62019-10-04 09:10:36 +020059
60
Marc Kupietz71d6e052019-11-22 18:42:10 +010061# ci.old <- function(df, x = totalResults, N = total, conf.level = 0.95) {
Marc Kupietzdcc1de62019-10-04 09:10:36 +020062# x <- deparse(substitute(x))
63# N <- deparse(substitute(N))
64# df <- data.frame(df)
65# df$f <- df[,x] / df[,N]
66# 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"))
67# return(df)
68# }