Skip to content

Commit 74b64c4

Browse files
rwoldfordrwoldford
authored
Merge pull request #174 from z267xu/master
loon 1.3.9
2 parents bdae199 + 16fd347 commit 74b64c4

File tree

483 files changed

+22805
-53920
lines changed

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

483 files changed

+22805
-53920
lines changed

‎R/DESCRIPTION

+1-1
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
Package: loon
22
Type: Package
33
Title: Interactive Statistical Data Visualization
4-
Version: 1.3.8
4+
Version: 1.3.9
55
Date: 2021-09-20
66
Authors@R: c(person(given = "Adrian", family = "Waddell",
77
email = "adrian@waddell.ch",

‎R/NEWS.md

+8
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,11 @@
1+
# loon 1.3.9
2+
3+
Some minor changes in facets:
4+
5+
- in facet_wrap, as the number of facet variables increase, the layout pattern is not consistent (e.g., one variable: the layout is by row; more than one variables: the layout is by column).
6+
7+
- fix typos: "extent" --> "extend"
8+
19
# loon 1.3.8
210

311
* Removed the vignette "Example analysis" on the minority data to make room for a new vignette "Publishing loon plots"

‎R/R/facet_layout.R

+48-43
Original file line numberDiff line numberDiff line change
@@ -85,14 +85,14 @@ facet_grid_layout <- function(plots,
8585

8686
if(length(by) == 2) {
8787

88-
colsLabel <- subtitles[all.vars(by[[2]])]
88+
colsLabel <- Filter(Negate(is.null), subtitles[all.vars(by[[2]])])
8989
rowsLabel <- list()
9090

9191
} else {
9292
# vars before tilde
93-
rowsLabel <- subtitles[all.vars(by[[2]])]
93+
rowsLabel <- Filter(Negate(is.null), subtitles[all.vars(by[[2]])])
9494
# vars after tilde
95-
colsLabel <- subtitles[all.vars(by[[3]])]
95+
colsLabel <- Filter(Negate(is.null), subtitles[all.vars(by[[3]])])
9696
}
9797

9898
} else {
@@ -176,17 +176,11 @@ facet_grid_layout <- function(plots,
176176

177177
}
178178
}
179-
180-
181179
} else {
182180

183181
for(i in seq(ncolsLabel)) {
184182
for(j in seq(nrowsLabel)) {
185183
id <- (i - 1) * nrowsLabel + j
186-
# plotid <- get_plot_id(layout_orders[id],
187-
# plot_names,
188-
# sep = sep)
189-
# plot_id <- c(plot_id, plotid)
190184
new_names <- c(new_names, paste0("x", j, "y", i))
191185
tkgrid(plots[[id]],
192186
row = (j - 1) * span + row_start_pos + title_pos, # leave space for labels
@@ -224,15 +218,16 @@ facet_grid_layout <- function(plots,
224218
rep(fluid_colsLabel[[fluid_colsLabel_name]], prod(lengths(colsLabel[1:(j - 1)])))
225219
}
226220
fluid_colsLabel[fluid_colsLabel_name] <<- NULL
227-
extent <- prod(lengths(fluid_colsLabel))
228-
columnspan <- extent * span
221+
extend <- prod(lengths(fluid_colsLabel))
222+
columnspan <- extend * span
229223

230224
name <- column_names[j]
231225
label <- if(is.null(name)) {
232226
col
233227
} else {
234228
if(grepl("color", name)) {
235-
l_colorName(col, error = FALSE)
229+
l_colorName(col, error = FALSE,
230+
precise = TRUE)
236231
} else {
237232
col
238233
}
@@ -244,7 +239,7 @@ facet_grid_layout <- function(plots,
244239
tkcolname <- as.character(tcltk::tcl('label',
245240
as.character(l_subwin(parent,
246241
paste0('columnlabel-', columnLabelLocation, '-',
247-
'x', j, 'y', i, 'extent', extent))),
242+
'x', j, 'y', i, 'extend', extend))),
248243
text = text,
249244
bg = labelBackground,
250245
fg = labelForeground,
@@ -296,8 +291,8 @@ facet_grid_layout <- function(plots,
296291

297292
name <- row_names[i]
298293

299-
extent <- prod(lengths(fluid_rowsLabel))
300-
rowspan <- extent * span
294+
extend <- prod(lengths(fluid_rowsLabel))
295+
rowspan <- extend * span
301296
for(j in seq(length(row))) {
302297
# row index
303298
label <- row[j]
@@ -307,7 +302,8 @@ facet_grid_layout <- function(plots,
307302
ifelse(
308303
grepl("color", name),
309304
{
310-
l_colorName(label, error = FALSE)
305+
l_colorName(label, error = FALSE,
306+
precise = TRUE)
311307
},
312308
{
313309
label
@@ -316,7 +312,7 @@ facet_grid_layout <- function(plots,
316312
tkrowname <- as.character(tcltk::tcl('label',
317313
as.character(l_subwin(parent,
318314
paste0('rowlabel-', rowLabelLocation, '-',
319-
'x', j, 'y', i, 'extent', extent))),
315+
'x', j, 'y', i, 'extend', extend))),
320316
text = paste(paste0(" ", strsplit(text, "")[[1]], " "), collapse = "\n"),
321317
bg = labelBackground,
322318
fg = labelForeground,
@@ -325,14 +321,14 @@ facet_grid_layout <- function(plots,
325321
if(rowLabelLocation == "right")
326322
tkgrid(tkrowname,
327323
row = (j - 1) * rowspan + row_start_pos + title_pos,
328-
column= -(i - 1) + ncolsLabel * span + len_colsLabel + ylabel_pos,
324+
column= -(i - len_rowsLabel) + ncolsLabel * span + len_colsLabel + ylabel_pos,
329325
rowspan = rowspan,
330326
columnspan = 1,
331327
sticky="nesw")
332328
else
333329
tkgrid(tkrowname,
334330
row = (j - 1) * rowspan + row_start_pos + title_pos,
335-
column= (i - 1)+ ylabel_pos,
331+
column= (i - 1) + ylabel_pos,
336332
rowspan = rowspan,
337333
columnspan = 1,
338334
sticky="nesw")
@@ -475,7 +471,7 @@ facet_wrap_layout <- function(plots,
475471
nrow = NULL,
476472
ncol = NULL,
477473
labelLocation = "top",
478-
byrow = FALSE,
474+
byrow = TRUE,
479475
swapAxes = FALSE,
480476
labelBackground = l_getOption("facetLabelBackground"),
481477
labelForeground = l_getOption("foreground"),
@@ -500,8 +496,13 @@ facet_wrap_layout <- function(plots,
500496

501497
if (is.null(nrow) && is.null(ncol)) {
502498
nm <- grDevices::n2mfrow(N)
503-
nrow <- nm[2]
504-
ncol <- nm[1]
499+
if (byrow) {
500+
nrow <- nm[2]
501+
ncol <- nm[1]
502+
} else {
503+
nrow <- nm[1]
504+
ncol <- nm[2]
505+
}
505506
}
506507

507508
# ** respect to the number of columns **
@@ -570,16 +571,18 @@ facet_wrap_layout <- function(plots,
570571
split <- paste0("[", sep, "]")
571572
if(byrow) {
572573

573-
for(j in seq(ncol)) {
574-
for(i in seq(nrow)) {
574+
for(i in seq(nrow)) {
575+
for(j in seq(ncol)) {
575576

576-
plotid <- (j - 1) * nrow + i
577+
plotid <- (i - 1) * ncol + j
577578
if(plotid > N) break()
578579

579580
new_names <- c(new_names, paste0("x", i, "y", j))
580581

581582
label <- strsplit(plot_names[plotid], split = split)[[1]]
582-
stopifnot(length(label) == label_span)
583+
stopifnot(
584+
length(label) == label_span
585+
)
583586

584587
if(labelLocation == "top") {
585588
# pack plots
@@ -589,6 +592,7 @@ facet_wrap_layout <- function(plots,
589592
rowspan = plots_span,
590593
columnspan = plots_span,
591594
sticky="nesw")
595+
592596
# pack labels
593597
lapply(seq(length(label)),
594598
function(k) {
@@ -598,10 +602,11 @@ facet_wrap_layout <- function(plots,
598602
text <- if(is.null(name)) {
599603
l
600604
} else {
605+
601606
ifelse(
602607
grepl("color", name), {
603-
l_colorName(l, error = FALSE)
604-
608+
l_colorName(l, error = FALSE,
609+
precise = TRUE)
605610
}, {
606611
l
607612
})
@@ -617,7 +622,7 @@ facet_wrap_layout <- function(plots,
617622
relief = labelRelief))
618623
tkgrid(tklabel,
619624
row = (i - 1) * span + (k - 1) + title_pos,
620-
column = (j - 1) * plots_span + ylabel_pos,
625+
column = (j - 1) * plots_span+ ylabel_pos,
621626
rowspan = 1,
622627
columnspan = plots_span,
623628
sticky="nesw")
@@ -644,7 +649,8 @@ facet_wrap_layout <- function(plots,
644649

645650
ifelse(
646651
grepl("color", name), {
647-
l_colorName(l, error = FALSE)
652+
l_colorName(l, error = FALSE,
653+
precise = TRUE)
648654
}, {
649655
l
650656
})
@@ -673,18 +679,16 @@ facet_wrap_layout <- function(plots,
673679

674680
} else {
675681

676-
for(i in seq(nrow)) {
677-
for(j in seq(ncol)) {
682+
for(j in seq(ncol)) {
683+
for(i in seq(nrow)) {
678684

679-
plotid <- (i - 1) * ncol + j
685+
plotid <- (j - 1) * nrow + i
680686
if(plotid > N) break()
681687

682688
new_names <- c(new_names, paste0("x", i, "y", j))
683689

684690
label <- strsplit(plot_names[plotid], split = split)[[1]]
685-
stopifnot(
686-
length(label) == label_span
687-
)
691+
stopifnot(length(label) == label_span)
688692

689693
if(labelLocation == "top") {
690694
# pack plots
@@ -694,7 +698,6 @@ facet_wrap_layout <- function(plots,
694698
rowspan = plots_span,
695699
columnspan = plots_span,
696700
sticky="nesw")
697-
698701
# pack labels
699702
lapply(seq(length(label)),
700703
function(k) {
@@ -704,10 +707,11 @@ facet_wrap_layout <- function(plots,
704707
text <- if(is.null(name)) {
705708
l
706709
} else {
707-
708710
ifelse(
709711
grepl("color", name), {
710-
l_colorName(l, error = FALSE)
712+
l_colorName(l, error = FALSE,
713+
precise = TRUE)
714+
711715
}, {
712716
l
713717
})
@@ -723,7 +727,7 @@ facet_wrap_layout <- function(plots,
723727
relief = labelRelief))
724728
tkgrid(tklabel,
725729
row = (i - 1) * span + (k - 1) + title_pos,
726-
column = (j - 1) * plots_span+ ylabel_pos,
730+
column = (j - 1) * plots_span + ylabel_pos,
727731
rowspan = 1,
728732
columnspan = plots_span,
729733
sticky="nesw")
@@ -750,7 +754,8 @@ facet_wrap_layout <- function(plots,
750754

751755
ifelse(
752756
grepl("color", name), {
753-
l_colorName(l, error = FALSE)
757+
l_colorName(l, error = FALSE,
758+
precise = TRUE)
754759
}, {
755760
l
756761
})
@@ -776,7 +781,6 @@ facet_wrap_layout <- function(plots,
776781
} else stop("Unknown 'labelLocation'. It can only be one of 'top' or 'bottom'.")
777782
}
778783
}
779-
780784
}
781785

782786
# pack title
@@ -907,7 +911,8 @@ facet_separate_layout <- function(plots,
907911
function(name) {
908912

909913
subtitle <- l_colorName(strsplit(name, split = split)[[1]],
910-
error = FALSE)
914+
error = FALSE,
915+
precise = TRUE)
911916
paste(c(title, subtitle), collapse = "\n")
912917
}, character(1))
913918
}

‎R/R/get_facets.R

+8-2
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@ get_facets <- function(widget, ...) {
44

55
get_facets.loon <- function(widget, by, on,
66
parent = NULL,
7+
layout = "grid",
78
linkingGroup, inheritLayers = TRUE, separate = FALSE,
89
bySubstitute, ...) {
910

@@ -39,6 +40,7 @@ get_facets.loon <- function(widget, by, on,
3940

4041
splited <- splitFun(widget = widget,
4142
data = data,
43+
layout = layout,
4244
by = by,
4345
on = on,
4446
column_names = column_names,
@@ -202,7 +204,8 @@ get_facets.loon <- function(widget, by, on,
202204
)
203205
}
204206

205-
get_facets.l_serialaxes <- function(widget, by, parent = NULL, linkingGroup,
207+
get_facets.l_serialaxes <- function(widget, by, parent = NULL,
208+
layout = "grid", linkingGroup,
206209
inheritLayers = TRUE, separate = FALSE,
207210
bySubstitute) {
208211

@@ -241,6 +244,7 @@ get_facets.l_serialaxes <- function(widget, by, parent = NULL, linkingGroup,
241244
# TODO by is a formula
242245
splited <- splitFun(widget = widget,
243246
data = data,
247+
layout = layout,
244248
by = by,
245249
column_names = column_names,
246250
bySubstitute = bySubstitute)
@@ -327,7 +331,7 @@ get_facets.l_serialaxes <- function(widget, by, parent = NULL, linkingGroup,
327331
)
328332
}
329333

330-
splitFun <- function(widget, data, by, on,
334+
splitFun <- function(widget, data, layout = "grid", by, on,
331335
column_names = NULL,
332336
bySubstitute, sep = "*",
333337
N = nrow(data)) {
@@ -352,9 +356,11 @@ splitFun <- function(widget, data, by, on,
352356
as.character(levels(factor(b)))),
353357
byNames)
354358

359+
if(layout == "grid") lex.order <- FALSE else lex.order <- TRUE
355360
split_data <- split(data,
356361
f = as.list(byDataFrame),
357362
drop = FALSE,
363+
lex.order = lex.order,
358364
sep = sep)
359365

360366
list(

‎R/R/graphutils.R

+1-1
Original file line numberDiff line numberDiff line change
@@ -117,7 +117,7 @@ as.loongraph <- function(graph) {
117117
#' for the graph objects in the RBGL and Rgraphviz R packages. For more
118118
#' information on packages that are useful to work with graphs see the
119119
#' \emph{gRaphical Models in R} CRAN Task View at
120-
#' \url{https://CRAN.R-project.org/view=gR}.
120+
#' \url{https://cran.r-project.org/web/views/}.
121121
#'
122122
#' @param loongraph object of class loongraph
123123
#'

‎R/R/l_facet.R

+2
Original file line numberDiff line numberDiff line change
@@ -163,6 +163,7 @@ l_facet.loon <- function(widget,
163163
facets <- get_facets(widget, by, on,
164164
parent = parent,
165165
linkingGroup,
166+
layout = layout,
166167
inheritLayers = inheritLayers,
167168
bySubstitute = substitute(by),
168169
separate = separate,
@@ -339,6 +340,7 @@ l_facet.l_serialaxes <- function(widget,
339340
facets <- get_facets(widget, by, on,
340341
parent = parent,
341342
linkingGroup,
343+
layout = layout,
342344
bySubstitute = substitute(by),
343345
separate = separate,
344346
...)

0 commit comments

Comments
 (0)