P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2024-12-26 18:46:13 +01:00
Code Releases Activity

freq: fix na.rm in groups

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends 2018-11-08 16:10:03 +01:00
parent 84e08f516a
commit 9be5e0318b
4 changed files with 11 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
NAMESPACE
View File

@ -173,6 +173,7 @@ importFrom(crayon,green)
importFrom(crayon,italic) importFrom(crayon,italic)
importFrom(crayon,red) importFrom(crayon,red)
importFrom(crayon,silver) importFrom(crayon,silver)
importFrom(crayon,strip_style)
importFrom(curl,nslookup) importFrom(curl,nslookup)
importFrom(data.table,as.data.table) importFrom(data.table,as.data.table)
importFrom(data.table,data.table) importFrom(data.table,data.table)
@ -190,6 +191,7 @@ importFrom(dplyr,desc)
importFrom(dplyr,everything) importFrom(dplyr,everything)
importFrom(dplyr,filter) importFrom(dplyr,filter)
importFrom(dplyr,filter_all) importFrom(dplyr,filter_all)
importFrom(dplyr,filter_at)
importFrom(dplyr,full_join) importFrom(dplyr,full_join)
importFrom(dplyr,funs) importFrom(dplyr,funs)
importFrom(dplyr,group_by) importFrom(dplyr,group_by)

6
R/eucast.R
View File

@ -97,7 +97,7 @@
#' @rdname EUCAST #' @rdname EUCAST
#' @export #' @export
#' @importFrom dplyr %>% select pull mutate_at vars #' @importFrom dplyr %>% select pull mutate_at vars
#' @importFrom crayon bold bgGreen bgYellow bgRed black green blue italic #' @importFrom crayon bold bgGreen bgYellow bgRed black green blue italic strip_style
#' @return The input of \code{tbl}, possibly with edited values of antibiotics. Or, if \code{verbose = TRUE}, a \code{data.frame} with verbose info. #' @return The input of \code{tbl}, possibly with edited values of antibiotics. Or, if \code{verbose = TRUE}, a \code{data.frame} with verbose info.
#' @source #' @source
#' \itemize{ #' \itemize{
@ -376,8 +376,8 @@ EUCAST_rules <- function(tbl,
if (verbose == TRUE) { if (verbose == TRUE) {
for (i in 1:length(cols)) { for (i in 1:length(cols)) {
# add new row for every affected column # add new row for every affected column
verbose_new <- data.frame(rule_type = rule[1], verbose_new <- data.frame(rule_type = strip_style(rule[1]),
rule_set = rule[2], rule_set = strip_style(rule[2]),
force_to = to, force_to = to,
found = length(before), found = length(before),
changed = sum(before != after, na.rm = TRUE), changed = sum(before != after, na.rm = TRUE),

5
R/freq.R
View File

@ -59,7 +59,7 @@
#' The function \code{top_freq} uses \code{\link[dplyr]{top_n}} internally and will include more than \code{n} rows if there are ties. #' The function \code{top_freq} uses \code{\link[dplyr]{top_n}} internally and will include more than \code{n} rows if there are ties.
#' @importFrom stats fivenum sd mad #' @importFrom stats fivenum sd mad
#' @importFrom grDevices boxplot.stats #' @importFrom grDevices boxplot.stats
#' @importFrom dplyr %>% arrange arrange_at desc funs group_by mutate mutate_at n_distinct pull select summarise tibble ungroup vars #' @importFrom dplyr %>% arrange arrange_at desc filter_at funs group_by mutate mutate_at n_distinct pull select summarise tibble ungroup vars all_vars
#' @importFrom utils browseVignettes #' @importFrom utils browseVignettes
#' @importFrom hms is.hms #' @importFrom hms is.hms
#' @importFrom crayon red green silver #' @importFrom crayon red green silver
@ -206,6 +206,9 @@ frequency_tbl <- function(x,
df <- x %>% df <- x %>%
group_by_at(vars(x.group_cols)) %>% group_by_at(vars(x.group_cols)) %>%
summarise(count = n()) summarise(count = n())
if (na.rm == TRUE) {
df <- df %>% filter_at(vars(cols), all_vars(!is.na(.)))
}
if (!missing(sort.count)) { if (!missing(sort.count)) {
if (sort.count == TRUE) { if (sort.count == TRUE) {
df <- df %>% arrange_at(c(x.group, "count"), desc) df <- df %>% arrange_at(c(x.group, "count"), desc)

2
tests/testthat/test-freq.R
View File

@ -63,6 +63,8 @@ test_that("frequency table works", {
# grouping variable # grouping variable
expect_output(print(septic_patients %>% group_by(gender) %>% freq(hospital_id))) expect_output(print(septic_patients %>% group_by(gender) %>% freq(hospital_id)))
expect_output(print(septic_patients %>% group_by(gender) %>% freq(amox, quote = TRUE)))
expect_output(print(septic_patients %>% group_by(gender) %>% freq(amox, markdown = TRUE)))
# top 5 # top 5
expect_equal( expect_equal(