diff --git a/NAMESPACE b/NAMESPACE index 6e374dd..4eac6ae 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,3 +1,5 @@ # Generated by roxygen2: do not edit by hand export(sens_analysis) +importFrom(BiasedUrn,dFNCHypergeo) +importFrom(stats,uniroot) diff --git a/R/find_odds.R b/R/find_odds.R index 9e6d670..769aa09 100644 --- a/R/find_odds.R +++ b/R/find_odds.R @@ -1,20 +1,18 @@ ##' Find odds ##' -##' A function that allows the researcher to input the likelihood of data or to find how mush bias in datacollection would be nescessary to obtain a p>0.05 or p>0.10 result using the same data. +##' A function that allows the researcher to input the likelihood of data or to find how mush bias in datacollection would be nescessary to obtain a p>0.05 or p>0.10 result using the same data. ##' ##' ##' @title Find odds given ideas about unequally easy evidence ##' @param obs_support An integer representing the number of observations in favor of the working hypothesis. Must be less than or equal to the total. ##' @param total_obs An integer representing the total number of observations ##' @param thep The p-value threshold -##' @return +##' @return ##' @importFrom BiasedUrn dFNCHypergeo -##' @importFrom stats uniroot +##' @importFrom stats uniroot ##' @export - obs_oppose <- obs_support+1 - -sens_analysis <- function(obs_support, obs_oppose, total_obs, thep=.05) { +sens_analysis <- function(obs_support, obs_oppose, total_obs, thep = .05) { find_odds <- function(x, thep = thep) { ## thep is the desired pvalue ## x is the odds diff --git a/R/p.R b/R/p.R deleted file mode 100644 index 904ff84..0000000 --- a/R/p.R +++ /dev/null @@ -1,15 +0,0 @@ -##' Find a p-value given a certain number of observations in favor of the working hypothesis among a total number of observations -##' -##' @param obs_support An integer representing the number of observations in favor of the working hypothesis. Must be less than or equal to the total. -##' @param total_obs An integer representing the total number of observations -##' @export -find_p <- function(obs_support,total_obs){ - ## Test to make sure that obs_support is less than or equal to total_obs - stopifnot("The number of observations in favor of the working hypothesis must be less than or equal to the total number of observations"=obs_support<=total_obs) - obs_oppose <- obs_support+1 - stopifnot("Observations are already compatible with the null. The number of observations in favor of the working hypothesis must be greater than or equal to half of the total number of observations"=obs_support >= (total_obs/2)) - ## We assume odds=1 here - thep <- dFNCHypergeo(x=obs_support, m1 = obs_support, m2 = obs_oppose, - n = total_obs, odds = 1) - return(thep) -} diff --git a/R/p_binary.R b/R/p_binary.R new file mode 100644 index 0000000..8a9bc52 --- /dev/null +++ b/R/p_binary.R @@ -0,0 +1,38 @@ +#' Find a p-value given a certain number of observations in favor of the +#' working hypothesis among a total number of observations +#' +#' +#' +#' @param obs_support An integer representing the number of observations in favor of the working hypothesis. Must be less than or equal to the total. +#' @param total_obs An integer representing the total number of observations +#' @param odds The odds of seeing +#' @param interpretation TRUE if the function returns text helping to interpret the result, FALSE (default option) to return just the p-value +#' @return Either a p-value (numeric, scalar) or a list containing the p-value and text containing an interpretation +#' @export +find_p_two_types <- function(obs_support, total_obs, odds = 1, interpretation = FALSE) { + ## Test to make sure that obs_support is less than or equal to total_obs + stopifnot("The number of observations in favor of the working hypothesis must be less than or equal to the total number of observations" = obs_support <= total_obs) + obs_oppose <- obs_support + 1 + stopifnot("Observations are already compatible with the null. The number of observations in favor of the working hypothesis must be greater than or equal to half of the total number of observations" = obs_support >= (total_obs / 2)) + ## We assume odds=1 here + thep <- dFNCHypergeo( + x = obs_support, m1 = obs_support, m2 = obs_oppose, + n = total_obs, odds = odds + ) + if (!interpretation) { + return(thep) + } else { + interp <- paste0("The probability of drawing ", obs_support, " observations which support the working theory from an urn model supporting a rival theory, where the odds of observing working theory information is odds=", odds, ", is p=", round(thep, 4)) + message(interp) + return(list(thep = thep, interp = interp)) + } +} +#' @examples +#' ... +#' # Equal probability, 2 kinds of evidence +#' find_p_two_types(obs_support = 7, total_obs = 10) +#' # Equal probability, 2 kinds of evidence with interpretation printed +#' find_p_two_types(obs_support = 7, total_obs = 10, interpretation = TRUE) +#' # Unequal probability, 2 kinds of evidence with interpretation printed +#' find_p_two_types(obs_support = 7, total_obs = 10, interpretation = TRUE, odds = .5) +#' find_p_two_types(obs_support = 7, total_obs = 10, interpretation = TRUE, odds = 2) diff --git a/tests/testthat/test_thep.R b/tests/testthat/test_thep.R index 7ea17e0..b81d357 100644 --- a/tests/testthat/test_thep.R +++ b/tests/testthat/test_thep.R @@ -1,18 +1,34 @@ # Test the p creation function -testthat::context("The simple unbiased p function test") ## The next lines are for use when creating the tests. Change interactive<-FALSE for production interactive <- FALSE if (interactive) { + library(devtools) load_all() ## use this during debugging } +test_that("It gives the correct p-value", { + res <- find_p_two_types(obs_support = 7, total_obs = 10) + expect_true(all.equal(res, 0.018648018648018651472)) +}) + +test_that("It prints the correct interpretation", { + res <- find_p_two_types(obs_support = 7, total_obs = 10, interpretation = TRUE) + expect_true(all.equal(res[["thep"]], 0.018648018648018651472)) + expect_true(all.equal(res[["interp"]], "The probability of drawing 7 observations which support the working theory from an urn model supporting a rival theory, where the odds of observing working theory information is odds=1, is p=0.0186")) +}) + + +test_that("P-values with odds < 1 are smaller than p-values with odds > 2", { + res_odds_half <- find_p_two_types(obs_support = 7, total_obs = 10, odds = .5, interpretation = FALSE) + res_odds_equal <- find_p_two_types(obs_support = 7, total_obs = 10, odds = 1, interpretation = FALSE) + res_odds_double <- find_p_two_types(obs_support = 7, total_obs = 10, odds = 2, interpretation = FALSE) + expect_lt(res_odds_half, res_odds_equal) + expect_lt(res_odds_equal, res_odds_double) +}) + test_that("Warnings work", { - expect_error(find_p(num_support=10,total_info=5)) - expect_error(find_p(num_support=2,total_info=10)) + expect_error(find_p_two_types(obs_support = 10, total_obs = 5)) + expect_error(find_p_two_types(obs_support = 2, total_obs = 10)) }) -test_that("It gives the correct p-value",{ - res <- find_p(num_support=7,total_info=10) - expect_true(all.equal(res,0.018648018648018651472)) -}) \ No newline at end of file