File: test-coord-polar.r

package info (click to toggle)
r-cran-ggplot2 3.4.1%2Bdfsg-1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm
  • size: 8,748 kB
  • sloc: sh: 15; makefile: 5
file content (142 lines) | stat: -rw-r--r-- 4,438 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
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
test_that("polar distance is calculated correctly", {
  dat <- data_frame(
    theta = c(0, 2*pi,   2,   6, 6, 1,    1,  0),
    r     = c(0,    0, 0.5, 0.5, 1, 1, 0.75, .5))

  scales <- list(
    x = scale_x_continuous(limits = c(0, 2*pi)),
    y = scale_y_continuous(limits = c(0, 1))
  )
  coord <- coord_polar()
  panel_params <- coord$setup_panel_params(scales$x, scales$y)
  dists <- coord$distance(dat$theta, dat$r, panel_params)

  # dists is normalized by dividing by this value, so we'll add it back
  # The maximum length of a spiral arc, from (t,r) = (0,0) to (2*pi,1)
  maxlen <- spiral_arc_length(1 / (2 * pi), 0, 2 * pi)

  # These are the expected lengths. I think they're correct...
  expect_equal(dists,
    c(0, -1.225737494, -2, -0.5, -5, -0.25, -0.6736885011) / maxlen)

  # The picture can be visualized with:
  # ggplot(dat, aes(x=theta, y=r)) + geom_path() +
  #   geom_point(alpha=0.3) + coord_polar()
})

test_that("polar distance calculation ignores NA's", {

  # These are r and theta values; we'll swap them around for testing
  x1 <- c(0, 0.5, 0.5, NA, 1)
  x2 <- c(0,   1,   2, 0,  1)

  dists <- dist_polar(x1, x2)
  expect_equal(is.na(dists), c(FALSE, FALSE, TRUE, TRUE))
  dists <- dist_polar(x2, x1)
  expect_equal(is.na(dists), c(FALSE, FALSE, TRUE, TRUE))

  # NA on the end
  x1 <- c(0, 0.5, 0.5, 1, NA)
  x2 <- c(0,   1,   2, 0,  1)
  dists <- dist_polar(x1, x2)
  expect_equal(is.na(dists), c(FALSE, FALSE, FALSE, TRUE))
  dists <- dist_polar(x2, x1)
  expect_equal(is.na(dists), c(FALSE, FALSE, FALSE, TRUE))

  # NAs in each vector - also have NaN
  x1 <- c(0, 0.5, 0.5,  1, NA)
  x2 <- c(NaN,   1,   2, NA,  1)
  dists <- dist_polar(x1, x2)
  expect_equal(is.na(dists), c(TRUE, FALSE, TRUE, TRUE))
  dists <- dist_polar(x2, x1)
  expect_equal(is.na(dists), c(TRUE, FALSE, TRUE, TRUE))
})

test_that("clipping can be turned off and on", {
  # clip can be turned on and off
  p <- ggplot() + coord_polar()
  coord <- ggplot_build(p)$layout$coord
  expect_equal(coord$clip, "on")

  p <- ggplot() + coord_polar(clip = "off")
  coord <- ggplot_build(p)$layout$coord
  expect_equal(coord$clip, "off")
})

test_that("Inf is squished to range", {
  d <- cdata(
    ggplot(data_frame(x = "a", y = 1), aes(x, y)) +
      geom_col() +
      coord_polar() +
      annotate("text", Inf, Inf, label = "Top-Center") +
      annotate("text", -Inf, -Inf, label = "Center-Center")
  )

  # 0.4 is the upper limit of radius hardcoded in r_rescale()
  expect_equal(d[[2]]$r, 0.4)
  expect_equal(d[[2]]$theta, mapped_discrete(0))
  expect_equal(d[[3]]$r, 0)
  expect_equal(d[[3]]$theta, mapped_discrete(0))
})


# Visual tests ------------------------------------------------------------

test_that("polar coordinates draw correctly", {
  theme <- theme_test() +
    theme(
      axis.text.y = element_blank(),
      axis.title = element_blank(),
      panel.grid.major = element_line(colour = "grey90")
    )
  dat <- data_frame(x = rep(0:1, 4), y = rep(c(1, 10, 40, 80), each = 2))

  expect_doppelganger("three-concentric-circles",
    ggplot(dat, aes(x, y, group = factor(y))) +
      geom_path() +
      coord_polar() +
      theme
  )

  dat <- data_frame(
    theta = c(0, 2*pi,   2,   6, 6, 1,    1,  0),
    r     = c(0,    0, 0.5, 0.5, 1, 1, 0.75, .5),
    g     = 1:8
  )
  expect_doppelganger("Rays, circular arcs, and spiral arcs",
    ggplot(dat, aes(theta, r, colour = g)) +
      geom_path(show.legend = FALSE) +
      geom_point(colour = "black") +
      coord_polar() +
      theme
  )

  dat <- data_frame(x = LETTERS[1:3], y = 1:3)
  expect_doppelganger("rose plot with has equal spacing",
    ggplot(dat, aes(x, y)) +
      geom_bar(stat = "identity") +
      coord_polar() +
      theme
  )
  expect_doppelganger("racetrack plot: closed and no center hole",
    ggplot(dat, aes(x, y)) +
      geom_bar(stat = "identity") +
      coord_polar(theta = "y") +
      theme
  )
  expect_doppelganger("racetrack plot: closed and has center hole",
    ggplot(dat, aes(x, y)) +
      geom_bar(stat = "identity") +
      coord_polar(theta = "y") +
      scale_x_discrete(expand = c(0, 0.6)) +
      theme
  )
  expect_doppelganger("secondary axis ticks and labels",
    ggplot(dat, aes(x, y, group = factor(y))) +
      geom_blank() +
      scale_y_continuous(sec.axis = sec_axis(~. * 0.1, name = "sec y")) +
      coord_polar() +
      theme_test() +
      theme(axis.text.x = element_blank())
  )
})