new test functions

R/abc.R

@@ -27,9 +27,10 @@ abc <- function(.data,...,dim,a=.7,b=.26,c=.04,func=c("sum")){
     ,choices = c("sum","n")
   )
 
+
   # input validation
 
-  assertthat::assert_that(a+b+c==1,msg = "A, B, and C must sum to 1")
+  assertthat::assert_that(assertthat::are_equal(x=c(a+b+c),1),msg = "A, B, and C must sum to 1")
 
   # numeric dim validation check
 

R/abc_graph.R

@@ -1,39 +1,34 @@
 
 
-
 #' Produces ABC graph based on abc() function
 #'
-#' @param df data frame
-#' @param group_label label for grouping variable
-#' @param dim_label label for dimension variable
-#' @param size ggplot size
-#' @param shape ggplot shape
-#' @param ...
+#' @param .data a tibble or DBI object producteed by abc() function
 #'
-#' @return
+#' @return ggplot
 #' @export
 #'
 #' @examples
+#' abc(ggplot2::diamonds,cut,dim=price,func="n") |> abc_graph()
 abc_graph <- function(.data){
 
 
   abc_coordinates <- .data |>
-    group_by(dim_category) |>
-    summarize(first_cum_per_of_total=first(cum_prop_total),
-              last_cum_per_of_total=last(cum_prop_total),
-              first_cum_unit_percent=first(cum_unit_prop),
-              last_cum_unit_percent=last(cum_unit_prop),
-              n=n(),
-              threshold=first(dim_threshold)
+    dplyr::group_by(dim_category) |>
+    dplyr::summarize(first_cum_per_of_total=dplyr::first(cum_prop_total),
+              last_cum_per_of_total=dplyr::last(cum_prop_total),
+              first_cum_unit_percent=dplyr::first(cum_unit_prop),
+              last_cum_unit_percent=dplyr::last(cum_unit_prop),
+              n=dplyr::n(),
+              threshold=dplyr::first(dim_threshold)
     ) |> dplyr::collect()
 
 
   .data |>
-    ggplot(aes(x=cum_unit_prop,
+    ggplot2::ggplot(ggplot2::aes(x=cum_unit_prop,
                y=cum_prop_total))+
-    geom_point()+
-    geom_line()+
-    annotate(geom = "rect",
+    ggplot2::geom_point()+
+    ggplot2::geom_line()+
+    ggplot2::annotate(geom = "rect",
              xmin = abc_coordinates$first_cum_unit_percent,
              xmax = abc_coordinates$last_cum_unit_percent,
              ymin = abc_coordinates$first_cum_per_of_total,
@@ -44,73 +39,23 @@ abc_graph <- function(.data){
 
     #A dotted line---------------------------------------------------------------------------
 
-  geom_vline(xintercept = abc_coordinates$last_cum_unit_percent[1],
+  ggplot2::geom_vline(xintercept = abc_coordinates$last_cum_unit_percent[1],
              linetype="dashed",
              col="#007e2f")+
     #B dotted line--------------------------------------------------------------------------
 
-  geom_vline(xintercept = abc_coordinates$last_cum_unit_percent[2],
+  ggplot2::geom_vline(xintercept = abc_coordinates$last_cum_unit_percent[2],
              linetype="dashed",
              col="#ffcd12")+
 
     # C dotted line, I think i take this out???------------------------------------------------------------------------
-  geom_vline(xintercept = abc_coordinates$last_cum_unit_percent[3],
+  ggplot2::geom_vline(xintercept = abc_coordinates$last_cum_unit_percent[3],
              linetype="dashed",
              col="#a40000")+
     # A text -----------------------------------------------------------------------------
 
     #format scales---------------------------------------------------------------------------------------------
-  scale_x_continuous(labels = scales::percent_format())+
-    scale_y_continuous(labels = scales::percent_format())
+  ggplot2::scale_x_continuous(labels = scales::percent_format())+
+    ggplot2::scale_y_continuous(labels = scales::percent_format())
 }
 
-
-
-
-
-
-create_abc_anototates <- function(.data,group_label,dim_label,...){
-
-
-  abc_coordinates <- .data |>
-    group_by(dim_category) |>
-    summarize(first_cum_per_of_total=first(cum_prop_total),
-              last_cum_per_of_total=last(cum_prop_total),
-              first_cum_unit_percent=first(cum_unit_prop),
-              last_cum_unit_percent=last(cum_unit_prop),
-              n=n(),
-              threshold=first(dim_threshold)
-    ) |> dplyr::collect()
-
-
-
-
-       annotate(geom="text",
-           label=
-             glue::glue(
-               "initial {scales::percent(abc_coordinates$last_cum_unit_percent[1])} ({scales::comma(abc_coordinates$n[1])}) of\n{group_label} drive\n{scales::percent(abc_coordinates$threshold[1])} of {dim_label}"
-             ),
-           x = abc_coordinates$last_cum_unit_percent[1]+.05,
-           y = abc_coordinates$last_cum_unit_percent[1]+.05,
-           hjust=0)+
-
-    # B text ----------------------------------------------------------------------------
-
-  annotate(geom="text",
-           label=
-             glue::glue(
-               "cumlative {scales::percent(abc_coordinates$last_cum_unit_percent[2])} of\n{group_label} drive\n{scales::percent(abc_coordinates$threshold[2])} of {dim_label}"
-             ),
-           hjust=0,
-           size=size,
-           x =abc_coordinates$last_cum_unit_percent[2]+.05,
-           y=abc_coordinates$last_cum_unit_percent[2])+
-    # C text ----------------------------------------------------------------------
-  annotate(geom="text",
-           label=
-             glue::glue("remaining {scales::percent(abc_coordinates$threshold[3])} of\n{dim_label} driven by {scales::percent(1-(abc_coordinates$last_cum_unit_percent[1]+abc_coordinates$last_cum_unit_percent[2]))}\n({scales::comma(abc_coordinates$n[3])}) of {group_label}"),
-           hjust=0,
-           size=size,
-           x =abc_coordinates$last_cum_unit_percent[3]-.3,
-           y=abc_coordinates$last_cum_unit_percent[3]-.25)
-}

R/clean_file_names.R

@@ -2,17 +2,17 @@
 
 #' Rename file names witih janitor convention
 #'
-#' @param file.path
+#' @param file_path file path with files you want to rename
 #' @param ... additional args for janitor::make_clean_names()
 #'
-#' @return
+#' @return invisible
 #' @export
 #'
 #' @examples
 #' clean_file_names()
-clean_file_names <- function(file.path,...){
+clean_file_names <- function(file_path,...){
 
-fp <- file.path
+fp <- file_path
 
   old_names <- list.files(fp,full.names = TRUE)
 

R/create_date_tbl_sql.R

@@ -9,6 +9,7 @@
 #' @return a sql query
 #'
 #' @examples
+#' create_date_sql(mtcars_dbi,start_date="2021-01-01",end_date="2022-01-01")
 create_date_sql <- function(.data,start_date,end_date){
 
   ## create validation tests

test.R

@@ -6,11 +6,12 @@ devtools::load_all()
 devtools::test()
 # load table
 
-drv <- duckdb::duckdb(dbdir="data/duckdb.db")
+drv <- duckdb::duckdb(dbdir="/home/hagan/database.duckdb")
 
 con <- DBI::dbConnect(drv)
+DBI::dbListTables(con)
 
-diamonds_db <- tbl(con,"diamonds.db")
+diamonds_db <- tbl(con,"mtcars_dbi")
 
 library(pointblank)
 
@@ -753,8 +754,5 @@ square <- function(n) {
   }
 }
 
-devtools::check()
-devtools::document()
-devtools::build()
 
-devtools::test()
+

tests/testthat/test-abc.R

@@ -0,0 +1,38 @@
+test_that("abc func n works", {
+
+  testthat::expect_success(
+    testthat::expect_type(ggplot2::diamonds |>abc(cut,dim = price,a = .7,b=.2,c=.1,func = "n") ,"list")
+    )
+
+  })
+
+
+test_that("abc func sum works", {
+
+  testthat::expect_success(
+    testthat::expect_type(ggplot2::diamonds |>abc(cut,dim = price,a = .7,b=.2,c=.1,func = "sum") ,"list")
+  )
+
+})
+
+
+test_that("assert checks work", {
+
+  testthat::expect_error(
+    testthat::expect_type(ggplot2::diamonds |>abc(cut,dim = price,a = .7,b=.3,c=.1,func = "sum") ,"list")
+  )
+
+})
+
+
+test_that("assert checks work", {
+
+  testthat::expect_error(
+
+    ggplot2::diamonds |>abc(cut,dim = price,a = .7,b=.3,c=.1,func = "sum")
+
+  )
+
+})
+
+

tests/testthat/test-cohort.R

@@ -2,51 +2,40 @@
 
 ## create tests
 
-library(dplyr)
+library(tidyverse)
 library(testthat)
+library(lubridate)
 
-test_that("Tibble input returns tibble output", {
+# test data set
+dat <- crossing(
+  date = seq.Date(from = ymd("2020-01-01"), to = ymd("2024-01-01"), by = "day"),
+  customer = rep(letters[1:17], 86)
+) |>
+  mutate(purchases = runif(24854))
 
+test_that("Tibble input returns tibble output", {
   testthat::expect_s3_class(
-
-    fpaR::contoso_fact_sales |>
-      mutate(DateKey=lubridate::mdy(DateKey)) |>
-      make_cohort_tbl(id_var=ProductKey,date_var=DateKey,time_unit = 'week',period_label =TRUE)
-
-
-    ,"data.frame")
+    dat |> make_cohort_tbl(id_var = customer, date_var = date, time_unit = "week", period_label = TRUE),
+    "data.frame"
+  )
 })
 
 
 test_that("time_unit validate", {
   testthat::expect_error(
-
-    fpaR::contoso_fact_sales |>
-      dplyr::mutate(DateKey=lubridate::mdy(DateKey)) |>
-      fpaR::make_cohort_tbl(id_var=ProductKey,date_var=DateKey,time_unit = 'weekly',period_label =TRUE)
-
+    dat |> fpaR::make_cohort_tbl(id_var = customer, date_var = date, time_unit = "weekly", period_label = TRUE)
   )
 })
 
 
 test_that("date_var validation", {
   testthat::expect_error(
-
-    fpaR::contoso_fact_sales |>
-      dplyr::mutate(DateKey=lubridate::mdy(DateKey)) |>
-      fpaR::make_cohort_tbl(id_var=ProductKey,date_var=SalesKey,time_unit = 'week',period_label =TRUE)
-
+    dat |> fpaR::make_cohort_tbl(id_var = customer, date_var = purchases, time_unit = "week", period_label = TRUE)
   )
 })
 
 test_that("Period label validation", {
   testthat::expect_error(
-
-    fpaR::contoso_fact_sales |>
-      dplyr::mutate(DateKey=lubridate::mdy(DateKey)) |>
-      fpaR::make_cohort_tbl(id_var=ProductKey,date_var=SalesKey,time_unit = 'week',period_label ="0")
-
+    dat |> fpaR::make_cohort_tbl(id_var = customer, date_var = date, time_unit = "week", period_label = 0)
   )
 })
-
-