19
19
# ' in accordance with the computed `theta` position. If `FALSE` (default),
20
20
# ' no such transformation is performed. Can be useful to rotate text geoms in
21
21
# ' alignment with the coordinates.
22
- # ' @param inner.radius A `numeric` between 0 and 1 setting the size of a inner.radius hole.
22
+ # ' @param inner.radius A `numeric` between 0 and 1 setting the size of a
23
+ # ' inner radius hole.
24
+ # ' @param reverse A string giving which directions to reverse. `"none"`
25
+ # ' (default) keep directions as is. `"theta"` reverses the angle and `"r"`
26
+ # ' reverses the radius. `"thetar"` reverses both the angle and the radius.
23
27
# ' @param r_axis_inside,rotate_angle `r lifecycle::badge("deprecated")`
24
28
# '
25
29
# ' @note
39
43
coord_radial <- function (theta = " x" ,
40
44
start = 0 , end = NULL ,
41
45
expand = TRUE ,
42
- direction = 1 ,
46
+ direction = deprecated() ,
43
47
clip = " off" ,
44
48
r.axis.inside = NULL ,
45
49
rotate.angle = FALSE ,
46
50
inner.radius = 0 ,
51
+ reverse = " none" ,
47
52
r_axis_inside = deprecated(),
48
53
rotate_angle = deprecated()) {
49
54
@@ -59,34 +64,46 @@ coord_radial <- function(theta = "x",
59
64
)
60
65
rotate.angle <- rotate_angle
61
66
}
67
+ if (lifecycle :: is_present(direction )) {
68
+ deprecate_warn0(
69
+ " 3.5.2" , " coord_radial(direction)" , " coord_radial(reverse)"
70
+ )
71
+ reverse <- switch (reverse , " r" = " thetar" , " theta" )
72
+ }
62
73
63
74
theta <- arg_match0(theta , c(" x" , " y" ))
64
75
r <- if (theta == " x" ) " y" else " x"
65
76
if (! is.numeric(r.axis.inside )) {
66
77
check_bool(r.axis.inside , allow_null = TRUE )
67
78
}
79
+ reverse <- arg_match0(reverse , c(" theta" , " thetar" , " r" , " none" ))
68
80
69
81
check_bool(rotate.angle )
70
82
check_number_decimal(start , allow_infinite = FALSE )
71
83
check_number_decimal(end , allow_infinite = FALSE , allow_null = TRUE )
72
84
check_number_decimal(inner.radius , min = 0 , max = 1 , allow_infinite = FALSE )
73
85
74
- end <- end %|| % (start + 2 * pi )
75
- if (start > end ) {
76
- n_rotate <- ((start - end ) %/% (2 * pi )) + 1
77
- start <- start - n_rotate * 2 * pi
86
+ arc <- c( start , end %|| % (start + 2 * pi ) )
87
+ if (arc [ 1 ] > arc [ 2 ] ) {
88
+ n_rotate <- ((arc [ 1 ] - arc [ 2 ] ) %/% (2 * pi )) + 1
89
+ arc [ 1 ] <- arc [ 1 ] - n_rotate * 2 * pi
78
90
}
79
- r.axis.inside <- r.axis.inside %|| % ! (abs(end - start ) > = 1.999 * pi )
91
+ arc <- switch (reverse , thetar = , theta = rev(arc ), arc )
92
+
93
+ r.axis.inside <- r.axis.inside %|| % ! (abs(arc [2 ] - arc [1 ]) > = 1.999 * pi )
94
+
95
+ inner.radius <- c(inner.radius , 1 ) * 0.4
96
+ inner.radius <- switch (reverse , thetar = , r = rev , identity )(inner.radius )
80
97
81
98
ggproto(NULL , CoordRadial ,
82
99
theta = theta ,
83
100
r = r ,
84
- arc = c( start , end ) ,
101
+ arc = arc ,
85
102
expand = expand ,
86
- direction = sign( direction ) ,
103
+ reverse = reverse ,
87
104
r_axis_inside = r.axis.inside ,
88
105
rotate_angle = rotate.angle ,
89
- inner_radius = c( inner.radius , 1 ) * 0.4 ,
106
+ inner_radius = inner.radius ,
90
107
clip = clip
91
108
)
92
109
}
@@ -107,16 +124,10 @@ CoordRadial <- ggproto("CoordRadial", Coord,
107
124
arc <- details $ arc %|| % c(0 , 2 * pi )
108
125
if (self $ theta == " x" ) {
109
126
r <- rescale(y , from = details $ r.range , to = self $ inner_radius / 0.4 )
110
- theta <- theta_rescale_no_clip(
111
- x , details $ theta.range ,
112
- arc , self $ direction
113
- )
127
+ theta <- theta_rescale_no_clip(x , details $ theta.range , arc )
114
128
} else {
115
129
r <- rescale(x , from = details $ r.range , to = self $ inner_radius / 0.4 )
116
- theta <- theta_rescale_no_clip(
117
- y , details $ theta.range ,
118
- arc , self $ direction
119
- )
130
+ theta <- theta_rescale_no_clip(y , details $ theta.range , arc )
120
131
}
121
132
122
133
dist_polar(r , theta )
@@ -200,10 +211,10 @@ CoordRadial <- ggproto("CoordRadial", Coord,
200
211
201
212
r_position <- c(" left" , " right" )
202
213
# If both opposite direction and opposite position, don't flip
203
- if (xor(self $ direction == - 1 , opposite_r )) {
214
+ if (xor(self $ reverse %in% c( " thetar " , " theta " ) , opposite_r )) {
204
215
r_position <- rev(r_position )
205
216
}
206
- arc <- rad2deg(panel_params $ axis_rotation ) * self $ direction
217
+ arc <- rad2deg(panel_params $ axis_rotation )
207
218
if (opposite_r ) {
208
219
arc <- rev(arc )
209
220
}
@@ -284,10 +295,7 @@ CoordRadial <- ggproto("CoordRadial", Coord,
284
295
arc <- panel_params $ arc %|| % c(0 , 2 * pi )
285
296
286
297
data $ r <- r_rescale(data $ r , panel_params $ r.range , panel_params $ inner_radius )
287
- data $ theta <- theta_rescale(
288
- data $ theta , panel_params $ theta.range ,
289
- arc , self $ direction
290
- )
298
+ data $ theta <- theta_rescale(data $ theta , panel_params $ theta.range , arc )
291
299
data $ x <- rescale(data $ r * sin(data $ theta ) + 0.5 , from = bbox $ x )
292
300
data $ y <- rescale(data $ r * cos(data $ theta ) + 0.5 , from = bbox $ y )
293
301
@@ -313,70 +321,12 @@ CoordRadial <- ggproto("CoordRadial", Coord,
313
321
},
314
322
315
323
render_bg = function (self , panel_params , theme ) {
316
-
317
- bbox <- panel_params $ bbox %|| % list (x = c(0 , 1 ), y = c(0 , 1 ))
318
- arc <- panel_params $ arc %|| % c(0 , 2 * pi )
319
- dir <- self $ direction
320
- inner_radius <- panel_params $ inner_radius
321
-
322
- theta_lim <- panel_params $ theta.range
323
- theta_maj <- panel_params $ theta.major
324
- theta_min <- setdiff(panel_params $ theta.minor , theta_maj )
325
-
326
- if (length(theta_maj ) > 0 ) {
327
- theta_maj <- theta_rescale(theta_maj , theta_lim , arc , dir )
328
- }
329
- if (length(theta_min ) > 0 ) {
330
- theta_min <- theta_rescale(theta_min , theta_lim , arc , dir )
331
- }
332
-
333
- theta_fine <- theta_rescale(seq(0 , 1 , length.out = 100 ), c(0 , 1 ), arc , dir )
334
- r_fine <- r_rescale(panel_params $ r.major , panel_params $ r.range ,
335
- panel_params $ inner_radius )
336
-
337
- # This gets the proper theme element for theta and r grid lines:
338
- # panel.grid.major.x or .y
339
- grid_elems <- paste(
340
- c(" panel.grid.major." , " panel.grid.minor." , " panel.grid.major." ),
341
- c(self $ theta , self $ theta , self $ r ), sep = " "
324
+ panel_params <- switch (
325
+ self $ theta ,
326
+ x = rename(panel_params , c(theta = " x" , r = " y" )),
327
+ y = rename(panel_params , c(theta = " y" , r = " x" ))
342
328
)
343
- grid_elems <- lapply(grid_elems , calc_element , theme = theme )
344
- majortheta <- paste(" panel.grid.major." , self $ theta , sep = " " )
345
- minortheta <- paste(" panel.grid.minor." , self $ theta , sep = " " )
346
- majorr <- paste(" panel.grid.major." , self $ r , sep = " " )
347
-
348
- bg_element <- calc_element(" panel.background" , theme )
349
- if (! inherits(bg_element , " element_blank" )) {
350
- background <- data_frame0(
351
- x = c(Inf , Inf , - Inf , - Inf ),
352
- y = c(Inf , - Inf , - Inf , Inf )
353
- )
354
- background <- coord_munch(self , background , panel_params , is_closed = TRUE )
355
- bg_gp <- gg_par(
356
- lwd = bg_element $ linewidth ,
357
- col = bg_element $ colour , fill = bg_element $ fill ,
358
- lty = bg_element $ linetype
359
- )
360
- background <- polygonGrob(
361
- x = background $ x , y = background $ y ,
362
- gp = bg_gp
363
- )
364
- } else {
365
- background <- zeroGrob()
366
- }
367
-
368
- ggname(" grill" , grobTree(
369
- background ,
370
- theta_grid(theta_maj , grid_elems [[1 ]], inner_radius , bbox ),
371
- theta_grid(theta_min , grid_elems [[2 ]], inner_radius , bbox ),
372
- element_render(
373
- theme , majorr , name = " radius" ,
374
- x = rescale(outer(sin(theta_fine ), r_fine ) + 0.5 , from = bbox $ x ),
375
- y = rescale(outer(cos(theta_fine ), r_fine ) + 0.5 , from = bbox $ y ),
376
- id.lengths = rep(length(theta_fine ), length(r_fine )),
377
- default.units = " native"
378
- )
379
- ))
329
+ guide_grid(theme , panel_params , self , square = FALSE )
380
330
},
381
331
382
332
render_fg = function (self , panel_params , theme ) {
@@ -395,8 +345,8 @@ CoordRadial <- ggproto("CoordRadial", Coord,
395
345
bbox <- panel_params $ bbox
396
346
dir <- self $ direction
397
347
rot <- panel_params $ axis_rotation
398
- rot <- if ( dir == 1 ) rot else rev(rot )
399
- rot <- dir * rad2deg(- rot )
348
+ rot <- switch ( self $ reverse , thetar = , theta = rev(rot ), rot )
349
+ rot <- rad2deg(- rot )
400
350
401
351
left <- panel_guides_grob(panel_params $ guides , position = " left" , theme )
402
352
left <- rotate_r_axis(left , rot [1 ], bbox , " left" )
@@ -540,6 +490,7 @@ polar_bbox <- function(arc, margin = c(0.05, 0.05, 0.05, 0.05),
540
490
if (abs(diff(arc )) > = 2 * pi ) {
541
491
return (list (x = c(0 , 1 ), y = c(0 , 1 )))
542
492
}
493
+ arc <- sort(arc )
543
494
544
495
# X and Y position of the sector arc ends
545
496
xmax <- 0.5 * sin(arc ) + 0.5
0 commit comments