Skip to content

Commit f6b833e

Browse files
DanChaltielDanChaltiel
committed
fixed as_flextable(compact=TRUE) whith duplicated labels
fixes #87
1 parent 730dd90 commit f6b833e

File tree

4 files changed

+85
-48
lines changed

4 files changed

+85
-48
lines changed

‎R/compact.R

Lines changed: 15 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -18,9 +18,10 @@ ct_compact = function(data, ...){
1818
#' @param data the object to compact
1919
#' @param name_from name of the column to be collapsed when compacting
2020
#' @param name_to name of the column that will receive the collapsed column. Will be created if it doesn't exist.
21+
#' @param ... additional arguments (not used)
22+
#' @param id_from name of the columns to use as cut-off. Useful when successive `name_from` have the same value.
2123
#' @param wrap_cols name of the columns to wrap
2224
#' @param rtn_flextable whether to return a formatted [flextable::flextable()] object or a simple `data.frame`
23-
#' @param ... additional arguments (not used)
2425
#' @rdname ct_compact
2526
#'
2627
#' @author Dan Chaltiel
@@ -40,10 +41,15 @@ ct_compact = function(data, ...){
4041
#' ct_compact(x, name_from="Species", name_to="Petal.Length")
4142
#' x$Species2 = substr(x$Species, 1, 1)
4243
#' ct_compact(x, name_from="Species", wrap_cols="Species2")
43-
ct_compact.data.frame = function(data, name_from, name_to="variable", wrap_cols=NULL, rtn_flextable=FALSE, ...){
44+
#' ct_compact(x, name_from="Species", id_from="Species2") #cut on "v"
45+
ct_compact.data.frame = function(data, name_from, name_to="variable", ...,
46+
id_from=name_from,
47+
wrap_cols=NULL, rtn_flextable=FALSE){
4448
assert_scalar(name_from)
4549
assert_scalar(name_to)
46-
id = (data[[name_from]]!=lag(data[[name_from]])) %>% replace_na(TRUE)
50+
assert_scalar(id_from)
51+
ifr = sym(id_from)
52+
id = (data[[id_from]]!=lag(data[[id_from]])) %>% replace_na(TRUE)
4753

4854
nf = sym(name_from)
4955
nt = sym(name_to)
@@ -52,12 +58,12 @@ ct_compact.data.frame = function(data, name_from, name_to="variable", wrap_cols=
5258
rtn = data[x,] %>%
5359
mutate(
5460
across(everything(), as.character),
55-
gp = row_number()==1 | !!nf!=lag(!!nf),
61+
gp = row_number()==1 | !!ifr!=lag(!!ifr),
5662
!!nt:=ifelse(.data$gp, !!nf, !!nt),
5763
across(any_of(wrap_cols), ~ifelse(.data$gp, .x, "")),
5864
across(-any_of(c(name_to, wrap_cols)), ~ifelse(.data$gp, "", .x)),
5965
) %>%
60-
select(any_of(name_to), everything(), -any_of(name_from), -"gp")
66+
select(any_of(name_to), everything(), -any_of(c(name_from, id_from)), -"gp")
6167
rownames(rtn) = NULL #resets row numbers
6268

6369
if(rtn_flextable){
@@ -88,7 +94,8 @@ ct_compact.data.frame = function(data, name_from, name_to="variable", wrap_cols=
8894
#' x=crosstable(mtcars2, c(disp,hp,am), by=vs, test=TRUE, effect=TRUE)
8995
#' ct_compact(x)
9096
#' ct_compact(x, name_from=".id")
91-
ct_compact.crosstable = function(data, name_from=c("label", ".id"), name_to="variable", keep_id=FALSE, ...){
97+
ct_compact.crosstable = function(data, name_from=c("label", ".id"), name_to="variable",
98+
id_from=".id", keep_id=FALSE, ...){
9299
by_levels = attr(data, "by_levels")
93100
by = attr(data, "by")
94101
name_from = match.arg(name_from)
@@ -98,15 +105,13 @@ ct_compact.crosstable = function(data, name_from=c("label", ".id"), name_to="var
98105
if(isTRUE(keep_id)) keep_id = "{label} ({.id})"
99106
data = data %>% mutate(label = glue(keep_id))
100107
}
101-
102108
rtn = data %>%
103-
select(-any_of(rcol)) %>%
104-
ct_compact.data.frame(name_from=name_from, name_to=name_to,
109+
ct_compact.data.frame(name_from=name_from, name_to=name_to, id_from=id_from,
105110
wrap_cols=wrap_cols, rtn_flextable=FALSE)
106111

107112
new_attr_names = setdiff(names(attributes(data)), names(attributes(rtn)))
108113
attributes(rtn) = c(attributes(rtn), attributes(data)[new_attr_names])
109-
class(rtn) = c("crosstable", "compacted_crosstable", "data.frame")
114+
class(rtn) = c("compacted_crosstable", class(data))
110115
rtn
111116
}
112117

‎man/ct_compact.Rd

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

‎tests/testthat/_snaps/compact.md

Lines changed: 40 additions & 36 deletions
Original file line numberDiff line numberDiff line change
@@ -73,43 +73,47 @@
7373
Code
7474
ct_compact(ct)
7575
Output
76-
variable straight vshaped
77-
1 Displacement (cu.in.)
78-
2 Min / Max 71.1 / 258.0 120.3 / 472.0
79-
3 Med [IQR] 120.5 [83.0;162.4] 311.0 [275.8;360.0]
80-
4 Mean (std) 132.5 (56.9) 307.1 (106.8)
81-
5 N (NA) 14 (0) 18 (0)
82-
6 Gross horsepower
83-
7 Min / Max 52.0 / 123.0 91.0 / 335.0
84-
8 Med [IQR] 96.0 [66.0;109.8] 180.0 [156.2;226.2]
85-
9 Mean (std) 91.4 (24.4) 189.7 (60.3)
86-
10 N (NA) 14 (0) 18 (0)
87-
11 Number of cylinders
88-
12 4 10 (90.91%) 1 (9.09%)
89-
13 6 4 (57.14%) 3 (42.86%)
90-
14 8 0 (0%) 14 (100.00%)
91-
15 Transmission
92-
16 auto 7 (36.84%) 12 (63.16%)
93-
17 manual 7 (53.85%) 6 (46.15%)
76+
# A tibble: 17 x 3
77+
variable straight vshaped
78+
* <chr> <chr> <chr>
79+
1 Displacement (cu.in.) "" ""
80+
2 Min / Max "71.1 / 258.0" "120.3 / 472.0"
81+
3 Med [IQR] "120.5 [83.0;162.4]" "311.0 [275.8;360.0]"
82+
4 Mean (std) "132.5 (56.9)" "307.1 (106.8)"
83+
5 N (NA) "14 (0)" "18 (0)"
84+
6 Gross horsepower "" ""
85+
7 Min / Max "52.0 / 123.0" "91.0 / 335.0"
86+
8 Med [IQR] "96.0 [66.0;109.8]" "180.0 [156.2;226.2]"
87+
9 Mean (std) "91.4 (24.4)" "189.7 (60.3)"
88+
10 N (NA) "14 (0)" "18 (0)"
89+
11 Number of cylinders "" ""
90+
12 4 "10 (90.91%)" "1 (9.09%)"
91+
13 6 "4 (57.14%)" "3 (42.86%)"
92+
14 8 "0 (0%)" "14 (100.00%)"
93+
15 Transmission "" ""
94+
16 auto "7 (36.84%)" "12 (63.16%)"
95+
17 manual "7 (53.85%)" "6 (46.15%)"
9496
Code
9597
ct_compact(ct, name_from = ".id")
9698
Output
97-
variable straight vshaped
98-
1 disp
99-
2 Min / Max 71.1 / 258.0 120.3 / 472.0
100-
3 Med [IQR] 120.5 [83.0;162.4] 311.0 [275.8;360.0]
101-
4 Mean (std) 132.5 (56.9) 307.1 (106.8)
102-
5 N (NA) 14 (0) 18 (0)
103-
6 hp
104-
7 Min / Max 52.0 / 123.0 91.0 / 335.0
105-
8 Med [IQR] 96.0 [66.0;109.8] 180.0 [156.2;226.2]
106-
9 Mean (std) 91.4 (24.4) 189.7 (60.3)
107-
10 N (NA) 14 (0) 18 (0)
108-
11 cyl
109-
12 4 10 (90.91%) 1 (9.09%)
110-
13 6 4 (57.14%) 3 (42.86%)
111-
14 8 0 (0%) 14 (100.00%)
112-
15 am
113-
16 auto 7 (36.84%) 12 (63.16%)
114-
17 manual 7 (53.85%) 6 (46.15%)
99+
# A tibble: 17 x 4
100+
variable label straight vshaped
101+
* <chr> <chr> <chr> <chr>
102+
1 disp "" "" ""
103+
2 Min / Max "Displacement (cu.in.)" "71.1 / 258.0" "120.3 / 472.0"
104+
3 Med [IQR] "Displacement (cu.in.)" "120.5 [83.0;162.4]" "311.0 [275.8;360.0]"
105+
4 Mean (std) "Displacement (cu.in.)" "132.5 (56.9)" "307.1 (106.8)"
106+
5 N (NA) "Displacement (cu.in.)" "14 (0)" "18 (0)"
107+
6 hp "" "" ""
108+
7 Min / Max "Gross horsepower" "52.0 / 123.0" "91.0 / 335.0"
109+
8 Med [IQR] "Gross horsepower" "96.0 [66.0;109.8]" "180.0 [156.2;226.2]"
110+
9 Mean (std) "Gross horsepower" "91.4 (24.4)" "189.7 (60.3)"
111+
10 N (NA) "Gross horsepower" "14 (0)" "18 (0)"
112+
11 cyl "" "" ""
113+
12 4 "Number of cylinders" "10 (90.91%)" "1 (9.09%)"
114+
13 6 "Number of cylinders" "4 (57.14%)" "3 (42.86%)"
115+
14 8 "Number of cylinders" "0 (0%)" "14 (100.00%)"
116+
15 am "" "" ""
117+
16 auto "Transmission" "7 (36.84%)" "12 (63.16%)"
118+
17 manual "Transmission" "7 (53.85%)" "6 (46.15%)"
115119

‎tests/testthat/test-compact.R

Lines changed: 23 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -64,6 +64,29 @@ test_that("Compacting inside or outside as_flextable.crosstable gives the same r
6464
})
6565

6666

67+
test_that("Compact method OK with as_flextable()", {
68+
69+
ct = mtcars2 %>%
70+
apply_labels(am="Engine") %>%
71+
crosstable(c(am, vs))
72+
73+
ft1 = ct %>% af(compact=FALSE)
74+
expect_setequal(ft1$body$dataset$.id, c("am", "vs"))
75+
expect_setequal(ft1$body$dataset$label, "Engine")
76+
expect_equal(ft1$body$dataset$variable, c("auto", "manual", "straight", "vshaped"))
77+
expect_equal(as.character(ft1$header$dataset), c("label", "variable", "value"))
78+
79+
ft2 = ct %>% af(compact=TRUE)
80+
expect_null(ft2$body$dataset$.id)
81+
expect_null(ft2$body$dataset$label)
82+
expect_equal(ft2$body$dataset$variable,
83+
c("Engine", "auto", "manual", "Engine", "straight", "vshaped"))
84+
expect_equal(as.character(ft2$header$dataset), c("variable", "value"))
85+
86+
})
87+
88+
89+
6790
# Misc flextable ----------------------------------------------------------
6891

6992

0 commit comments

Comments
 (0)