1
0
mirror of https://github.com/msberends/AMR.git synced 2024-12-25 18:06:12 +01:00

prevent dplyr:row_number warning

This commit is contained in:
dr. M.S. (Matthijs) Berends 2018-05-31 14:19:25 +02:00
parent 7a6d5fb6b7
commit efdf5a3dc5
6 changed files with 22 additions and 12 deletions

View File

@ -1,6 +1,6 @@
Package: AMR Package: AMR
Version: 0.2.0.9001 Version: 0.2.0.9002
Date: 2018-05-30 Date: 2018-05-31
Title: Antimicrobial Resistance Analysis Title: Antimicrobial Resistance Analysis
Authors@R: c( Authors@R: c(
person( person(

View File

@ -1,4 +1,4 @@
# 0.2.0.9000 (development version) # 0.2.0.90xx (development version)
#### New #### New
* Vignettes about frequency tables * Vignettes about frequency tables
* Possibility to globally set the default for the amount of items to print in frequency tables (`freq` function), with `options(max.print.freq = n)` * Possibility to globally set the default for the amount of items to print in frequency tables (`freq` function), with `options(max.print.freq = n)`
@ -6,6 +6,8 @@
#### Changed #### Changed
* Renamed `toConsole` parameter of `freq` to `as.data.frame` * Renamed `toConsole` parameter of `freq` to `as.data.frame`
* Small translational improvements to the `septic_patients` dataset * Small translational improvements to the `septic_patients` dataset
* Coerce RSI values from combined MIC/RSI values: `as.rsi("<=0.002; S")` will now return `"S"`
* Fix for warning `hybrid evaluation forced for row_number` from the `dplyr` package v0.7.5 and above.
# 0.2.0 (latest stable version) # 0.2.0 (latest stable version)
#### New #### New

View File

@ -44,7 +44,7 @@ as.rsi <- function(x) {
# remove all spaces # remove all spaces
x <- gsub(' +', '', x) x <- gsub(' +', '', x)
# remove all MIC-like values: numbers, operators and periods # remove all MIC-like values: numbers, operators and periods
x <- gsub('[0-9.,<=>]+', '', x) x <- gsub('[0-9.,;:<=>]+', '', x)
# disallow more than 3 characters # disallow more than 3 characters
x[nchar(x) > 3] <- NA x[nchar(x) > 3] <- NA
# set to capitals # set to capitals

View File

@ -292,12 +292,15 @@ first_isolate <- function(tbl,
} }
scope.size <- tbl %>% scope.size <- tbl %>%
filter(row_number() %>% filter(
between(row.start, suppressWarnings(
row.end), row_number() %>% between(row.start,
genus != '') %>% row.end)
),
genus != '') %>%
nrow() nrow()
# Analysis of first isolate ---- # Analysis of first isolate ----
all_first <- tbl %>% all_first <- tbl %>%
mutate(other_pat_or_mo = if_else(patient_id == lag(patient_id) mutate(other_pat_or_mo = if_else(patient_id == lag(patient_id)
@ -336,13 +339,14 @@ first_isolate <- function(tbl,
mutate( mutate(
real_first_isolate = real_first_isolate =
if_else( if_else(
between(row_number(), row.start, row.end) suppressWarnings(between(row_number(), row.start, row.end))
& genus != '' & genus != ''
& (other_pat_or_mo & (other_pat_or_mo
| days_diff >= episode_days | days_diff >= episode_days
| key_ab_other), | key_ab_other),
TRUE, TRUE,
FALSE)) FALSE))
if (info == TRUE) { if (info == TRUE) {
cat('\n') cat('\n')
} }
@ -351,7 +355,7 @@ first_isolate <- function(tbl,
mutate( mutate(
real_first_isolate = real_first_isolate =
if_else( if_else(
between(row_number(), row.start, row.end) suppressWarnings(between(row_number(), row.start, row.end))
& genus != '' & genus != ''
& (other_pat_or_mo & (other_pat_or_mo
| days_diff >= episode_days), | days_diff >= episode_days),

View File

@ -349,7 +349,6 @@ freq <- function(x,
' (', ' (',
(Count.rest / length(x)) %>% percent(force_zero = TRUE), (Count.rest / length(x)) %>% percent(force_zero = TRUE),
') ]\n', sep = '') ') ]\n', sep = '')
cat('\n')
} else { } else {
print( print(

View File

@ -204,7 +204,12 @@ prettyprint_df <- function(x,
# class will be marked up per column # class will be marked up per column
if (NROW(x.bak) > 0) { if (NROW(x.bak) > 0) {
rownames.x <- rownames(x) rownames.x <- rownames(x)
x <- x %>% filter(row_number() == 1) %>% rbind(x, stringsAsFactors = FALSE) x <- x %>%
filter(
suppressWarnings(
row_number() == 1)
) %>%
rbind(x, stringsAsFactors = FALSE)
rownames(x) <- c('*', rownames.x) rownames(x) <- c('*', rownames.x)
} }