Change a sparse plot into a different - r

I have a sparse plot due to data input
Data input
dframe <- structure(list(value = c(1L, 2L, 3L, 4L, 5L, 8L, 6L, 7L,
10L, 9L, 14L, 15L, 20L, 22L, 24L), level= c(1009L, 103L, 43L,
7L, 5L, 4L, 3L, 3L, 2L, 1L, 1L, 1L, 1L, 1L, 1L)), class = "data.frame", row.names = c(NA,
-15L))
And the plot:
library(ggplot2)
p <- ggplot(data=dframe, mapping = aes(x=value, y=level)) +
geom_col(color = '#032838', fill = 'steelblue', size = 1) +
geom_text(aes(label = level), vjust = -0.4, size = 4, position = position_dodge(0.9))
Is there any alternative plot which will not be so sparse after frequency of 30 in x axis?


Here is a hypothesis: you could zoom in on the part of the plot where the data are more sparse. An example with ggforce
library(ggforce)
#transform your data to be plotted by geom_histogram (or geom_density)
df <- data.frame(value=rep(dframe$value,dframe$level))
ggplot() +
geom_histogram(aes(x=value),dplyr::mutate(df, z = F),bins = 25,color = '#032838', fill = 'steelblue') +
geom_histogram(aes(x=value),dplyr::mutate(df, z = T),bins =50,color = '#032838', fill = 'steelblue') +
facet_zoom(xlim = c(5, 25),ylim=c(0,10), horizontal = F,zoom.data = z,zoom.size=0.5)+
theme(zoom.y = element_blank(), validate = FALSE)
which give you:
you can play with the bins argument to find the perfect solution for you.
N.B. I remove the geom_text part since you did not provide the Users variable


Why not just take the logarithm of your level data? That would be the standard thing to do in such a situation. Consider:
p <- ggplot(data=dframe, mapping = aes(x=value, y=log(level))) +
geom_col(color = '#032838', fill = 'steelblue', size = 1)

Related

ggplot2: nudge geom_step() upwards a little bit for every group with discrete y-axis

I have objects moving through different places over time, the plots look like this (but with many more paths):
ggplot(data = df, aes(
y = place,
x = value,
color = order,
group = order
)) +
geom_step(alpha = 0.5) +
theme(legend.position = "bottom") +
guides(color = guide_legend(ncol = 1)) +
geom_point(alpha = 0.5) +
facet_wrap( ~ order)
I'd like to combine the facets into one plot:
ggplot(data = df, aes(
y = place,
x = value,
color = order,
group = order
)) +
geom_step(alpha = 0.5) +
theme(legend.position = "bottom") +
guides(color = guide_legend(ncol = 1)) +
geom_point(alpha = 0.5)
The problem I have with this is the overlapping. I would like to nudge/move every different color of geom_step() up by a few pixels (maybe a linewidth), so that overlapping lines appear thicker. I have tried this R - ggplot dodging geom_lines but changing the x- and y-coordinate messes up the plot.
ggplot(data = df, aes(
y = value,
x = place,
color = order,
group = order
)) +
geom_step(alpha = 0.5, direction = "vh", position = position_dodge(width = 0.5)) +
theme(legend.position = "bottom") +
guides(color = guide_legend(ncol = 1)) +
coord_flip()
I hope I was clear about my desired output. I'm grateful for any hints!
the data:
df <- structure(list(place = structure(c(1L, 7L, 8L, 2L, 8L, 4L, 8L,
11L, 9L, 10L, 9L, 7L, 6L, 7L, 1L, 7L, 8L, 3L, 8L, 5L, 9L, 11L,
9L, 10L, 8L, 7L, 6L, 7L), .Label = c("A", "B", "C", "D", "E",
"F", "G", "H", "I", "J", "K"), class = "factor"), order = structure(c(1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L,
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("a",
"b"), class = "factor"), value = c(0, 38.0069999694824, 254.986999988556,
266.786999940872, 358.447000026703, 368.375, 613.148000001907,
626.457999944687, 778.240999937057, 790.655999898911, 844.833999872208,
914.274999856949, 925.282999992371, 952.84299993515, 0, 38.3450000286102,
80.5469999313354, 93.7960000038147, 188.280999898911, 199.918999910355,
380.635999917984, 385.131000041962, 447.441999912262, 455.503999948502,
528.233000040054, 677.162999868393, 690.805000066757, 713.063999891281
)), row.names = c(NA, -28L), class = "data.frame")

Okay, so after some more googling i stumbled upon the ggstance-package, which includes a vertical version of position_dodge which does exactly what i need:
library(ggstance)
ggplot(data = df, aes(
y = place,
x = value,
color = order,
group = order
)) +
geom_step(position = position_dodge2v(height = 0.2, preserve = "single")) +
theme(legend.position = "bottom") +
guides(color = guide_legend(ncol = 1))

ggplot2 - alternative to geom_ribbon for non continuous x values with facet

I need to plot a ribbon around a hline in a graph with barplots divided in facets. The x axis is non continuous and even though I have tried different solutions like making x numeric for geom_ribbon, I can't find a solution.
toplot=structure(list(size = c(10L, 10L, 10L, 10L, 30L, 30L, 30L, 30L,
50L, 50L, 50L, 50L, 100L, 100L, 100L, 100L), density = structure(c(2L,
3L, 4L, 5L, 2L, 3L, 4L, 5L, 2L, 3L, 4L, 5L, 2L, 3L, 4L, 5L), .Label = c("control",
"low", "medium", "high", "extreme"), class = "factor"), mean = c(0.649495617453177,
0.595030456501759, 0.671853292620394, 0.772710452129729, 0.208287258947775,
0.113070097194118, 0.138593272196695, 0.106836463449531, 0.142217123599047,
0.291860533054406, 0.187033701620647, 0.12045308442074, 0, 0.0000389132497170763,
0.00251973356226341, 0), sd = c(0.0472308191904496, 0.0716594048000388,
0.0857233139528986, 0.0534307204561747, 0.0481240616513752, 0.0390094013972726,
0.0412224562146842, 0.0278742510208481, 0.0233346723409426, 0.0559831409664118,
0.0494588911471589, 0.0270924698136921, 0, 0.000218839700404029,
0.00550243848896909, 0), period = structure(c(1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), class = "factor", .Label = "final")), .Names = c("size",
"density", "mean", "sd", "period"), row.names = c(2L, 3L, 4L,
5L, 7L, 8L, 9L, 10L, 12L, 13L, 14L, 15L, 17L, 18L, 19L, 20L), class = "data.frame")
contr=structure(list(size = c(10L, 30L, 50L, 100L), density = structure(c(1L,
1L, 1L, 1L), .Label = c("control", "low", "medium", "high", "extreme"
), class = "factor"), mean = c(0.640615964924125, 0.231731093831607,
0.122309113981835, 0.0053438272624331), sd = c(0.04503167947312,
0.0406874041671366, 0.0173288744394121, 0.00181433175554796),
period = c("final", "final", "final", "final")), .Names = c("size",
"density", "mean", "sd", "period"), row.names = c(1L, 6L, 11L,
16L), class = "data.frame")
and the code that I have
p <- ggplot(data=toplot,aes(x=period,y=mean,fill=density)) +
geom_bar(stat='identity',position = 'dodge') +
facet_grid(~size) +
geom_hline(data = contr, aes(yintercept = mean,linetype = "control"),size=1.2) +
scale_linetype_manual(name = "",values=2)
I would like to draw a ribbon around the horizontal control line but it's not working. This doesn't draw anything and changes the fill.
p + geom_ribbon(data=contr, aes(ymin = mean - sd, ymax = mean + sd),fill='grey')
and this also messes up the facets
p + geom_ribbon(data=contr, aes(x=1:4, ymin = mean - sd, ymax = mean + sd),fill='grey')
I have also tried to use group=size to match the facet command but nothing happens.
Either I am using the wrong geom or I am missing how to structure the data. I tried to use this http://mjskay.github.io/tidybayes/reference/geom_lineribbon.html but it doesn't exist in ggplot2

Objects like geom_ribbon expect a series of x and y values, so that points can be connected via lines. The main problem here is that your x-axis has only 1 value ('final'), so there's nothing to connect. You can get around the problem with geom_rect, which only needs values for the upper-right and lower-left corners. We simply use -Inf and Inf for the xmin and xmax values, so that the rectangle spans the full width of each facet:
p <- ggplot(data=toplot,aes(x=period,y=mean,fill=density)) +
geom_bar(stat='identity',position = 'dodge') +
facet_grid(~size) +
geom_rect(data = contr, aes(ymin = mean - sd, ymax = mean + sd), xmin = -Inf, xmax = Inf, alpha = 0.25, fill = 'black') +
geom_hline(data = contr, aes(yintercept = mean,linetype = "control"),size=1.2) +
scale_linetype_manual(name = "",values=2)

The geom_rect() approach is nice. You could do something similar with geom_crossbar():
p <- ggplot(data=toplot,aes(x=period,y=mean,fill=density)) +
geom_bar(stat='identity',position = 'dodge') +
facet_grid(~size) +
geom_crossbar(data = contr,
aes(ymin = (mean - 2*sd),
ymax=(mean + 2*sd), linetype = "control"),
size=.2, alpha=.5, width=1, fill='darkgrey') +
scale_linetype_manual(name = "",values=2)
p + theme_minimal()

Something like this. Modify the size=7 value to change the thickness of the line; and alpha=0.2 to edit transparency.
p <- ggplot(data=toplot,aes(x=period,y=mean,fill=density)) +
geom_bar(stat='identity',position = 'dodge') +
facet_grid(~size) +
geom_hline(data = contr, aes(yintercept = mean),size=7,alpha=0.2) +
geom_hline(data = contr, aes(yintercept = mean,linetype = "control"),size=1.2) +
scale_linetype_manual(name = "",values=2)

Align points summarized by a variable with points dodged by the same variable

I have data from two different data sets. The first, dat1 contains multiple points. The 2nd dat2 contains only the max values for each Season-Species group in dat1. I am trying to plot dat1 and then want to plot larger shapes that highlight the max values for each Season-Species group, that is, dat2.
Data:
library(ggplot2)
library(dplyr)
dat1 <- structure(list(Season = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 2L,
2L, 2L, 2L, 2L, 2L), .Label = c("Summer", "Winter"), class = "factor"),
Species = structure(c(1L, 1L, 1L, 2L, 2L, 2L, 1L, 1L, 1L,
2L, 2L, 2L), .Label = c("BHS", "MTG"), class = "factor"),
CovGrain = structure(c(1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L,
1L, 2L, 3L), .Label = c("CanCov_30", "CanCov_500", "CanCov_1000",
"NDVI_30", "NDVI_500", "NDVI_1000", "Slope_30", "Slope_500",
"Slope_1000", "SlopeVar_30", "SlopeVar_500", "SlopeVar_1000"
), class = "factor"), Count = c(4L, 19L, 4L, 5L, 3L, 14L,
14L, 9L, 9L, 4L, 10L, 9L)), .Names = c("Season", "Species",
"CovGrain", "Count"), class = "data.frame", row.names = c(1L,
2L, 3L, 14L, 15L, 16L, 30L, 31L, 32L, 45L, 46L, 47L))
dat2 <- dat1 %>% group_by(Season, Species) %>%
filter(Count == max(Count)) %>% as.data.frame()
ggplot(dat1, aes(x = CovGrain, y = Count)) +
geom_point(aes(fill = Species, color = Species),
alpha = 0.5, stroke = 3, size = 3, position=position_dodge(0.5)) +
facet_wrap(~Season, scales = "free_x") +
scale_shape_manual(values = c(21,22,24)) +
scale_fill_manual(values=c("blue", "red")) +
geom_point(data = dat2, aes(x = CovGrain, y = Count), shape = 23,
stroke = 2, size = 6, position=position_dodge(0.5)) +
theme_bw()
In the plot below I want the black triangles to be correctly dodged so that they outline the largest point of each group.
Any suggestions are appreciated!

Create a boolean variable in the original data which indicates if 'Count' is at maximum, grouped by 'Season' and 'Species'. Use scale_alpha_manual to set alpha to 0 for FALSE (i.e. "Count" not at max). Dodge by "Species" using group = Species.
dat1 <- dat1 %>% group_by(Season, Species) %>%
mutate(max_count = Count == max(Count))
pos <- position_dodge(0.5)
ggplot(dat1, aes(x = CovGrain, y = Count)) +
geom_point(aes(color = Species), position = pos) +
geom_point(aes(alpha = max_count, group = Species), shape = 23, size = 6, position = pos) +
facet_wrap(~ Season) +
scale_alpha_manual(values = c(0, 1), guide = "none") +
theme_bw()

This is a little bit hacky, and there is probably a better solution, but one way is to create a new x variable with your own randomness. The hacky part comes from first doing geom_point(size = -1) to get it to maintain the x-axis. So, not elegant, by any means, but gets you what you want, I think.
dat1$id <- 1:nrow(dat1)
dat2 <- dat1 %>%
group_by(Season, Species, Cov) %>%
filter(Count == max(Count)) %>%
as.data.frame()
randomness <- rnorm(nrow(dat1), 0, 0.5)
dat1$new_x <- as.integer(dat1$CovGrain) + randomness
dat2$new_x <- as.integer(dat2$CovGrain) + randomness[dat2$id]
ggplot(dat1, aes(x = CovGrain, y = Count)) +
geom_point(size = -1) +
geom_point(aes(x = new_x, fill = Species, color = Species),
alpha = 0.5, stroke = 3, size = 3) +
facet_wrap(~Season, scales = "free_x") +
scale_shape_manual(values = c(21,22,24)) +
scale_fill_manual(values=c("blue", "red")) +
geom_point(data = dat2, aes(x = new_x, y = Count), shape = 23,
stroke = 2, size = 6) +
theme_bw()

Controlling bar width with ggplot2 [duplicate]

This question is motivated by further exploring this question. The problem with the accepted solution becomes more obvious when there is a greater disparity in the number of bars per facet. Take a look at this data and the resultant plot using that solution:
# create slightly contrived data to better highlight width problems
data <- data.frame(ID=factor(c(rep(1,9), rep(2,6), rep(3,6), rep(4,3), rep(5,3))),
TYPE=factor(rep(1:3,length(ID)/3)),
TIME=factor(c(1,1,1,2,2,2,3,3,3,1,1,1,2,2,2,1,1,1,2,2,2,1,1,1,1,1,1)),
VAL=runif(27))
# implement previously suggested solution
base.width <- 0.9
data$w <- base.width
# facet two has 3 bars compared to facet one's 5 bars
data$w[data$TIME==2] <- base.width * 3/5
# facet 3 has 1 bar compared to facet one's 5 bars
data$w[data$TIME==3] <- base.width * 1/5
ggplot(data, aes(x=ID, y=VAL, fill=TYPE)) +
facet_wrap(~TIME, ncol=1, scale="free") +
geom_bar(position="stack", aes(width = w),stat = "identity") +
coord_flip()
You'll notice the widths look exactly right, but the whitespace in facet 3 is quite glaring. There is no easy way to fix this in ggplot2 that I have seen yet (facet_wrap does not have a space option).
Next step is to try to solve this using gridExtra:
# create each of the three plots, don't worry about legend for now
p1 <- ggplot(data[data$TIME==1,], aes(x=ID, y=VAL, fill=TYPE)) +
facet_wrap(~ TIME, ncol=1) +
geom_bar(position="stack", show_guide=FALSE) +
coord_flip()
p2 <- ggplot(data[data$TIME==2,], aes(x=ID, y=VAL, fill=TYPE)) +
facet_wrap(~ TIME, ncol=1) +
geom_bar(position="stack", show_guide=FALSE) +
coord_flip()
p3 <- ggplot(data[data$TIME==3,], aes(x=ID, y=VAL, fill=TYPE)) +
facet_wrap(~ TIME, ncol=1) +
geom_bar(position="stack", show_guide=FALSE) +
coord_flip()
# use similar arithmetic to try and get layout correct
require(gridExtra)
heights <- c(5, 3, 1) / sum(5, 3, 1)
print(arrangeGrob(p1 ,p2, p3, ncol=1,
heights=heights))
You'll notice I used the same arithmetic previously suggested based off the number of bars per facet, but in this case it ends up horribly wrong. This seems to be because there are extra "constant height" elements that I need to take into consideration in the math.
Another complication (I believe) is that the final output (and whether or not the widths match) will also depend on the width and height of where I'm outputting the final grob to, whether its in a R/RStudio environment, or to a PNG file.
How can I accomplish this?

Something like this appear to work, but it doesn't - not completely. It has the appearance of working because the levels of the ID factor are sequential. Anything else, and scale = "free" fails. But it might be possible to develop further. The method uses facet_grid, and thus space = "free" can be used. The method uses geom_rect to layer differently coloured rectangles on top of each other. It needs cumulative sums to be calculated so that the right-hand edge of each rectangle can be positioned.
data <- data.frame(ID=factor(c(rep(1,9), rep(2,6), rep(3,6), rep(4,3), rep(5,3))),
TYPE=factor(rep(1:3,3)),
TIME=factor(c(1,1,1,2,2,2,3,3,3,1,1,1,2,2,2,1,1,1,2,2,2,1,1,1,1,1,1)),
VAL=runif(27))
library(ggplot2)
library(plyr)
# Get the cumulative sums
data = ddply(data, .(ID, TIME), mutate, CUMSUMVAL = cumsum(VAL))
ggplot(data, aes(x=VAL, y = as.numeric(ID), fill=TYPE)) +
geom_rect(data = subset(data, TYPE == 3), aes(xmin = 0, xmax = CUMSUMVAL, ymin = as.numeric(ID)-.2, ymax = as.numeric(ID)+.2)) +
geom_rect(data = subset(data, TYPE == 2), aes(xmin = 0, xmax = CUMSUMVAL, ymin = as.numeric(ID)-.2, ymax = as.numeric(ID)+.2)) +
geom_rect(data = subset(data, TYPE == 1), aes(xmin = 0, xmax = CUMSUMVAL, ymin = as.numeric(ID)-.2, ymax = as.numeric(ID)+.2)) +
facet_grid(TIME~., space = "free", scale="free") +
scale_y_continuous(breaks = c(1:5), expand = c(0, 0.2))
EDIT: OR really thick lines work a little better (I think)
ggplot(data, aes(x=VAL, y = ID, colour=TYPE)) +
geom_segment(data = subset(data, TYPE == 3), aes(x = 0, xend = CUMSUMVAL, y = ID, yend = ID), size = 10) +
geom_segment(data = subset(data, TYPE == 2), aes(x = 0, xend = CUMSUMVAL, y = ID, yend = ID), size = 10) +
geom_segment(data = subset(data, TYPE == 1), aes(x = 0, xend = CUMSUMVAL, y = ID, yend = ID), size = 10) +
facet_grid(TIME~., space = "free", scale="free")
Additional Edit Taking the data from your earleir post, and modifying it a little.
Updated opts is deprecated; using theme instead.
df <- structure(list(ID = structure(c(1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L,
2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 4L, 4L, 5L,
5L, 5L, 5L, 5L, 5L, 6L, 6L, 6L, 6L, 6L, 6L, 7L, 7L, 7L), .Label = c("a",
"b", "c", "d", "e", "f", "g"), class = "factor"), TYPE = structure(c(1L,
2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L,
1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L,
5L, 6L, 1L, 2L, 3L), .Label = c("1", "2", "3", "4", "5", "6",
"7", "8"), class = "factor"), TIME = structure(c(2L, 2L, 2L,
2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L,
2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 3L, 3L, 3L, 3L, 3L, 3L,
1L, 1L, 1L), .Label = c("One", "Five", "Fifteen"), class = "factor"), VAL = c(0.937377670081332,
0.522220720537007, 0.278690102742985, 0.967633064137772, 0.116124767344445,
0.0544306698720902, 0.470229141646996, 0.62017166428268, 0.195459847105667,
0.732876230962574, 0.996336271753535, 0.983087373664603, 0.666449476964772,
0.291554537601769, 0.167933790013194, 0.860138458199799, 0.172361251665279,
0.833266809117049, 0.620465772924945, 0.786503327777609, 0.761877260869369,
0.425386636285111, 0.612077651312575, 0.178726130630821, 0.528709076810628,
0.492527724476531, 0.472576208412647, 0.0702785139437765, 0.696220921119675,
0.230852259788662, 0.359884874196723, 0.518227979075164, 0.259466265095398,
0.149970305617899, 0.00682218233123422, 0.463400925742462, 0.924704828299582,
0.229068386601284)), .Names = c("ID", "TYPE", "TIME", "VAL"), row.names = c(NA,
-38L), class = "data.frame")
library(ggplot2)
library(plyr)
data = ddply(df, .(ID, TIME), mutate, CUMSUMVAL = cumsum(VAL))
ggplot(data, aes(x=VAL, y = ID, colour=TYPE)) +
geom_segment(data = subset(data, TYPE == 6), aes(x = 0, xend = CUMSUMVAL, y = ID, yend = ID), size = 10) +
geom_segment(data = subset(data, TYPE == 5), aes(x = 0, xend = CUMSUMVAL, y = ID, yend = ID), size = 10) +
geom_segment(data = subset(data, TYPE == 4), aes(x = 0, xend = CUMSUMVAL, y = ID, yend = ID), size = 10) +
geom_segment(data = subset(data, TYPE == 3), aes(x = 0, xend = CUMSUMVAL, y = ID, yend = ID), size = 10) +
geom_segment(data = subset(data, TYPE == 2), aes(x = 0, xend = CUMSUMVAL, y = ID, yend = ID), size = 10) +
geom_segment(data = subset(data, TYPE == 1), aes(x = 0, xend = CUMSUMVAL, y = ID, yend = ID), size = 10) +
facet_grid(TIME~., space = "free", scale="free") +
theme(strip.text.y = element_text(angle = 0))

Changing the gtable doesn't help, unfortunately, as the bar width is in relative units,
g = ggplot_gtable(ggplot_build(p))
panels = which(sapply(g$heights, attr, "unit") == "null")
g$heights[[panels[1]]] <- unit(5, "null")
g$heights[[panels[2]]] <- unit(3, "null")
g$heights[[panels[3]]] <- unit(1, "null")
grid.draw(g)

ggplot2 + gridExtra: how to ensure geom_bar in different size plot grobs result in exact same bar width

This question is motivated by further exploring this question. The problem with the accepted solution becomes more obvious when there is a greater disparity in the number of bars per facet. Take a look at this data and the resultant plot using that solution:
# create slightly contrived data to better highlight width problems
data <- data.frame(ID=factor(c(rep(1,9), rep(2,6), rep(3,6), rep(4,3), rep(5,3))),
TYPE=factor(rep(1:3,length(ID)/3)),
TIME=factor(c(1,1,1,2,2,2,3,3,3,1,1,1,2,2,2,1,1,1,2,2,2,1,1,1,1,1,1)),
VAL=runif(27))
# implement previously suggested solution
base.width <- 0.9
data$w <- base.width
# facet two has 3 bars compared to facet one's 5 bars
data$w[data$TIME==2] <- base.width * 3/5
# facet 3 has 1 bar compared to facet one's 5 bars
data$w[data$TIME==3] <- base.width * 1/5
ggplot(data, aes(x=ID, y=VAL, fill=TYPE)) +
facet_wrap(~TIME, ncol=1, scale="free") +
geom_bar(position="stack", aes(width = w),stat = "identity") +
coord_flip()
You'll notice the widths look exactly right, but the whitespace in facet 3 is quite glaring. There is no easy way to fix this in ggplot2 that I have seen yet (facet_wrap does not have a space option).
Next step is to try to solve this using gridExtra:
# create each of the three plots, don't worry about legend for now
p1 <- ggplot(data[data$TIME==1,], aes(x=ID, y=VAL, fill=TYPE)) +
facet_wrap(~ TIME, ncol=1) +
geom_bar(position="stack", show_guide=FALSE) +
coord_flip()
p2 <- ggplot(data[data$TIME==2,], aes(x=ID, y=VAL, fill=TYPE)) +
facet_wrap(~ TIME, ncol=1) +
geom_bar(position="stack", show_guide=FALSE) +
coord_flip()
p3 <- ggplot(data[data$TIME==3,], aes(x=ID, y=VAL, fill=TYPE)) +
facet_wrap(~ TIME, ncol=1) +
geom_bar(position="stack", show_guide=FALSE) +
coord_flip()
# use similar arithmetic to try and get layout correct
require(gridExtra)
heights <- c(5, 3, 1) / sum(5, 3, 1)
print(arrangeGrob(p1 ,p2, p3, ncol=1,
heights=heights))
You'll notice I used the same arithmetic previously suggested based off the number of bars per facet, but in this case it ends up horribly wrong. This seems to be because there are extra "constant height" elements that I need to take into consideration in the math.
Another complication (I believe) is that the final output (and whether or not the widths match) will also depend on the width and height of where I'm outputting the final grob to, whether its in a R/RStudio environment, or to a PNG file.
How can I accomplish this?

Something like this appear to work, but it doesn't - not completely. It has the appearance of working because the levels of the ID factor are sequential. Anything else, and scale = "free" fails. But it might be possible to develop further. The method uses facet_grid, and thus space = "free" can be used. The method uses geom_rect to layer differently coloured rectangles on top of each other. It needs cumulative sums to be calculated so that the right-hand edge of each rectangle can be positioned.
data <- data.frame(ID=factor(c(rep(1,9), rep(2,6), rep(3,6), rep(4,3), rep(5,3))),
TYPE=factor(rep(1:3,3)),
TIME=factor(c(1,1,1,2,2,2,3,3,3,1,1,1,2,2,2,1,1,1,2,2,2,1,1,1,1,1,1)),
VAL=runif(27))
library(ggplot2)
library(plyr)
# Get the cumulative sums
data = ddply(data, .(ID, TIME), mutate, CUMSUMVAL = cumsum(VAL))
ggplot(data, aes(x=VAL, y = as.numeric(ID), fill=TYPE)) +
geom_rect(data = subset(data, TYPE == 3), aes(xmin = 0, xmax = CUMSUMVAL, ymin = as.numeric(ID)-.2, ymax = as.numeric(ID)+.2)) +
geom_rect(data = subset(data, TYPE == 2), aes(xmin = 0, xmax = CUMSUMVAL, ymin = as.numeric(ID)-.2, ymax = as.numeric(ID)+.2)) +
geom_rect(data = subset(data, TYPE == 1), aes(xmin = 0, xmax = CUMSUMVAL, ymin = as.numeric(ID)-.2, ymax = as.numeric(ID)+.2)) +
facet_grid(TIME~., space = "free", scale="free") +
scale_y_continuous(breaks = c(1:5), expand = c(0, 0.2))
EDIT: OR really thick lines work a little better (I think)
ggplot(data, aes(x=VAL, y = ID, colour=TYPE)) +
geom_segment(data = subset(data, TYPE == 3), aes(x = 0, xend = CUMSUMVAL, y = ID, yend = ID), size = 10) +
geom_segment(data = subset(data, TYPE == 2), aes(x = 0, xend = CUMSUMVAL, y = ID, yend = ID), size = 10) +
geom_segment(data = subset(data, TYPE == 1), aes(x = 0, xend = CUMSUMVAL, y = ID, yend = ID), size = 10) +
facet_grid(TIME~., space = "free", scale="free")
Additional Edit Taking the data from your earleir post, and modifying it a little.
Updated opts is deprecated; using theme instead.
df <- structure(list(ID = structure(c(1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L,
2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 4L, 4L, 5L,
5L, 5L, 5L, 5L, 5L, 6L, 6L, 6L, 6L, 6L, 6L, 7L, 7L, 7L), .Label = c("a",
"b", "c", "d", "e", "f", "g"), class = "factor"), TYPE = structure(c(1L,
2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L,
1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L,
5L, 6L, 1L, 2L, 3L), .Label = c("1", "2", "3", "4", "5", "6",
"7", "8"), class = "factor"), TIME = structure(c(2L, 2L, 2L,
2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L,
2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 3L, 3L, 3L, 3L, 3L, 3L,
1L, 1L, 1L), .Label = c("One", "Five", "Fifteen"), class = "factor"), VAL = c(0.937377670081332,
0.522220720537007, 0.278690102742985, 0.967633064137772, 0.116124767344445,
0.0544306698720902, 0.470229141646996, 0.62017166428268, 0.195459847105667,
0.732876230962574, 0.996336271753535, 0.983087373664603, 0.666449476964772,
0.291554537601769, 0.167933790013194, 0.860138458199799, 0.172361251665279,
0.833266809117049, 0.620465772924945, 0.786503327777609, 0.761877260869369,
0.425386636285111, 0.612077651312575, 0.178726130630821, 0.528709076810628,
0.492527724476531, 0.472576208412647, 0.0702785139437765, 0.696220921119675,
0.230852259788662, 0.359884874196723, 0.518227979075164, 0.259466265095398,
0.149970305617899, 0.00682218233123422, 0.463400925742462, 0.924704828299582,
0.229068386601284)), .Names = c("ID", "TYPE", "TIME", "VAL"), row.names = c(NA,
-38L), class = "data.frame")
library(ggplot2)
library(plyr)
data = ddply(df, .(ID, TIME), mutate, CUMSUMVAL = cumsum(VAL))
ggplot(data, aes(x=VAL, y = ID, colour=TYPE)) +
geom_segment(data = subset(data, TYPE == 6), aes(x = 0, xend = CUMSUMVAL, y = ID, yend = ID), size = 10) +
geom_segment(data = subset(data, TYPE == 5), aes(x = 0, xend = CUMSUMVAL, y = ID, yend = ID), size = 10) +
geom_segment(data = subset(data, TYPE == 4), aes(x = 0, xend = CUMSUMVAL, y = ID, yend = ID), size = 10) +
geom_segment(data = subset(data, TYPE == 3), aes(x = 0, xend = CUMSUMVAL, y = ID, yend = ID), size = 10) +
geom_segment(data = subset(data, TYPE == 2), aes(x = 0, xend = CUMSUMVAL, y = ID, yend = ID), size = 10) +
geom_segment(data = subset(data, TYPE == 1), aes(x = 0, xend = CUMSUMVAL, y = ID, yend = ID), size = 10) +
facet_grid(TIME~., space = "free", scale="free") +
theme(strip.text.y = element_text(angle = 0))

Changing the gtable doesn't help, unfortunately, as the bar width is in relative units,
g = ggplot_gtable(ggplot_build(p))
panels = which(sapply(g$heights, attr, "unit") == "null")
g$heights[[panels[1]]] <- unit(5, "null")
g$heights[[panels[2]]] <- unit(3, "null")
g$heights[[panels[3]]] <- unit(1, "null")
grid.draw(g)

Resources