File: test-matrix_apply_linter.R

package info (click to toggle)
r-cran-lintr 3.2.0-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 4,396 kB
  • sloc: sh: 13; xml: 10; makefile: 2
file content (101 lines) | stat: -rw-r--r-- 2,990 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
test_that("matrix_apply_linter skips allowed usages", {
  linter <- matrix_apply_linter()

  expect_lint("apply(x, 1, prod)", NULL, linter)

  expect_lint("apply(x, 1, function(i) sum(i[i > 0]))", NULL, linter)

  # sum as FUN argument
  expect_lint("apply(x, 1, f, sum)", NULL, linter)

  # mean() with named arguments other than na.rm is skipped because they are not
  # implemented in colMeans() or rowMeans()
  expect_lint("apply(x, 1, mean, trim = 0.2)", NULL, linter)
})

test_that("matrix_apply_linter is not implemented for complex MARGIN values", {
  linter <- matrix_apply_linter()

  # Could be implemented at some point
  expect_lint("apply(x, seq(2, 4), sum)", NULL, linter)

  # No equivalent
  expect_lint("apply(x, c(2, 4), sum)", NULL, linter)

  # Beyond the scope of static analysis
  expect_lint("apply(x, m, sum)", NULL, linter)

  expect_lint("apply(x, 1 + 2:4, sum)", NULL, linter)

})


test_that("matrix_apply_linter simple disallowed usages", {
  linter <- matrix_apply_linter()
  lint_message <- rex::rex("rowSums(x)")

  expect_lint("apply(x, 1, sum)", lint_message, linter)

  expect_lint("apply(x, MARGIN = 1, FUN = sum)", lint_message, linter)

  expect_lint("apply(x, 1L, sum)", lint_message, linter)

  expect_lint("apply(x, 1:4, sum)", rex::rex("rowSums(x, dims = 4)"), linter)

  expect_lint("apply(x, 2, sum)", rex::rex("rowSums(colSums(x))"), linter)

  expect_lint("apply(x, 2:4, sum)", rex::rex("rowSums(colSums(x), dims = 3)"), linter)

  lint_message <- rex::rex("rowMeans")

  expect_lint("apply(x, 1, mean)", lint_message, linter)

  expect_lint("apply(x, MARGIN = 1, FUN = mean)", lint_message, linter)

  # Works with extra args in mean()
  expect_lint("apply(x, 1, mean, na.rm = TRUE)", lint_message, linter)

  lint_message <- rex::rex("colMeans")

  expect_lint("apply(x, 2, mean)", lint_message, linter)

  expect_lint("apply(x, 2:4, mean)", lint_message, linter)

})

test_that("matrix_apply_linter recommendation includes na.rm if present in original call", {
  linter <- matrix_apply_linter()
  lint_message <- rex::rex("na.rm = TRUE")

  expect_lint("apply(x, 1, sum, na.rm = TRUE)", lint_message, linter)

  expect_lint("apply(x, 2, sum, na.rm = TRUE)", lint_message, linter)

  expect_lint("apply(x, 1, mean, na.rm = TRUE)", lint_message, linter)

  expect_lint("apply(x, 2, mean, na.rm = TRUE)", lint_message, linter)

  lint_message <- rex::rex("rowSums(x)")
  expect_lint("apply(x, 1, sum)", lint_message, linter)

  lint_message <- rex::rex("na.rm = foo")
  expect_lint("apply(x, 1, sum, na.rm = foo)", lint_message, linter)

})

test_that("matrix_apply_linter works with multiple lints in a single expression", {
  linter <- matrix_apply_linter()

  expect_lint(
    trim_some("{
      apply(x, 1, sum)
      apply(y, 2:4, mean, na.rm = TRUE)
    }"),
    list(
      list(rex::rex("rowSums(x)"), line_number = 2L),
      list(rex::rex("rowMeans(colMeans(y, na.rm = TRUE), dims = 3)"), line_number = 3L)
    ),
    linter
  )

})