P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2025-07-08 11:51:59 +02:00
Code Releases Activity

extra unit tests, add row.names to freq

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2018-06-19 15:20:14 +02:00
parent bdc860e29c
commit 4a027f3c34
8 changed files with 77 additions and 25 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
R/atc.R
View File

@ -263,7 +263,7 @@ abname <- function(abcode, from = c("guess", "atc", "molis", "umcg"), to = 'offi
if (!from %in% colnames(antibiotics) |
!to %in% colnames(antibiotics)) {
stop(paste0('Invalid `from` or `to`. Choose one of ',
colnames(antibiotics) %>% paste(collapse = ","), '.'), call. = FALSE)
colnames(antibiotics) %>% paste(collapse = ", "), '.'), call. = FALSE)
}
abcode <- as.character(abcode)

21
R/freq.R
View File

@ -23,6 +23,7 @@
#' @param sort.count sort on count. Use \code{FALSE} to sort alphabetically on item.
#' @param nmax number of row to print. The default, \code{15}, uses \code{\link{getOption}("max.print.freq")}. Use \code{nmax = 0} or \code{nmax = NA} to print all rows.
#' @param na.rm a logical value indicating whether NA values should be removed from the frequency table. The header will always print the amount of \code{NA}s.
#' @param row.names a logical value indicating whether row indices should be printed as \code{1:nrow(x)}
#' @param markdown print table in markdown format (this forces \code{nmax = NA})
#' @param as.data.frame return frequency table without header as a \code{data.frame} (e.g. to assign the table to an object)
#' @param digits how many significant digits are to be used for numeric values (not for the items themselves, that depends on \code{\link{getOption}("digits")})
@ -68,6 +69,7 @@ freq <- function(x,
sort.count = TRUE,
nmax = getOption("max.print.freq"),
na.rm = TRUE,
row.names = TRUE,
markdown = FALSE,
as.data.frame = FALSE,
digits = 2,
@ -222,11 +224,13 @@ freq <- function(x,
}
if (any(class(x) %in% c('Date', 'POSIXct', 'POSIXlt'))) {
header <- header %>% paste0('\n')
mindatum <- x %>% min()
maxdatum <- x %>% max()
header <- header %>% paste0(markdown_line, '\nOldest: ', mindatum %>% format(formatdates) %>% trimws())
header <- header %>% paste0(markdown_line, '\nNewest: ', maxdatum %>% format(formatdates) %>% trimws(),
' (+', difftime(maxdatum, mindatum, units = 'auto') %>% as.double() %>% format(), ')')
mindate <- x %>% min(na.rm = TRUE)
maxdate <- x %>% max(na.rm = TRUE)
mediandate <- x %>% median(na.rm = TRUE)
header <- header %>% paste0(markdown_line, '\nOldest: ', mindate %>% format(formatdates) %>% trimws())
header <- header %>% paste0(markdown_line, '\nNewest: ', maxdate %>% format(formatdates) %>% trimws(),
' (+', difftime(maxdate, mindate, units = 'auto') %>% as.double() %>% format(), ')')
header <- header %>% paste0(markdown_line, '\nMedian: ', mediandate %>% format(formatdates) %>% trimws())
}
if (any(class(x) == 'POSIXlt')) {
x <- x %>% format(formatdates)
@ -266,8 +270,9 @@ freq <- function(x,
} else {
df <- tibble::tibble(Item = x) %>%
group_by(Item)
column_names <- column_names[1:5] # strip factor lvl
column_names_df <- column_names_df[1:5] # strip factor lvl
# strip factor lvl from col names
column_names <- column_names[1:length(column_names) - 1]
column_names_df <- column_names_df[1:length(column_names_df) - 1]
column_align <- c(x_align, 'r', 'r', 'r', 'r')
}
df <- df %>%
@ -333,6 +338,7 @@ freq <- function(x,
print(
knitr::kable(df2,
format = tblformat,
row.names = row.names,
col.names = column_names,
align = column_align,
padding = 1)
@ -354,6 +360,7 @@ freq <- function(x,
print(
knitr::kable(df,
format = tblformat,
row.names = row.names,
col.names = column_names,
align = column_align,
padding = 1)