Related
I wish to create a Space Adjacency Matrix in R, preferably using ggplot/tidyverse for consistency with other scripts, but I am open to other solutions.
Here is what I am looking for.
A Space Adjacency Matrix is used in interior and architectural design to illustrate relationships (adjacencies) between spaces within a building.
Each space in the building has a relationship (or lack of relationship) to every other space.
The input data is likely formatted similarly to this:
rel.ABCD <- data.frame(
id = c(1,2,3,4,5,6),
x1 = c("A","A","A","B","B","C"),
x2 = c("B","C","D","C","D","D"),
relation = c(1,2,1,3,2,1)
)
rel.ABCD
#> id x1 x2 relation
#> 1 1 A B 1
#> 2 2 A C 2
#> 3 3 A D 1
#> 4 4 B C 3
#> 5 5 B D 2
#> 6 6 C D 1
Created on 2022-04-11 by the reprex package (v2.0.1)
Four spaces (A, B, C and D) exist in the example above. Each has a type of relation with the other spaces. Spaces A and B (id 1) have a relation type of 1, spaces B and C (id 4) have a relation type of 3, etc.
In some ways, the Space Adjacency Matrix is similar to a correlation table (in format, not function), matching lists of entities intersect and the value for the relationship is shown at the intersection. The difference is that instead of labels existing on both the x-axes and y-axes, they exist on the y-axes only, like in the example below from vectorworks.net.
The relation is displayed at the intersecting grid for each room pair (e.g. dispatch and office have a relationship type 5, storage and shop have a relationship type 1, etc.). The relation is typically depicted as an icon, number or fill colour.
How can I generate this graph?
I don't know of any package that implements this. But it is good to keep in mind that you can basically plot anything in ggplot2, as long as you can translate what you're plotting to polygons. That said, here is how you can translate this particular problem to polygons.
library(ggplot2)
#> Warning: package 'ggplot2' was built under R version 4.1.3
rel.ABCD <- data.frame(
id = c(1,2,3,4,5,6),
x1 = c("A","A","A","B","B","C"),
x2 = c("B","C","D","C","D","D"),
relation = c(1,2,1,3,2,1)
)
# Encode categorical values as numeric
union <- with(rel.ABCD, union(x1, x2))
rel.ABCD <- transform(
rel.ABCD,
x = match(x1, union),
y = match(x2, union)
)
# Expand observation to rectangle polygons
new <- rel.ABCD[rep(seq_len(nrow(rel.ABCD)), each = 4),]
xpand <- c(-1, -1, 1, 1) * 0.5
ypand <- c(-1, 1, 1, -1) * 0.5
new <- transform(
new,
x = x + xpand,
y = y + ypand
)
# Rotate coordinates 45 degrees
rotmat <- matrix(c(-0.5, 0.5, 0.5, 0.5), ncol = 2)
new[, c("x", "y")] <- t(rotmat %*% t(as.matrix(new[, c("x", "y")])))
# Plot
ggplot(new, aes(x, y, group = id)) +
geom_polygon(aes(fill = factor(relation))) +
scale_y_continuous(breaks = seq_along(union),
labels = union) +
coord_equal()
If you want the labels more like your example, you can also coerce these to polygons.
# Make dataframe for labels
labels <- data.frame(
label = union,
x = 0, y = seq_along(union)
)
# Write offset for label polygons
size <- 1
xoffset <- c(-size, -size, 0, 0.5, 0)
yoffset <- c(-0.5, 0.5, 0.5, 0, -0.5)
# Expand every label to a polygon
labels <- labels[rep(seq_len(nrow(labels)), each = 5), ]
labels <- transform(
labels,
x = x + xoffset,
y = y + yoffset
)
ggplot(new, aes(x, y)) +
geom_polygon(aes(fill = factor(relation), group = id),
colour = "black") +
geom_polygon(data = labels, aes(group = label),
colour = "black", fill = NA) +
annotate(
"text",
x = 0, y = seq_along(union), label = union,
hjust = 1
) +
coord_equal() +
guides(x = "none", y = "none")
Created on 2022-04-11 by the reprex package (v2.0.1)
I'm aiming to reproduce an animated figure by Ed Hawkins on climate change in R with gganimate. The figure is called climate spiral. While a static ggplot figure shows the correct order of lines by year (the most recent data on top), the animated plot with transition_reveal() results in a wrong order of the lines.
Here is a reproducible example code with synthetic data:
library(tidyverse)
library(lubridate)
library(gganimate)
library(RColorBrewer)
# Create monthly data from 1950 to 2020 (and a component for rising values with time)
df <- tibble(year = rep(1950:2020, each = 12),
month = rep(month.abb, 2020-1950+1)) %>%
mutate(date = dmy(paste("01",month,year)),
value = rnorm(n(), 0, 2) + row_number()*0.005) %>%
with_groups(year, mutate, value_yr = mean(value))
temp <- df %>%
ggplot(aes(x = month(date, label=T), y = value, color = value_yr)) +
geom_line(size = 0.6, aes(group = year)) +
geom_hline(yintercept = 0, color = "white") +
geom_hline(yintercept = c(-4,4), color = c("skyblue3","red1"), size = 0.2) +
geom_vline(xintercept = 1:12, color = "white", size = 0.2) +
annotate("label", x = 12.5, y = c(-4,0,4), label = c("-4°C","0°C","+4°C"),
color = c("skyblue3","white","red1"), size = 2.5, fill = "#464950",
label.size = NA, label.padding = unit(0.1, "lines"),) +
geom_point(x = 1, y = -11, size = 15, color = "#464950") +
geom_label(aes(x = 1, y = -11, label = year),
color = "white", size = 4,
fill = "#464950", label.size = NA) +
coord_polar(start = 0) +
scale_color_gradientn(colors = rev(brewer.pal(n=11, name = "RdBu")),
limits = range(df$value_yr)) +
labs(x = "", y = "") +
theme_bw() +
theme(panel.background = element_blank(),
panel.border = element_blank(),
panel.grid.major = element_blank(),
plot.background=element_rect(fill="#464950", color="#464950"),
axis.text.x = element_text(margin = margin(t = -20, unit = "pt"),
color = "white"),
axis.text.y = element_blank(),
axis.ticks = element_blank(),
legend.position = "none")
Now, we can either save the plot as PNG or animate and save as GIF:
ggsave(temp, filename = "test.png", width = 5, height = 5, dpi = 320)
# Animate by date:
anim <- temp +
transition_reveal(date) +
ease_aes('linear')
output <- animate(anim, nframes = 100, end_pause = 30,
height = 5, width = 5, units = "in", res = 300)
anim_save("test.gif", output)
Let's see the results!
Static PNG:
Animated GIF:
At first glance, the results look equal, however, the detail shows differences (for instance, the marked blue line).
In this example code with synthetic data, the differences are minor. But with real data, the figures look pretty different as many red lines (recent data points with high temperatures) disappear in the background. So, how can you retain the order in transition_reveal() by date? Any help appreciated, thanks a lot!
This isn't the answer per se. This is the why. You'll have to tell me what you prefer given this information for me to give you a solution.
I tried a few things—each of which I was just sure would work but did not. So, I wanted to see what was happening in ggplot. My hunch proved correct. Your data is in order of value_yr in the png, not year.
I repeat this question at the end:
Either you can put the animation in order of value_yr or you can put the color in ggplot in order by year. Which would you prefer?
How do I know? I extracted the assigned colors in the object.
tellMe <- ggplot_build(temp)$data[[1]]
head(tellMe)
# colour x y group PANEL flipped_aes size linetype alpha
# 1 #1E60A4 1 -1.75990067 1 1 FALSE 0.6 1 NA
# 2 #1E60A4 2 -0.08968196 1 1 FALSE 0.6 1 NA
# 3 #1E60A4 3 -0.69657130 1 1 FALSE 0.6 1 NA
# 4 #1E60A4 4 -0.10777727 1 1 FALSE 0.6 1 NA
# 5 #1E60A4 5 1.57710505 1 1 FALSE 0.6 1 NA
# 6 #1E60A4 6 1.63277369 1 1 FALSE 0.6 1 NA
gimme <- tellMe %>% group_by(group) %>%
summarise(color = unique(colour)) %>%
print(n = 100) # there are less than 100, I just want them all
head(gimme)
# # A tibble: 6 × 2
# group color
# <int> <chr>
# 1 1 #1E60A4
# 2 2 #114781
# 3 3 #175290
# 4 4 #053061
# 5 5 #1C5C9E
# 6 6 #3E8BBF
To me, this indicated that the colors weren't in group order, so I wanted to see the colors to visualize the order.
I used this function. I know it came from a demo, but I don't remember which one. I looked just so I could include that here, but I didn't find it.
# this is from a demo (not sure which one anymore!
showCols <- function(cl=colors(), bg = "lightgrey",
cex = .75, rot = 20) {
m <- ceiling(sqrt(n <-length(cl)))
length(cl) <- m*m; cm <- matrix(cl, m)
require("grid")
grid.newpage(); vp <- viewport(w = .92, h = .92)
grid.rect(gp=gpar(fill=bg))
grid.text(cm, x = col(cm)/m, y = rev(row(cm))/m, rot = rot,
vp=vp, gp=gpar(cex = cex, col = cm))
}
showCols(gimme$color)
The top left color is the oldest year, the value below it is the following year, and so on. The most recent year is the bottom value in the right-most column.
df %>% group_by(yr) %>% summarise(value_yr = unique(value_yr))
# they are in 'value_yr' order in ggplot, not year
# # A tibble: 71 × 2
# yr value_yr
# <int> <dbl>
# 1 1950 0.0380
# 2 1951 -0.215
# 3 1952 -0.101
# 4 1953 -0.459
# 5 1954 -0.00130
# 6 1955 0.559
# 7 1956 -0.457
# 8 1957 -0.251
# 9 1958 1.10
# 10 1959 0.282
# # … with 61 more rows
Either you can put the animation in order of value_yr or you can put the color in ggplot in order by year. Which would you prefer?
Update
You won't use transition_reveal to group and transition by the same element. Unfortunately, I can't tell you why, but it seems to get stuck at 1958!
To make this gif on the left match that ggplot png on the right:
First, I modified the calls to ggplot and geom_line
ggplot(aes(x = month(date, label = T), y = value,
group = yr, color = yr)) +
geom_line(size = .6)
Then I tried to use transition_reveal but noticed that subsequent years were layered underneath other years. I can't account for that odd behavior. When I ran showCol after changing temp, the colors were in order. That ruled out what I had thought the problem was initially.
I modified the object anim, using transition_manual to force the order of the plot layers.
anim <- temp +
transition_manual(yr, cumulative = T) +
ease_aes('linear')
That's it. Now the layers match.
As to whether this would have worked before you changed the color assignment: original plot with manual transitions of the year on the left, ggplot png on the right:
It looks like that would've have worked, as well. So, my original drawn-out explanation wasn't nearly as useful as I thought, but at least you have a working solution now. (Sigh.)
i'm fairly new to R so please excuse me for the noob question.
I have a dataframe that looks like this:
gene ctrl treated
gene_1 100 37.5
gene_2 100 20.2
... ... ...
For each row (ie each gene) in the df, I want to plot the values in such a way that ctrl and treated are one next to the other.
The code below gives something close to what i want, but the output is not grouped as it should: the bars for controls are plotted before the ones for treated samples.
barplot(height = df$df.ctrl1, df$df.avg_treated), names.arg = df$df.gene)
I know there are many similar questions, but i've gone through them with no success.
Anyone can help me understand what am i doing wrong?
Second (optional) question: what if i want to color-code the bars according to the gene id?
Many thanks.
I would use ggplot for this. Let's start with a slightly expanded example:
df <- data.frame(genes = c("gene_1", "gene_2", "gene_3", "gene_4"),
ctrl = c(50, 60, 70, 80),
treated = c(55, 64, 75, 83))
df
#> genes ctrl treated
#> 1 gene_1 50 55
#> 2 gene_2 60 64
#> 3 gene_3 70 75
#> 4 gene_4 80 83
The first thing we need to do is switch the dataframe to long format using tidyr::pivot_longer to put all your values in one column, and the labels of "ctrl" and "treatment" in another column. Then we can use ggplot to build our output:
library(tidyr)
library(ggplot2)
df %>%
pivot_longer(cols = c("ctrl", "treated")) %>%
ggplot(aes(name, value, fill = genes, alpha = name)) +
geom_col(position = position_dodge(), color = "black") +
scale_alpha_manual(values = c(0.5, 1), guide = guide_none()) +
facet_grid(~genes, scales = "free_x", switch = "x") +
theme(strip.placement = "outside",
panel.spacing = unit(0, "points"),
strip.background = element_blank(),
strip.text = element_text(face = "bold", size = 12)) +
labs(x = "Gene")
Created on 2020-08-22 by the reprex package (v0.3.0)
Consider transposing your data, converting into matrix with dimnames. Then run barplot with legend. Below demonstrates with random data. Note: ylim is adjusted for pretty range limit.
set.seed(92220)
df <- data.frame(gene = paste("gene", 1:30),
ctrl = runif(30, 50, 100),
treated = runif(30, 50, 100))
head(df)
# gene ctrl treated
# 1 gene 1 75.74607 76.15832
# 2 gene 2 61.73860 70.19874
# 3 gene 3 56.57906 63.67602
# 4 gene 4 60.23045 80.21108
# 5 gene 5 62.52773 60.86909
# 6 gene 6 85.71849 61.25974
# TRANSPOSE INTO MATRIX WITH DIMNAMES
dat <- `dimnames<-`(t(as.matrix(df[c("ctrl", "treated")])),
list(c("ctrl", "treated"), df$gene))
barplot(dat, beside=TRUE, col=c("blue", "red"), las=3,
main="Control Vs. Treatment",
ylim=range(pretty(c(0, dat*1.05))))
legend("top", legend=row.names(dat),
fill=c("blue", "red"), ncol=2, cex=0.75)
# Data:
zz <- "Small Large Lat Long
1 51 2 11 10
2 49 0 12 11
3 77 7 13 13
4 46 5 12 15
5 32 6 13 14
6 54 3 15 17
7 68 0 14 10
8 39 5 12 13"
Data <- as.data.frame(read.table(text=zz, header = TRUE))
I have a continuous variable, a ratio (small/large), I am successfully plotting.
Although, some 0s exist within the 'large' variable. When this occurs, I just want to plot the 'small' number as a ratio is impossible. To do this I have the following:
ratio.both <- Data %>%
filter(Large > 0) %>%
mutate(Ratio = Small/Large)
only.sml<- Data %>%
filter(Large < 1)
I then plot both on the same graph (by lat long data):
ggplot() +
geom_point(data = ratio.both,
aes(x = Long,
y = Lat,
size = Ratio),
stroke = 0,
colour = '#3B3B3B',
shape=16) +
#
geom_point(data = only.sml,
aes(x = Long,
y = Lat,
size = Small,
shape=1),
stroke = 1,
shape=1)
Notice the difference in shape. This plots the following
not the nicest graph but demonstrates example
The difference between those which are a ratio (filled) and those which are just the small value is clear on the map but difficult in the legend.
I want the following in the legend:
#Title
Size = both.ratio$Ratio,
Shape/fill = Ratio or small value #whichever is easier
It is much easier to use variables in the table to contrast the data using the built in aesthetics mapping, instead of creating separate geoms for the small and large data. You can for example create a new variable that checks whether that datapoint belongs to the large or small "type". You can then map shape, color, size or whatever you want in aesthetics and optionally add scales for these manually (if you want).
Data %>%
mutate(is_large = ifelse(Large > 0, "Ratio", "Small"),
size = ifelse(is_large == "Large", Small/Large, Small)) %>%
ggplot(aes(Long, Lat,
size = size,
shape = is_large)) +
geom_point() +
scale_shape_manual(values = c("Ratio" = 16, "Small" = 1),
name = "Size") +
scale_size_continuous(name = "Ratio/small value")
Or if you want to contrast by point color:
Data %>%
mutate(is_large = ifelse(Large > 0, "Ratio", "Small"),
size = ifelse(is_large == "Large", Small/Large, Small)) %>%
ggplot(aes(Long, Lat,
size = size,
color = is_large)) +
geom_point() +
scale_color_manual(values = c("Ratio" = "blue", "Small" = "red"),
name = "Size") +
scale_size_continuous(name = "Ratio/small value")
I’d like to use ggplot to draw a grid plot of the following scenario which I’ve attempted to depict in the picture below... I could use some guidance on how to logically think about the approach. Thank you for the guidance.
--
Each aisle in the example picture below has an odd number side—and an even number side
The spaces on the odd-side are listed ascending from 1… K where K is odd
The spaces on the even-side are listed ascending from 2…N where N is even
This pattern exists for each aisle in the parking lot
If a car is parked in a space—we track that spot in a database.
How can I reproduce a grid-level ggplot to indicate with a symbol on the plot all spaces where a car is parked?
The listing of occupied spaces would be “fed” into the ggplot logic via a .csv file: the format of the .csv would look something like this:
A01
A04
A05
A08
A09
A15
A20
A33
B07
B31
B44
C01
C04
C36
...
Image credit: Michael Layefsky, 2010, Google Images
My experience with direct use of grid is limited, so I can't say how hard this would be with grid functions, but it seems reasonably straightforward in ggplot2. Here's a simple example that is (I hope) not too far off from what you're looking for:
library(ggplot2)
# Set up grid of space identifiers
df = data.frame(y=1:10, x=rep(c(0:1, 3:4, 6:7), each=10),
space=paste0(rep(c("A","B","C"), each=20),
rep(c(seq(2,20,2),seq(1,20,2)), 3)),
stringsAsFactors=FALSE)
# Assume we have a vector of occupied spaces
set.seed(194)
occupied = sample(df$space, 30)
# Mark occupied spaces in data frame
df$status = ifelse(df$space %in% occupied, "Occupied", "Available")
ggplot(df) +
geom_segment(aes(x=x - 0.5, xend=x + 0.5, y=y, yend=y - 1)) +
geom_label(aes(label=space, x=x, y=y, fill=status), colour="blue", label.size=0) +
annotate(geom="segment", x=seq(0.5,6.5,3), xend=seq(0.5,6.5,3),
y=rep(0,3), yend=rep(10,3), lty="11") +
theme_bw(base_size=14) +
scale_fill_manual(values=c(hcl(c(105,15),100,65))) +
#scale_fill_manual(values=c(NA, hcl(15,100,65))) + # Color only occupied spaces
theme(axis.text = element_blank(),
axis.ticks = element_blank(),
panel.grid = element_blank()) +
labs(x="",y="",fill="")
If you are taking a list of only the occupied spots as input in the form that you showed, and then you want to produce a visualization of occupied spots using ggplot2, this approach will work. First, I process the input, turning it into something that I can give ggplot easily.
# the provided example data
d <- read.table(text="
A01
A04
A05
A08
A09
A15
A20
A33
B07
B31
B44
C01
C04
C36", stringsAsFactors=FALSE)
Split the "spaces" into meaningful coordinates. I kept the original space names around for later labeling. What follows is all manipulation used to get the plot set up correctly.
cars <- strsplit(d[,1], "(?<=[A-Z])", perl=TRUE) # split the raw data
# turn resulting list into data.frame and give it names
cars <- setNames(do.call(rbind.data.frame, cars), c("aisle","spot.num"))
# convert the from factors to numeric,
# and turn the aisle letter into numeric data for plotting
# retain the original spot id for labeling the plot
cars <- with(cars, data.frame(
spot.num = as.numeric(as.character(spot.num)),
aisle = aisle, # keep this around for faceting
aisle.coord = 2 * (utf8ToInt(paste(as.character(aisle), collapse="")) - utf8ToInt("A")),
spot.id = d[,1]))
I multiplied the aisle by 2 after converting A to 1, B to 2, and so on, to make a new variable called aisle.coord. The reason for multiplying by 2 is to set up a variable where each aisle can be composed of two lines:
# if the spot number is even, increment aisle by 1 (put it on the right).
# This is possible because I multiplied by 2 earlier
cars$aisle.coord[cars$spot.num %% 2 == 0] <- cars$aisle.coord[cars$spot.num %% 2 == 0] + 1
# We need to adjust the spot numbers to real row numbers
# i.e. A02 is in row 1, not row 2, A10 is in row 5, etc.
cars$spot <- ceiling(cars$spot.num / 2)
Now, the plotting:
library(ggplot2)
library(grid) # for unit()
ggplot(cars, aes(x = aisle.coord %% 2, y = spot)) +
geom_tile(width = 0.5, height = 0.8) +
facet_grid(~aisle) +
geom_text( aes(x = aisle.coord %% 2, y = spot, label = spot.id), color = "white")
That is a bare-bones attempt at the graph. Lots of room for you to improve and adjust it. Here is another attempt with a little more effort. Still, plenty of room for adjustment (e.g. you could adjust the plot so that a the full lot appears, not just the part of the lot up to the maximum spot: B44):
ggplot(cars, aes(x = aisle.coord %% 2, y = spot)) +
geom_tile(width = 0.5, height = 0.8, fill = "orange") +
facet_grid(~aisle) +
geom_text( aes(x = aisle.coord %% 2, y = spot, label = spot.id), color = "white", size = 4) +
annotate("rect", ymin = 0, ymax = max(cars$spot)+0.5, xmin = 0.3, xmax = 0.7, fill = "grey40") +
theme(panel.margin.x = unit(0.05, "lines"),
plot.background = element_rect("grey40"),
panel.background = element_rect("grey40"),
panel.grid.minor = element_blank(),
axis.title = element_blank(),
axis.text = element_blank(),
strip.text = element_blank(),
strip.background = element_blank()) +
scale_y_continuous(breaks = seq(0.5, (max(cars$spot) + 0.5), 1)) +
scale_x_continuous(breaks = c(-0.3, 1.3)) +
geom_text(data=data.frame(x = 0.5, y = 10, aisle = LETTERS[1:length(unique(cars$aisle))]),
aes(x = x, y = y, label = aisle), inherit.aes = FALSE, color = "white")