Skip to content

Commit

Permalink
there was an issue with collapsed data and free scales. strange it we…
Browse files Browse the repository at this point in the history 
…nt unnoticed for so long
  • Loading branch information
@jtlandis
jtlandis committed Dec 27, 2023
1 parent 969a6d0 commit d3aa9c0
Show file tree
Hide file tree
Showing 5 changed files with 80 additions and 45 deletions.
41 changes: 18 additions & 23 deletions R/constructor-.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -92,22 +92,16 @@ ggside_scales <- function(scales, ggside) {
# browser()
parent <- ggproto_parent(scales, self)
parent$add(scale)
if (!is.null(scale)) {
if (any(pos <- c("x","y") %in% scale$aesthetics)) {
side <- switch(c("x","y")[pos], x = "yside", y = "xside")
s <- new_pos_scale(self$scales[[self$n()]])
self$scales[[self$n()]] <- s
} else if (any(pos <- c("ysidex", "xsidey") %in% scale$aesthetics)) {
side <- c("ysidex", "xsidey")[pos]
main_scale <- self$find(switch(side, ysidex = "x", xsidey = "y"))
# if main scale is already specified
# then assume its position.
if (any(main_scale)) {
main_scale <- self$scales[main_scale]
scale$position <- main_scale[[1]]$position
}
self$ggside[[side]] <- scale
if (!is.null(scale) && any(pos <- c("ysidex", "xsidey") %in% scale$aesthetics)) {
side <- c("ysidex", "xsidey")[pos]
main_scale <- self$find(switch(side, ysidex = "x", xsidey = "y"))
# if main scale is already specified
# then assume its position.
if (any(main_scale)) {
main_scale <- self$scales[main_scale]
scale$position <- main_scale[[1]]$position
}
self$ggside[[side]] <- scale
}
},
input = function(self) {
Expand All @@ -132,9 +126,9 @@ ggside_scales <- function(scales, ggside) {
}, logical(1))
})

lgl <- new_scales$find(c("x","y"))
if (any(lgl))
new_scales$scales[lgl] <- lapply(new_scales$scales[lgl], new_pos_scale)
# lgl <- new_scales$find(c("x","y"))
# if (any(lgl))
# new_scales$scales[lgl] <- lapply(new_scales$scales[lgl], new_pos_scale)

new_scales

Expand All @@ -155,11 +149,12 @@ new_pos_scale <- function(scale) {
# # local_vanilla_scale_aes(self)
# ggproto_parent(scale, self)$transform_df(df)
# },
map = function(self, x, limits = self$get_limits()) {
if (length(x)==0) return(x)
parent <- ggproto_parent(scale, self)
parent$map(x, limits)
})
# map = function(self, x, limits = self$get_limits()) {
# if (length(x)==0) return(x)
# parent <- ggproto_parent(scale, self)
# parent$map(x, limits)
# }
)
}


Expand Down
2 changes: 1 addition & 1 deletion R/ggside.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -45,7 +45,7 @@ ggside <- function(x.pos = NULL, y.pos = NULL, scales = NULL, collapse = NULL,
draw_y_on <- resolve_arg(draw_y_on, c("default","main","side"))
strip <- resolve_arg(strip, c("default", "main"))
collapse <- resolve_arg(collapse, c("all", "x", "y"))
respect_side_labels <- resolve_arg(respect_side_labels, c("default","x","y", "all", "none"))
respect_side_labels <- resolve_arg(respect_side_labels, c("default","x","y", "all", "none", "independent"))


ggproto(
Expand Down
1 change: 1 addition & 0 deletions R/side-facet-grid.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -333,6 +333,7 @@ sideFacetGrid_map_data <- function (data, layout, params) {
if (empty(data)) {
return(cbind(data, PANEL = integer(0)))
}

rows <- params$rows
cols <- params$cols
vars <- c(names(rows), names(cols), "PANEL_TYPE")
Expand Down
67 changes: 53 additions & 14 deletions R/side-facet_utils.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -48,7 +48,6 @@ check_scales_collapse <- function(data, params) {
#' @export
sidePanelLayout <- function(layout,
ggside){

ggside$collapse <- check_collapse(ggside$collapse, ggside$sides_used)
facet_vars <- setdiff(colnames(layout), c("PANEL","ROW","COL","SCALE_X","SCALE_Y","PANEL_GROUP","PANEL_TYPE"))
x.pos = ggside$x.pos
Expand Down Expand Up @@ -150,9 +149,9 @@ sidePanelLayout <- function(layout,

}
.pty <- layout[["PANEL_TYPE"]]=="y"
layout[["SCALE_X"]][.pty] <- x_scale_fun(layout[["SCALE_X"]],.pty)
layout[["SCALE_X"]][.pty] <- x_scale_fun(layout[["SCALE_X"]], .pty, interaction(layout[["ROW"]], layout[["COL"]], lex.order = TRUE))
.ptx <- layout[["PANEL_TYPE"]]=="x"
layout[["SCALE_Y"]][.ptx] <- y_scale_fun(layout[["SCALE_Y"]], .ptx)
layout[["SCALE_Y"]][.ptx] <- y_scale_fun(layout[["SCALE_Y"]], .ptx, interaction(layout[["ROW"]], layout[["COL"]], lex.order = TRUE))
layout <- layout[,setdiff(colnames(layout), c("ROW_trans","COL_trans","PANEL"))]
layout <- unique(layout)
layout <- layout[order(layout$ROW, layout$COL),]
Expand All @@ -163,12 +162,15 @@ sidePanelLayout <- function(layout,



fixed_fun <- function(x, lgl){
fixed_fun <- function(x, lgl, indx){
rep(max(x)+1L,sum(lgl))
}

free_fun <- function(x, lgl){
max(x)+(seq_len(sum(lgl)))
free_fun <- function(x, lgl, indx){
ind <- indx[lgl]
uindx <- unique(ind)
scale <- seq_along(uindx)
max(x) + scale[match(ind, uindx)]
}

max_factor <- function(x){
Expand Down Expand Up @@ -224,42 +226,79 @@ map_panel_type <- function(panel_params, panel_types) {
}

calc_panel_spacing <- function(ggside, layout, top, right, bot, left) {

respect <- ggside$respect_side_labels
y.pos <- ggside$y.pos
x.pos <- ggside$x.pos
xside <- "x" %in% layout$PANEL_TYPE
yside <- "y" %in% layout$PANEL_TYPE
n_row <- max(layout$ROW)
collapse <- ggside$collapse
collapsed <- !is.null(collapse)

top_height <- vapply(top, height_cm, numeric(1))
right_width <- vapply(right, width_cm, numeric(1))
bot_height <- vapply(bot, height_cm, numeric(1))
left_width <- vapply(left, width_cm, numeric(1))

xside_panels <- layout$panel_pos[layout$PANEL_TYPE=="x"]
yside_panels <- layout$panel_pos[layout$PANEL_TYPE=="y"]
xsub <- layout[layout$PANEL_TYPE=="x",]
ysub <- layout[layout$PANEL_TYPE=="y",]
xside_panels <- xsub$panel_pos
yside_panels <- ysub$panel_pos

if (respect=="default" && xside && yside) {
#heights
if (y.pos=="left")
if (y.pos=="left") {
left_width[xside_panels] <- 0
else
} else {
right_width[xside_panels] <- 0
}

#widths
if (x.pos=="top")
if (x.pos=="top") {
top_height[yside_panels] <- 0
else
} else {
bot_height[yside_panels] <- 0
} else {
}
} else if (respect == "independent" && xside && yside) {
#heights
if (y.pos=="left") {
if (collapsed && collapse %in% c("y", "all")) {
left_width[tapply(xsub$panel_pos, xsub$ROW, min)] <- 0
} else {
left_width[xside_panels] <- 0
}
} else {
if (collapsed && collapse %in% c("y", "all")) {
left_width[tapply(xsub$panel_pos, xsub$ROW, max)] <- 0
} else {
right_width[xside_panels] <- 0
}
}

#widths
if (x.pos=="top") {
if (collapsed && collapse %in% c("x", "all")) {
top_height[tapply(ysub$panel_pos, ysub$COL, min)]
} else {
top_height[yside_panels] <- 0
}
} else {
if (collapsed && collapse %in% c("x", "all")) {
#only set bottom y panel to 0
bot_height[tapply(ysub$panel_pos, ysub$COL, max)] <- 0
} else {
bot_height[yside_panels] <- 0
}
}

} else {
if (respect %in% c("x", "none") && yside) {
bot_height[yside_panels] <- top_height[yside_panels] <- 0
}
if (respect %in% c("y", "none") && xside) {
left_width[xside_panels] <- right_width[xside_panels] <- 0
}

}

list(
Expand Down
14 changes: 7 additions & 7 deletions vignettes/ggside_basic_usage.Rmd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -163,8 +163,8 @@ p <- ggplot(i2, aes(Sepal.Width, Sepal.Length, color = Species)) +


```{r base_example_FacetNull}
p2 <- p + geom_xsidedensity(aes(y=stat(density))) +
geom_ysidedensity(aes(x=after_stat(density))) +
p2 <- p + geom_xsidedensity(aes(y = after_stat(density))) +
geom_ysidedensity(aes(x = after_stat(density))) +
theme_bw()
p2 + labs(title = "FacetNull")
```
Expand Down Expand Up @@ -202,17 +202,17 @@ p2 + facet_grid(Species~Species2, space = "free", scales = "free") +
```

```{r base_example_custom2}
p + geom_xsidedensity(aes(y=stat(density)))+
geom_ysidedensity(aes(x=stat(density), ycolor = Species2)) +
p + geom_xsidedensity(aes(y=after_after_stat(density)))+
geom_ysidedensity(aes(x=after_after_stat(density), ycolor = Species2)) +
theme_bw() +
facet_grid(Species~Species2, space = "free", scales = "free") +
labs(title = "FacetGrid", subtitle = "Collapsing All Side Panels") +
ggside(collapse = "all")
```

```{r base_example_custom3}
p + geom_xsidedensity(aes(y=stat(density), xfill = Species), position = "stack")+
geom_ysidedensity(aes(x=stat(density), yfill = Species2), position = "stack") +
p + geom_xsidedensity(aes(y=after_stat(density), xfill = Species), position = "stack")+
geom_ysidedensity(aes(x=after_stat(density), yfill = Species2), position = "stack") +
theme_bw() +
facet_grid(Species~Species2, space = "free", scales = "free") +
labs(title = "FacetGrid", subtitle = "Collapsing All Side Panels") +
Expand All @@ -237,7 +237,7 @@ You may also change the size of the side panels with the theme elements `ggside.
```{r base_example_theme}
p2 + facet_grid(Species~Species2, space = "free", scales = "free") +
labs(title = "FacetGrid", subtitle = "Collapsing X Side Panels and \nAdjusted Side Panel Relative Size") +
ggside(collapse = "x", x.pos = "bottom", scales = "free_x") +
ggside(collapse = "all", x.pos = "bottom", scales = "free_x") +
theme(ggside.panel.scale.x = .4,
ggside.panel.scale.y = .25)
```
Expand Down

0 comments on commit d3aa9c0

Please sign in to comment.