Skip to content

Commit f67175d

Browse files
gogonzogogonzo
committed
tests
1 parent b41b946 commit f67175d

File tree

5 files changed

+176
-34
lines changed

5 files changed

+176
-34
lines changed

‎R/FilterStateChoices.R‎

Lines changed: 0 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -202,15 +202,12 @@ ChoicesFilterState <- R6::R6Class( # nolint
202202
ns <- NS(id)
203203

204204
countsmax <- as.numeric(names(private$choices))
205-
countsmin <- rep(0, length(private$choices))
206205
countsnow <- isolate(unname(table(factor(private$x_reactive(), levels = private$choices))))
207206

208-
209207
ui_input <- if (private$is_checkboxgroup()) {
210208
labels <- countBarLabels(
211209
inputId = ns("labels"),
212210
choices = as.character(private$choices),
213-
countsmin = countsmin,
214211
countsnow = countsnow,
215212
countsmax = countsmax
216213
)
@@ -277,7 +274,6 @@ ChoicesFilterState <- R6::R6Class( # nolint
277274
updateCountBarLabels(
278275
inputId = "labels",
279276
choices = as.character(private$choices),
280-
countsmin = rep(0, length(private$choices)),
281277
countsmax = as.numeric(names(private$choices)),
282278
countsnow = unname(table(factor(private$x_reactive(), levels = private$choices)))
283279
)

‎R/FilterStateLogical.R‎

Lines changed: 0 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -177,13 +177,11 @@ LogicalFilterState <- R6::R6Class( # nolint
177177
ns <- NS(id)
178178

179179
countsmax <- as.numeric(names(private$choices))
180-
countsmin <- rep(0, length(private$choices))
181180
countsnow <- isolate(unname(table(factor(private$x_reactive(), levels = private$choices))))
182181

183182
labels <- countBarLabels(
184183
inputId = ns("labels"),
185184
choices = as.character(private$choices),
186-
countsmin = countsmin,
187185
countsnow = countsnow,
188186
countsmax = countsmax
189187
)
@@ -227,7 +225,6 @@ LogicalFilterState <- R6::R6Class( # nolint
227225
updateCountBarLabels(
228226
inputId = "labels",
229227
choices = as.character(private$choices),
230-
countsmin = rep(0, length(private$choices)),
231228
countsmax = as.numeric(names(private$choices)),
232229
countsnow = unname(table(factor(private$x_reactive(), levels = private$choices)))
233230
)

‎R/count_labels.R‎

Lines changed: 15 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -7,8 +7,6 @@
77
#' @param session (`session`) object passed to function given to `shinyServer`.
88
#' @param inputId (`character(1)`) `shiny` id
99
#' @param choices (`vector`) determines label text.
10-
#' @param countsmin (`numeric`) determining minimal count of each element.
11-
#' Length should be the same as `choices`
1210
#' @param countsmax (`numeric`) determining maximal count of each element.
1311
#' Length should be the same as `choices`.
1412
#' @param countsnow (`numeric`) actual counts of each element.
@@ -24,7 +22,6 @@
2422
#' labels <- countBarLabels(
2523
#' inputId = "counts",
2624
#' choices = c("a", "b", "c"),
27-
#' countsmin = c(0, 0, 0),
2825
#' countsmax = c(20, 20, 20),
2926
#' countsnow = unname(counts)
3027
#' )
@@ -52,36 +49,36 @@
5249
#' updateCountBarLabels(
5350
#' inputId = "counts",
5451
#' choices = levels(choices),
55-
#' countsmin = c(0, 0, 0),
5652
#' countsmax = c(20, 20, 20),
5753
#' countsnow = unname(new_counts)
5854
#' )
5955
#' })
6056
#' }
6157
#' )
6258
#' @keywords internal
63-
countBarLabels <- function(inputId, choices, countsmin, countsmax, countsnow = NULL) {
59+
countBarLabels <- function(inputId, choices, countsmax, countsnow = NULL) {
6460
checkmate::assert_string(inputId)
6561
checkmate::assert_vector(choices)
66-
checkmate::assert_numeric(countsmin, len = length(choices))
6762
checkmate::assert_numeric(countsmax, len = length(choices))
6863
checkmate::assert_numeric(countsnow, len = length(choices), null.ok = TRUE)
64+
if (!is.null(countsnow)) {
65+
checkmate::assert_true(all(countsnow <= countsmax))
66+
}
6967

7068
ns <- NS(inputId)
69+
counttotal <- sum(countsmax)
7170

7271
lapply(seq_along(choices), function(i) {
7372
choice <- as.character(choices[i])
74-
countmin <- countsmin[i]
7573
countmax <- countsmax[i]
76-
countnow <- if (is.null(countsnow)) countmax else countsnow[i]
74+
countnow <- if (is.null(countsnow)) 0 else countsnow[i]
7775

7876
countBarLabel(
7977
inputId = ns(i),
8078
label = choice,
81-
countmin = countmin,
8279
countmax = countmax,
8380
countnow = countnow,
84-
counttotal = sum(countsmax)
81+
counttotal = counttotal
8582
)
8683
})
8784
}
@@ -92,21 +89,20 @@ countBarLabels <- function(inputId, choices, countsmin, countsmax, countsnow = N
9289
#' @param session (`session`) object passed to function given to `shinyServer`.
9390
#' @param inputId (`character(1)`) `shiny` id
9491
#' @param label (`character(1)`) Text to display followed by counts
95-
#' @param countmin (`numeric(1)`) minimal possible count for a single item.
9692
#' @param countmax (`numeric(1)`) maximal possible count for a single item.
9793
#' @param countnow (`numeric(1)`) current count of a single item.
9894
#' @param counttotal (`numeric(1)`) total count to make whole progress bar
9995
#' taking part of the container. Ratio between `countmax / counttotal`
10096
#' determines `<style="width: <countmax / counttotal>%""`.
10197
#' @return `shiny.tag` object with a progress bar and a label.
10298
#' @keywords internal
103-
countBarLabel <- function(inputId, label, countmin, countmax, countnow = NULL, counttotal = countmax) {
99+
countBarLabel <- function(inputId, label, countmax, countnow = NULL, counttotal = countmax) {
104100
checkmate::assert_string(inputId)
105101
checkmate::assert_string(label)
106-
checkmate::assert_number(countmin)
107102
checkmate::assert_number(countmax)
108-
checkmate::assert_number(countnow, null.ok = TRUE)
109-
checkmate::assert_number(counttotal)
103+
checkmate::assert_number(countnow, null.ok = TRUE, upper = countmax)
104+
checkmate::assert_number(counttotal, lower = countmax)
105+
110106

111107
label_html <- countLabel(inputId = inputId, label = label, countmax = countmax, countnow = countnow)
112108
progress_html <- countBar(inputId = inputId, countmax = countmax, countnow = countnow, counttotal = counttotal)
@@ -154,18 +150,16 @@ countLabel <- function(inputId, label, countmax, countnow = NULL) {
154150

155151
#' @rdname countBarLabels
156152
updateCountBarLabels <- function(session = getDefaultReactiveDomain(), inputId, choices,
157-
countsmin, countsmax, countsnow = NULL) {
153+
countsmax, countsnow = NULL) {
158154
checkmate::assert_string(inputId)
159155
checkmate::assert_vector(choices)
160-
checkmate::assert_numeric(countsmin, len = length(choices))
161156
checkmate::assert_numeric(countsmax, len = length(choices))
162157
checkmate::assert_numeric(countsnow, len = length(choices), null.ok = TRUE)
163158

164159
ns <- NS(inputId)
165160
counttotal <- sum(countsmax)
166161
lapply(seq_along(choices), function(i) {
167162
choice <- choices[i]
168-
countmin <- countsmin[i]
169163
countmax <- countsmax[i]
170164
countnow <- if (is.null(countsnow)) countmax else countsnow[i]
171165
updateCountLabel(
@@ -176,7 +170,6 @@ updateCountBarLabels <- function(session = getDefaultReactiveDomain(), inputId,
176170
)
177171
updateCountBar(
178172
inputId = ns(i),
179-
countmin = countmin,
180173
countmax = countmax,
181174
countnow = countnow,
182175
counttotal = counttotal
@@ -187,10 +180,9 @@ updateCountBarLabels <- function(session = getDefaultReactiveDomain(), inputId,
187180

188181
#' @rdname countBarLabel
189182
updateCountBarLabel <- function(session = getDefaultReactiveDomain(), inputId, label,
190-
countmin, countmax, countnow = NULL, counttotal) {
183+
countmax, countnow = NULL, counttotal) {
191184
checkmate::assert_string(inputId)
192185
checkmate::assert_string(label)
193-
checkmate::assert_number(countmin)
194186
checkmate::assert_number(countmax)
195187
checkmate::assert_number(countnow, null.ok = TRUE)
196188
checkmate::assert_number(counttotal)
@@ -199,7 +191,7 @@ updateCountBarLabel <- function(session = getDefaultReactiveDomain(), inputId, l
199191
if (is.null(countnow)) countnow <- countmax
200192

201193
updateCountLabel(inputId = inputId, label = label, countmax = countmax, countnow = countnow)
202-
updateCountBar(inputId = inputId, countmin = countmin, countmax = countmax, countnow = countnow, counttotal = counttotal)
194+
updateCountBar(inputId = inputId, countmax = countmax, countnow = countnow, counttotal = counttotal)
203195

204196
invisible(NULL)
205197
}
@@ -223,9 +215,8 @@ updateCountLabel <- function(session = getDefaultReactiveDomain(), inputId, labe
223215
}
224216

225217
#' @rdname countBarLabel
226-
updateCountBar <- function(session = getDefaultReactiveDomain(), inputId, countmin, countmax, countnow, counttotal) {
218+
updateCountBar <- function(session = getDefaultReactiveDomain(), inputId, countmax, countnow, counttotal) {
227219
checkmate::assert_string(inputId)
228-
checkmate::assert_number(countmin)
229220
checkmate::assert_number(countmax)
230221
checkmate::assert_number(countnow, null.ok = TRUE)
231222
checkmate::assert_number(counttotal)
@@ -234,7 +225,6 @@ updateCountBar <- function(session = getDefaultReactiveDomain(), inputId, countm
234225
type = "updateCountBar",
235226
message = list(
236227
id = session$ns(inputId),
237-
countmin = countmin,
238228
countmax = countmax,
239229
countnow = countnow,
240230
counttotal = counttotal

‎man/countBarLabels.Rd‎

Lines changed: 0 additions & 2 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎tests/testthat/test-count_labels.R‎

Lines changed: 161 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -149,3 +149,164 @@ testthat::test_that("countBar returns a div with class and two progressbars", {
149149
out <- rapply(countBar(inputId = "a", countmax = countmax, countnow = countnow, counttotal), unclass, how = "list")
150150
testthat::expect_identical(out, expected)
151151
})
152+
153+
# countBarLabel ------------
154+
testthat::test_that("countBarLabel requires InputId to be a character(1)", {
155+
testthat::expect_no_error(countBarLabel(inputId = "a", label = "a", countmax = 50))
156+
testthat::expect_error(countBarLabel(label = "a", countmax = 50), "inputId")
157+
testthat::expect_error(countBarLabel(inputId = NULL, label = "a", countmax = 50), "inputId")
158+
testthat::expect_error(countBarLabel(inputId = character(0), label = "a", countmax = 50), "inputId")
159+
testthat::expect_error(countBarLabel(inputId = 1L, label = "a", countmax = 50), "inputId")
160+
})
161+
162+
testthat::test_that("countBarLabel requires label to be a character(1)", {
163+
testthat::expect_no_error(countBarLabel(inputId = "a", label = "a", countmax = 50))
164+
testthat::expect_error(countBarLabel(inputId = "a", label = character(0), countmax = 50), "label")
165+
testthat::expect_error(countBarLabel(inputId = "a", label = 1, countmax = 50), "label")
166+
})
167+
168+
testthat::test_that("countBarLabel requires countmax to be a numeric(1)", {
169+
testthat::expect_no_error(countBarLabel(inputId = "a", label = "a", countmax = 100))
170+
testthat::expect_error(countBarLabel(inputId = "a", label = "a", countmax = "100"), "countmax")
171+
testthat::expect_error(countBarLabel(inputId = "a", label = "a", countmax = numeric(0)), "countmax")
172+
})
173+
174+
testthat::test_that("countBarLabel requires countnow to be a numeric(1), NULL or missing", {
175+
testthat::expect_no_error(countBarLabel(inputId = "a", label = "a", countmax = 100, countnow = 1))
176+
testthat::expect_no_error(countBarLabel(inputId = "a", label = "a", countmax = 100, countnow = NULL))
177+
testthat::expect_no_error(countBarLabel(inputId = "a", label = "a", countmax = 100))
178+
testthat::expect_error(countBarLabel(inputId = "a", label = "a", countmax = 100, countnow = "50"), "countnow")
179+
testthat::expect_error(countBarLabel(inputId = "a", label = "a", countmax = 100, countnow = numeric(0)), "countnow")
180+
})
181+
182+
testthat::test_that("countBarLabel requires counttotal to be a numeric(1) or missing", {
183+
testthat::expect_no_error(countBarLabel(inputId = "a", label = "a", countmax = 100, counttotal = 200))
184+
testthat::expect_no_error(countBarLabel(inputId = "a", label = "a", countmax = 100))
185+
testthat::expect_error(countBarLabel(inputId = "a", label = "a", countmax = 100, counttotal = "200"), "counttotal")
186+
testthat::expect_error(
187+
countBarLabel(inputId = "a", label = "a", countmax = 100, counttotal = numeric(0)), "counttotal"
188+
)
189+
})
190+
191+
testthat::test_that("countBarLabel returns a div containing a progress bar and a label", {
192+
label <- "a"
193+
countmax <- 150
194+
countnow <- 50
195+
counttotal <- 200
196+
197+
out <- countBarLabel(inputId = "a", label = label, countmax = countmax, countnow = countnow, counttotal = counttotal)
198+
199+
expected <- tags$div(
200+
countBar(inputId = "a", countmax = countmax, countnow = countnow, counttotal = counttotal),
201+
countLabel(inputId = "a", label = label, countmax = countmax, countnow = countnow)
202+
)
203+
testthat::expect_identical(out, expected)
204+
})
205+
206+
testthat::test_that("countBarLabel sets counttotal to countmax when missing", {
207+
out <- countBarLabel(inputId = "a", label = "a", countmax = 100, countnow = 50)
208+
expected <- tags$div(
209+
countBar(inputId = "a", countmax = 100, countnow = 50, counttotal = 100),
210+
countLabel(inputId = "a", label = label, countmax = 100, countnow = 50)
211+
)
212+
testthat::expect_identical(out, expected)
213+
})
214+
215+
# countBarLabels -----
216+
countsmax <- c(3, 7, 10)
217+
choices <- c("a", "b", "c")
218+
countsnow <- c(2, 6, 9)
219+
220+
testthat::test_that("countBarLabels requires InputId to be a character(1)", {
221+
testthat::expect_no_error(
222+
countBarLabels(inputId = "a", choices = choices, countsmax = countsmax, countsnow = countsnow)
223+
)
224+
testthat::expect_error(
225+
countBarLabels(inputId = NULL, choices = choices, countsmax = countsmax, countsnow = countsnow),
226+
"inputId"
227+
)
228+
testthat::expect_error(
229+
countBarLabels(inputId = character(0), choices = choices, countsmax = countsmax, countsnow = countsnow),
230+
"inputId"
231+
)
232+
testthat::expect_error(
233+
countBarLabels(inputId = 1, choices = choices, countsmax = countsmax, countsnow = countsnow),
234+
"inputId"
235+
)
236+
testthat::expect_error(
237+
countBarLabels(choices = choices, countsmax = countsmax, countsnow = countsnow),
238+
"inputId"
239+
)
240+
})
241+
242+
testthat::test_that("countBarLabels requires choices to be a vector", {
243+
testthat::expect_no_error(
244+
countBarLabels(inputId = "a", choices = choices, countsmax = countsmax, countsnow = countsnow)
245+
)
246+
testthat::expect_no_error(
247+
countBarLabels(inputId = "a", choices = c(1, 2, 3), countsmax = countsmax, countsnow = countsnow),
248+
)
249+
testthat::expect_error(
250+
countBarLabels(inputId = "a", countsmax = countsmax, countsnow = countsnow),
251+
"choices"
252+
)
253+
254+
testthat::expect_no_error(countBarLabels(inputId = "a", label = "a", countmax = 100))
255+
testthat::expect_error(countBarLabels(inputId = "a", label = "a", countmax = "100"), "countmax")
256+
testthat::expect_error(countBarLabels(inputId = "a", label = "a", countmax = numeric(0)), "countmax")
257+
})
258+
259+
testthat::test_that("countBarLabels requires countsmax to be a numeric of the same length as choices", {
260+
testthat::expect_no_error(
261+
countBarLabels(inputId = "a", choices = choices, countsmax = countsmax, countsnow = countsnow)
262+
)
263+
testthat::expect_error(
264+
countBarLabels(inputId = "a", choices = choices, countsnow = countsnow),
265+
"countsmax"
266+
)
267+
testthat::expect_error(
268+
countBarLabels(inputId = "a", choices = choices, countsmax = as.character(countsmax), countsnow = countsnow),
269+
"countsmax"
270+
)
271+
testthat::expect_error(
272+
countBarLabels(inputId = "a", choices = choices, countsmax = c(3, 7), countsnow = countsnow),
273+
"countsmax"
274+
)
275+
})
276+
277+
278+
testthat::test_that("countBarLabels requires counstnow to be a numeric lower than countsmax, NULL or missing", {
279+
testthat::expect_no_error(
280+
countBarLabels(inputId = "a", choices = choices, countsmax = countsmax, countsnow = countsnow)
281+
)
282+
testthat::expect_no_error(countBarLabels(inputId = "a", choices = choices, countsmax = countsmax))
283+
testthat::expect_error(
284+
countBarLabels(inputId = "a", choices = choices, countsmax = countsmax, countsnow = c(0, 0)),
285+
"countsmax"
286+
)
287+
testthat::expect_error(
288+
countBarLabels(inputId = "a", choices = choices, countsmax = countsmax, countsnow = c(1, 20, 2)),
289+
"countsmax"
290+
)
291+
testthat::expect_error(
292+
countBarLabels(inputId = "a", choices = choices, countsmax = countsmax, countsnow = as.character(countsnow)),
293+
"countsmax"
294+
)
295+
})
296+
297+
testthat::test_that("countBarLabels returns a list of countBarLabel(s)", {
298+
out <- countBarLabels(inputId = "a", choices = choices, countsmax = countsmax, countsnow = countsnow)
299+
300+
ns <- NS("a")
301+
expected <- lapply(seq_along(choices), function(i) {
302+
countBarLabel(
303+
inputId = ns(i),
304+
label = choices[i],
305+
countmax = countsmax[i],
306+
countnow = countsnow[i],
307+
counttotal = sum(countsmax)
308+
)
309+
})
310+
311+
testthat::expect_identical(out, expected)
312+
})

0 commit comments

Comments
 (0)