pattern aesthetic for ggplot2 geom_bar? #4
Comments
|
I've thought of an ugly solution which wouldn't be an aes: using ImageMagick I could make holes in the picture for each colour and overlay the picture on the pattern, and repeat this for each fill. |
|
Hum, this would be quite ugly. library("colourlovers")
library("ggplot2")
# plot for testing idea
qplot(factor(cyl), data=mtcars, geom="bar", fill=factor(cyl)) +
scale_fill_manual(values = c("red", "blue", "darkgreen"))
ggsave(file = "test.png", height = 10, width = 10, units = "cm")
i <- 1
for(col in c("red", "blue", "darkgreen")){
# make colour transparent
shell(paste0("convert test.png -fuzz 10% -transparent ",col," test.png"))
# download a popular pattern
jpeg("pattern1.jpg", height = 480, width = 480)
plot(clpatterns('top')[[i]])
dev.off()
shell("convert -size 393x393 pattern1.jpg -resize 1181x1181 pattern1.jpg")
# create the overlayed picture
shell("composite test.png pattern1.jpg test.png")
i <- i+1
}
Plus using the loop there is a risk to modify the patterns that were already applied.
|
|
That's actually a pretty awesomely terrible graph. I think theme still hope for this, that specific example aside. |
|
Yeah I've given it more thought and I still long for it actually. That'd be so cool. I'd be better to use the raster returned by the API. I'll go and have a look at the ggplot2 repo which will make me smarter! |
|
So I'm going to stop now but I explored an idea. ### packages
library("dplyr")
library("tidyr")
library("httr")
library("grid")
library("ggplot2")
# get pattern
p <- clpattern('1047011', fmt='json')
picture <- content(GET(p$imageUrl))
# picture is a 4 dimensional array
img <- as.raster(picture)
# rectangle example
d=data.frame(x1=c(1,3,1,5,4), x2=c(2,4,3,6,6), y1=c(1,1,4,1,3), y2=c(2,2,5,3,5), t=c('a','a','a','b','b'), r=c(1,2,3,4,5))
# data.frame with hex info for each point,
# x and y resized for filling the biggest rectangle
maxX <- max(d$x2 - d$x1)
maxY <- max(d$y2 - d$y1)
maxx <- max(maxX, maxY)
img2 <- tbl_df(as.data.frame(as.matrix(img)))
names(img2) <- 1:ncol(img2)
row.names(img2) <- nrow(img2):1
img2 <- img2 %>%
mutate(y = row.names(img2)) %>%
gather(x, value, 1:ncol(img)) %>%
mutate(x = as.numeric(x),
y = as.numeric(y)) %>%
mutate(x = (x/max(x)) * maxx,
y = (y/max(y)) * maxx)
# basic plot
p <- ggplot() +
scale_x_continuous(name="x") +
scale_y_continuous(name="y") +
geom_rect(data=d, mapping=aes(xmin=x1, xmax=x2, ymin=y1, ymax=y2, fill=t), color="black", alpha=0.5) +
geom_text(data=d, aes(x=x1+(x2-x1)/2, y=y1+(y2-y1)/2, label=r), size=4) +
theme(legend.position = "none")
ggsave(p, file = "basic.png")
# now add the pattern filling to each rectangle
for (i in 1:nrow(d)){
# only keep part of the data.frame/pattern
xmax <- d[i, "x2"] - d[i, "x1"]
ymax <- d[i, "y2"] - d[i, "y1"]
dataPlot <- filter(img2,
x <= xmax,
y <= ymax) %>%
# and shift the coordinates
mutate(x = x + d[i, "x1"],
y = y + d[i, "y1"])
p <- p +
geom_point(data=dataPlot, aes(x, y, col = value))
}
ggsave(p, file = "lion.png")
This is encouraging but:
We'll see if it leads me anywhere some day... Maybe I should ask for help on Twitter? Or would you ask? Anyway, it's nice to learn more about ggplot2! |
|
Maybe I should make this an issue for the Ropensci unconf but I doubt that wanting to put cute animals on ggplot2 is relevant. 😄 |
|
Better try, thanks to Jim Hester. ### packages
library("dplyr")
library("tidyr")
library("httr")
library("grid")
library("ggplot2")
library("colourlovers")
# get pattern
p <- clpattern('1047011', fmt='json')
picture <- content(GET(p$imageUrl))
# picture is a 4 dimensional array
img <- as.raster(picture)
# rectangle example
d=data.frame(x1=c(1,3,1,5,4), x2=c(2,4,3,6,6), y1=c(1,1,4,1,3), y2=c(2,2,5,3,5), t=c('a','a','a','b','b'), r=c(1,2,3,4,5))
# data.frame with hex info for each point,
# x and y resized for filling the biggest rectangle
maxX <- max(d$x2 - d$x1)
maxY <- max(d$y2 - d$y1)
maxx <- max(maxX, maxY)
img2 <- tbl_df(as.data.frame(as.matrix(img)))
names(img2) <- 1:ncol(img2)
row.names(img2) <- nrow(img2):1
img2 <- img2 %>%
mutate(y = row.names(img2)) %>%
gather(x, value, 1:ncol(img)) %>%
mutate(x = as.numeric(x),
y = as.numeric(y)) %>%
mutate(x = (x/max(x)) * maxx,
y = (y/max(y)) * maxx)
# basic plot
p <- ggplot() +
scale_x_continuous(name="x") +
scale_y_continuous(name="y") +
geom_rect(data=d, mapping=aes(xmin=x1, xmax=x2, ymin=y1, ymax=y2, fill=t), color="black", alpha=0.5) +
geom_text(data=d, aes(x=x1+(x2-x1)/2, y=y1+(y2-y1)/2, label=r), size=4) +
theme(legend.position = "none")
ggsave(p, file = "basic.png")
# now add the pattern filling to each rectangle
for (i in 1:nrow(d)){
# only keep part of the data.frame/pattern
xmax <- d[i, "x2"] - d[i, "x1"]
ymax <- d[i, "y2"] - d[i, "y1"]
dataPlot <- filter(img2,
x <= xmax,
y <= ymax)
dataPlot <- dataPlot %>%
# and shift the coordinates
mutate(x = x + d[i, "x1"],
y = y + d[i, "y1"])
p <- p + geom_raster(data = dataPlot, aes(x, y), fill = dataPlot$value)
}
ggsave(p, file = "lion.png")
|
|
I may have an idea for doing a legend. I could extract the first colour of the pattern (first in the list, it might not be the most important one in the pattern?) and use it as fill before adding the pattern. That'd be easy and would do the job. I still don't know how to better resize/crop. |
|
New progress! Better resizing/cropping I think. ### packages
library("dplyr")
library("tidyr")
library("httr")
library("grid")
library("ggplot2")
library("colourlovers")
# get pattern
p <- clpattern('1047011', fmt='json')
picture <- content(GET(p$imageUrl))
# picture is a 4 dimensional array
img <- as.raster(picture)
# rectangle example
d=data.frame(x1=c(1,3,1,5,4), x2=c(2,4,3,6,6), y1=c(1,1,4,1,3), y2=c(2,2,5,3,5), t=c('a','a','a','b','b'), r=c(1,2,3,4,5))
# find the smallest distance between x/y
maxX <- min(d$x2 - d$x1)
maxY <- min(d$y2 - d$y1)
maxx <- min(maxX, maxY)
# basic plot
p <- ggplot() +
scale_x_continuous(name="x") +
scale_y_continuous(name="y") +
geom_rect(data=d, mapping=aes(xmin=x1, xmax=x2, ymin=y1, ymax=y2, fill=t), color="black", alpha=0.5) +
geom_text(data=d, aes(x=x1+(x2-x1)/2, y=y1+(y2-y1)/2, label=r), size=4) +
theme(legend.position = "none")
ggsave(p, file = "basic.png")
# now add the pattern filling to each rectangle
for (i in 1:nrow(d)){
# we have to repeat the data.frame/pattern
xmax <- d[i, "x2"] - d[i, "x1"]
ymax <- d[i, "y2"] - d[i, "y1"]
sizex <- ceiling(xmax/maxx)
sizey <- ceiling(ymax/maxx)
size <- max(sizex, sizey)
img2 <- apply(img,MARGIN=1,function(x) rep(x,size))
img2 <- apply(img2,MARGIN=1,function(x) rep(x,size))
# from matrix to data.frame
img2 <- tbl_df(as.data.frame(as.matrix(img2)))
names(img2) <- 1:ncol(img2)
row.names(img2) <- nrow(img2):1
dataPlot <- img2 %>%
mutate(y = row.names(img2)) %>%
gather(x, value, 1:ncol(img2)) %>%
mutate(x = as.numeric(x)/nrow(img2)*size,
y = as.numeric(y)/nrow(img2)*size)
# only keep the points that are in the rectangle
dataPlot <- dataPlot %>%
filter(x <= xmax, y <= ymax)
dataPlot <- dataPlot %>%
# and shift the coordinates
mutate(x = x + d[i, "x1"],
y = y + d[i, "y1"])
p <- p + geom_point(data = dataPlot, aes(x, y), col = dataPlot$value)
}
ggsave(p, file = "lion.png")
|
|
Ooh, fun. Want to put together a vignette?
|
|
I'm having way too much fun with this actually. When I've something substantial for a geom_bar I'll write something up and stop polluting your issues board, hehe. For what else could it be good to have pattern fills? I guess only rectangles and geom_bar? |
|
Background images?
|
|
Ah yes you're right. So
I won't be very fast but eventually I want to write the code and explanations. It makes my heart happy to see the small lions in my RStudio Viewer! |
|
First geom_bar try. Strange borders + I have to do something about the x/y ratio. ########
# geom_bar
library("dplyr")
library("tidyr")
library("httr")
library("grid")
library("ggplot2")
library("colourlovers")
# Generate data
c <- ggplot(mtcars, aes(factor(cyl)))
# By default, uses stat="bin", which gives the count in each category
c <- c + geom_bar(width=.5)
# get pattern
p <- clpattern('5171987', fmt='json')
picture <- content(GET(p$imageUrl))
# picture is a 4 dimensional array
img <- as.raster(picture)
index <- 0
for (i in levels(as.factor(mtcars$cyl))){
index <- index + 1
# we have to repeat the data.frame/pattern
xmax <- 1
ymax <- sum(mtcars$cyl==i)
size <- ymax
img2 <- apply(img,MARGIN=2,function(x) rep(x,size))
# from matrix to data.frame
img2 <- tbl_df(as.data.frame(as.matrix(img2)))
names(img2) <- seq(index - 0.25, to = index + 0.25, length = ncol(img2))
dataPlot <- img2 %>%
mutate(y = seq(from = 0, to = ymax, length = nrow(img2))) %>%
gather(x, value, 1:ncol(img2)) %>%
mutate(x = as.numeric(x))
c <- c + geom_point(data = dataPlot, aes(x, y), col = dataPlot$value)
}
ggsave(c+ coord_fixed(ratio = 1/4), file = "geombar.png", width = 10, height = 10)
|
|
I really have to fight the x/y ratio thing. This is an example with the 5 most popular patterns. ### packages
library("dplyr")
library("tidyr")
library("httr")
library("grid")
library("ggplot2")
library("colourlovers")
# get pattern
p <- clpatterns(set = "top", fmt='json')[1:5]
dataPatterns <- tbl_df(data.frame(id = do.call("c", lapply(p, "[[", 1)),
numVotes = do.call("c", lapply(p, "[[", 5)),
imageURL = do.call("c", lapply(p, "[[", 13)))) %>%
mutate(id = factor(id, levels = id[order(numVotes, decreasing = TRUE)], ordered = TRUE))
firstCol <- NULL
for (i in 1:nrow(dataPatterns)){
firstCol <- c(firstCol, p[[i]][10]$colors[[2]])
}
dataPatterns <- dataPatterns %>%
mutate(firstCol = paste0("#",firstCol),
numVotes = numVotes / 1000)
# boring -- I used the second colour because the first was too similar across patterns
boring <- ggplot(dataPatterns) +
geom_bar(aes(x = id, y = numVotes, fill = id),
stat = "identity", width = .5) +
scale_fill_manual(values = dataPatterns$firstCol) +
ylab("Number of loves (kilo-love)") +
xlab("Pattern ID")
ggsave(boring, file = "boring.png", width = 10, height = 10)
# Now make it beautiful!
for (i in 1:nrow(dataPatterns)){
# get pattern
picture <- content(GET(as.character(dataPatterns$imageURL[i])))
# picture is a 4 dimensional array
img <- as.raster(picture)
# we have to repeat the data.frame/pattern
xmax <- 1
ymax <- dataPatterns$numVotes[i]
size <- ymax
img2 <- apply(img,MARGIN=2,function(x) rep(x,size))
# from matrix to data.frame
img2 <- tbl_df(as.data.frame(as.matrix(img2)))
names(img2) <- seq(i - 0.25, to = i + 0.25, length = ncol(img2))
dataPlot <- img2 %>%
mutate(y = seq(from = 0, to = ymax, length = nrow(img2))) %>%
gather(x, value, 1:ncol(img2)) %>%
mutate(x = as.numeric(x))
boring <- boring + geom_point(data = dataPlot, aes(x, y), col = dataPlot$value)
}
ggsave(boring + coord_fixed(ratio = 1/4),
file = "cool.png", width = 10, height = 10)
|
|
(and the upper and right borders of each bar are so weird!) |
|
I've made good progress now. I use coord_fixed and get the range of the x and y axis from ggplot_build(). ### packages
library("dplyr")
library("tidyr")
library("httr")
library("grid")
library("ggplot2")
library("colourlovers")
# get pattern
p <- clpatterns(keywords = "dog")[1:5]
dataPatterns <- tbl_df(data.frame(id = do.call("c", lapply(p, "[[", 1)),
numVotes = as.numeric(do.call("c", lapply(p, "[[", 5))),
imageURL = do.call("c", lapply(p, "[[", 13)))) %>%
mutate(id = factor(id, levels = id[order(numVotes, decreasing = TRUE)], ordered = TRUE))
firstCol <- NULL
for (i in 1:nrow(dataPatterns)){
firstCol <- c(firstCol, p[[i]][10]$colors[[4]])
}
dataPatterns <- dataPatterns %>%
mutate(firstCol = paste0("#",firstCol))
# boring -- I used the third colour because the first was too similar across patterns
boring <- ggplot(dataPatterns) +
geom_bar(aes(x = id, y = numVotes, fill = id),
stat = "identity", width = .5) +
scale_fill_manual(values = dataPatterns$firstCol) +
ylab("Number of votes") +
xlab("Pattern ID")
plotInfo <- ggplot_build(boring)
extentX <- diff(plotInfo$panel$ranges[[1]]$x.major_source)[1]
extentY <- diff(plotInfo$panel$ranges[[1]]$y.major_source)[1]
boring <- boring + coord_fixed(ratio = extentX/extentY)
ggsave(boring, file = "boring.png", width = 10, height = 10)
# Now make it beautiful!
for (i in 1:nrow(dataPatterns)){
# get pattern
picture <- content(GET(as.character(dataPatterns$imageURL[i])))
# picture is a 4 dimensional array
img <- as.raster(picture)
# we have to repeat the data.frame/pattern
xmax <- 1
ymax <- dataPatterns$numVotes[i]
size <- ceiling(ymax*2/extentY)
img2 <- apply(img,MARGIN=2,function(x) rep(x,size))
# from matrix to data.frame
img2 <- tbl_df(as.data.frame(as.matrix(img2)))
names(img2) <- seq(i - 0.25, to = i + 0.25, length = ncol(img2))
dataPlot <- img2 %>%
mutate(y = seq(from = size/2*extentY, to = 0, length = nrow(img2)))%>%
gather(x, value, 1:ncol(img2)) %>%
filter(y <= ymax) %>%
mutate(x = as.numeric(x))
boring <- boring + geom_point(data = dataPlot, aes(x, y), col = dataPlot$value)
}
ggsave(boring,
file = "cool.png", width = 10, height = 10)
|
|
draft of a future vignette? https://github.com/masalmon/colourlovers_patterns |
|
I'll first write it and then fork this repo etc. -- that is, if you want to add the vignette, obviously. |
|
This is really cool! Good work! |
|
Related blog post http://www.masalmon.eu/2017/02/19/babarplot/ |
|
Nice try, but its still far away from nice pattern that work on black and white print outs. |
|
What about a simple pattern with lines? Like slanted lines, cross lines, etc? |
|
check out https://github.com/clauswilke/ggtextures |
|
ah sorry just saw I had already posted this link! See also https://coolbutuseless.github.io/2020/04/01/introducing-ggpattern-pattern-fills-for-ggplot/ |
|
IMO both ggtextures and ggpattern are not ideal solutions as they can't simply be integrated into ggplot. One place where this seamless integration becomes essential is when using stat_summary some_plot + Currently, there's no way to add a pattern in this manner. |
I'm opening issue with no pressure on you!
If I were to write such a code I'd need to:
The text was updated successfully, but these errors were encountered: