Skip to content

Commit

Permalink
Code reformatting (no functional changes)
Browse files Browse the repository at this point in the history
  • Loading branch information
billdenney committed Dec 13, 2024
1 parent 7362ea3 commit fb0e324
Show file tree
Hide file tree
Showing 2 changed files with 120 additions and 84 deletions.
38 changes: 16 additions & 22 deletions R/cleaners.R
Original file line number Diff line number Diff line change
Expand Up @@ -95,39 +95,33 @@ clean.conc.blq <- function(conc, time,
tfirst <- pk.calc.tfirst(ret$conc, ret$time, check=FALSE)
tlast <- pk.calc.tlast(ret$conc, ret$time, check=FALSE)
tmax <- pk.calc.tmax(ret$conc, ret$time, check=FALSE)

# If all measurements are BLQ
if (all(ret$conc == 0)){
# Apply "first" BLQ rule to everything for tfirst/tlast
tfirst <- max(ret$time)
tlast <- tfirst + 1

# Apply "before.tmax" BLQ rule to everything for tmax
tmax <- max(ret$time)
}

# Depending on the specified argument perform the corresponding action
for (i in seq_len(length(conc.blq))) {
# Set the mask to apply the rule to
n <- names(conc.blq)[i]
if (is.null(n) & length(conc.blq) == 1) {
mask <- (ret$conc %in% 0)
} else if (n == "first") {
mask <- (ret$time <= tfirst &
ret$conc %in% 0)
} else if (n == "middle") {
mask <- (tfirst < ret$time &
ret$time < tlast &
ret$conc %in% 0)
} else if (n == "last") {
mask <- (tlast <= ret$time &
ret$conc %in% 0)
} else if (n == "before.tmax") {
mask <- (ret$time < tmax &
ret$conc %in% 0)
} else if (n == "after.tmax") {
mask <- (tmax <= ret$time &
ret$conc %in% 0)
time_type <- names(conc.blq)[i]
if (is.null(time_type) & length(conc.blq) == 1) {
mask <- ret$conc %in% 0
} else if (time_type == "first") {
mask <- ret$time <= tfirst & ret$conc %in% 0
} else if (time_type == "middle") {
mask <- tfirst < ret$time & ret$time < tlast & ret$conc %in% 0
} else if (time_type == "last") {
mask <- tlast <= ret$time & ret$conc %in% 0
} else if (time_type == "before.tmax") {
mask <- ret$time < tmax & ret$conc %in% 0
} else if (time_type == "after.tmax") {
mask <- tmax <= ret$time & ret$conc %in% 0
} else {
stop("There is a bug in cleaning the conc.blq with position names") # nocov
}
Expand Down
166 changes: 104 additions & 62 deletions tests/testthat/test-cleaners.R
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,7 @@ test_that("clean.conc.na", {
clean.conc.na(conc=as.numeric(NA), time=1, conc.na="drop"))
expect_equal(v1,
data.frame(conc=numeric(), time=numeric()))
expect_warning(v2 <-
expect_warning(v2 <-
clean.conc.na(conc=as.numeric(c(NA, NA)), time=1:2,
conc.na="drop"))
expect_equal(v2,
Expand Down Expand Up @@ -189,7 +189,7 @@ test_that("clean.conc.blq", {
d.result,
info="fix related item to #145"
)

# If there are BLQ values at the beginning, middle, and end, it
# only drops all of them or drops them selectively as instructed.
d.test <- data.frame(conc=c(0, 1, 0, 2, 0), time=1:5)
Expand All @@ -214,7 +214,7 @@ test_that("clean.conc.blq", {
}
}
}

# When conc.na is 0, it drops those.
d.test <- data.frame(conc=c(0, 1, NA, 2, 0), time=1:5)
expect_equal(clean.conc.blq(d.test$conc, d.test$time,
Expand All @@ -241,44 +241,64 @@ test_that("clean.conc.blq", {
conc.blq="drop", conc.na="drop"),
d.test[c(2,4),])


# If there are BLQ values before tmax, drops those if given a simple drop
d.test <- data.frame(conc=c(0, 1), time=1:2)
expect_equal(clean.conc.blq(d.test$conc, d.test$time,
conc.blq=list(before.tmax="drop", after.tmax="drop"), conc.na="drop"),
d.test[2,])

expect_equal(
clean.conc.blq(
d.test$conc, d.test$time,
conc.blq=list(before.tmax="drop", after.tmax="drop"), conc.na="drop"),
d.test[2, ]
)

# If there are BLQ values after tmax, drops those if given a simple drop
d.test <- data.frame(conc=c(1, 0), time=1:2)
expect_equal(clean.conc.blq(d.test$conc, d.test$time,
conc.blq=list(before.tmax="drop", after.tmax="drop"), conc.na="drop"),
d.test[1,])

expect_equal(
clean.conc.blq(
d.test$conc, d.test$time,
conc.blq=list(before.tmax="drop", after.tmax="drop"), conc.na="drop"),
d.test[1,]
)

# If there are BLQ values before and after tmax, drops those if given a single instruction
d.test <- data.frame(conc=c(0, 1, 0), time=1:3)
expect_equal(clean.conc.blq(d.test$conc, d.test$time,
conc.blq=list(before.tmax="drop", after.tmax="drop"), conc.na="drop"),
d.test[2,])

expect_equal(
clean.conc.blq(
d.test$conc, d.test$time,
conc.blq=list(before.tmax="drop", after.tmax="drop"), conc.na="drop"
),
d.test[2,]
)

# If all values are BLQ, drops all rows
d.test <- data.frame(conc=0, time=1:3)
expect_equal(
clean.conc.blq(d.test$conc, d.test$time,
conc.blq=list(before.tmax="drop", after.tmax="drop"), conc.na="drop"),
clean.conc.blq(
d.test$conc, d.test$time,
conc.blq=list(before.tmax="drop", after.tmax="drop"), conc.na="drop"
),
d.test[logical(),]
)

# If there are BLQ values in the middle, it drops or keeps those or sets them to a number
d.test <- data.frame(conc=c(1, 0, 2), time=1:3)
expect_equal(clean.conc.blq(d.test$conc, d.test$time,
conc.blq=list(before.tmax="drop", after.tmax="drop"), conc.na="drop"),
d.test[-2,])

expect_equal(
clean.conc.blq(
d.test$conc, d.test$time,
conc.blq=list(before.tmax="drop", after.tmax="drop"), conc.na="drop"
),
d.test[-2,]
)

d.test <- data.frame(conc=c(1, 0, 2), time=1:3)
expect_equal(clean.conc.blq(d.test$conc, d.test$time,
conc.blq=list(before.tmax="keep", after.tmax="keep"), conc.na="drop"),
d.test)

expect_equal(
clean.conc.blq(
d.test$conc, d.test$time,
conc.blq=list(before.tmax="keep", after.tmax="keep"), conc.na="drop"
),
d.test
)

d.test <- data.frame(conc=c(1, 0, 2), time=1:3)
d.result <- data.frame(conc=c(1, 0.5, 2), time=1:3)
expect_equal(
Expand All @@ -288,53 +308,75 @@ test_that("clean.conc.blq", {
),
d.result
)

# If there are BLQ values before and after tmax, it only drops all of them or drops them selectively as instructed

# If there are BLQ values before and after tmax, it only drops all of them
# or drops them selectively as instructed
d.test <- data.frame(conc=c(0, 1, 0, 2, 0), time=1:5)
expect_equal(clean.conc.blq(d.test$conc, d.test$time,
conc.blq=list(before.tmax="drop", after.tmax="drop"), conc.na="drop"),
d.test[c(2, 4),])
expect_equal(
clean.conc.blq(
d.test$conc, d.test$time,
conc.blq=list(before.tmax="drop", after.tmax="drop"), conc.na="drop"
),
d.test[c(2, 4),]
)
for (before.tmax in c("drop", "keep")) {
for (after.tmax in c("drop", "keep")) {
expect_equal(clean.conc.blq(d.test$conc, d.test$time,
conc.blq=list(
before.tmax=before.tmax,
after.tmax=after.tmax),
conc.na=0),
d.test[c(before.tmax %in% "keep",
TRUE,
before.tmax %in% "keep",
TRUE,
after.tmax %in% "keep"),],
info=paste(before.tmax, after.tmax))
expect_equal(
clean.conc.blq(
d.test$conc, d.test$time,
conc.blq=list(before.tmax=before.tmax, after.tmax=after.tmax),
conc.na=0
),
d.test[
c(before.tmax %in% "keep",
TRUE,
before.tmax %in% "keep",
TRUE,
after.tmax %in% "keep"),],
info=paste(before.tmax, after.tmax)
)
}
}

# When conc.na is 0, it drops those
d.test <- data.frame(conc=c(0, 1, NA, 2, 0), time=1:5)
expect_equal(clean.conc.blq(d.test$conc, d.test$time,
conc.blq=list(before.tmax="drop", after.tmax="drop"), conc.na=0),
d.test[c(2, 4),])

expect_equal(
clean.conc.blq(
d.test$conc, d.test$time,
conc.blq=list(before.tmax="drop", after.tmax="drop"), conc.na=0
),
d.test[c(2, 4),]
)

# When conc.na is a number, it keeps those
d.test <- data.frame(conc=c(0, 1, NA, 2, 0), time=1:5)
d.result <- data.frame(conc=c(0, 1, 0.5, 2, 0), time=1:5)
expect_equal(clean.conc.blq(d.test$conc, d.test$time,
conc.blq=list(before.tmax="drop", after.tmax="drop"), conc.na=0.5),
d.result[2:4,])

expect_equal(
clean.conc.blq(
d.test$conc, d.test$time,
conc.blq=list(before.tmax="drop", after.tmax="drop"), conc.na=0.5
),
d.result[2:4,]
)

# It passes additional to be part of the output data frame
d.test <- data.frame(conc=c(0, 1, NA, 2, 0), time=1:5, more=6:10)
d.result <- data.frame(conc=c(0, 1, 0.5, 2, 0), time=1:5, more=6:10)
expect_equal(clean.conc.blq(d.test$conc, d.test$time,
more=d.test$more,
conc.blq=list(before.tmax="drop", after.tmax="drop"), conc.na=0.5),
d.result[2:4,])
expect_equal(
clean.conc.blq(
d.test$conc, d.test$time,
more=d.test$more,
conc.blq=list(before.tmax="drop", after.tmax="drop"), conc.na=0.5
),
d.result[2:4,]
)
d.test <- data.frame(conc=c(0, 1, NA, 2, 0), time=1:5, more=6:10)
expect_equal(clean.conc.blq(d.test$conc, d.test$time,
more=d.test$more,
conc.blq=list(before.tmax="drop", after.tmax="drop"), conc.na="drop"),
d.test[c(2,4),])

expect_equal(
clean.conc.blq(
d.test$conc, d.test$time,
more=d.test$more,
conc.blq=list(before.tmax="drop", after.tmax="drop"), conc.na="drop"
),
d.test[c(2,4),]
)
})

0 comments on commit fb0e324

Please sign in to comment.