I am trying to plot a heatmap of a country with some points that are probabilities of occurrence of a event.
What I did up to now is next:
library(raster)
library(ggplot2)
Uruguay <- getData("GADM",country="Uruguay",level=0)
ggplot(Uruguay,aes(x=long,y=lat,group=group)) +
ggplot2::lims(x = c(-60, -50), y = c(-35, -30))+
geom_polygon(aes(x = long, y = lat, group = group, fill=id),color="grey30")+
coord_map(xlim=c(-1,1)+bbox(Uruguay)["x",],ylim=c(-1,1)+bbox(Uruguay)["y",])+
scale_fill_discrete(guide="none")+
theme_bw()+theme(panel.grid=element_blank())
my data to produce the heatmap is
prob <- c(10,20,90,40)
lat <- c(-30.52,-32.04,-33.16,-34.28)
long <- c(-57.40,-55.45,-56.35,-56.40)
data <- data.frame(prob, lat, long)
I think that using ggplot2::stat_density2d and ggplot2::scale_fill_gradientn is the way to go but I don't know how to implement it. I want to produce a heatmap like that
Any help is Welcome.
Thanks in advance.
To plot the example data you could just use plot
library(raster)
Uruguay <- getData("GADM",country="Uruguay",level=0)
plot(Uruguay, col="orange")
As for the map you want to make, there are a lot of choices involved. But here is a basic example
prob <- c(10,20,90,40)
lat <- c(-30.52,-32.04,-33.16,-34.28)
long <- c(-57.40,-55.45,-56.35,-56.40)
data <- data.frame(prob, lat, long)
r <- raster(Uruguay, res=.5)
x <- rasterize(cbind(long, lat), r, prob)
plot(x)
lines(Uruguay)
Finally I could get what I wanted. Henrik's answer in this post was very helpful
I share the code with you
library(raster)
library(reshape2)
library(ggplot2)
Uruguay <- getData("GADM",country="Uruguay",level=1)
#invented data
prob <- c(5, 90,10,15,99,40,90,25,70,90)
lat <- c(-31,-31.2,-31.3,-34,-32.5,-32.6,-33.7,-34.9,-34.2,-32.5)
long <- c(-58.3,-55.1,-57.3,-58.4,-56.5,-54,-57.7,-55.8,-54.1,-53.5)
prueba <- data.frame(prob, lat, long)
library(akima)
fld <- with(prueba, interp(x = long, y = lat, z = prob))
class(Uruguay)
uru <- fortify(Uruguay)
library(reshape2)
# prepare data in long format
df <- melt(fld$z, na.rm = TRUE)
names(df) <- c("x", "y", "prob")
df$long <- fld$x[df$x]
df$lat <- fld$y[df$y]
ggplot() +
geom_polygon(data = uru, aes(x = long, y = lat, group = group),
colour = "black", size = 0.5, fill = "white") +
geom_tile(data = df, aes(x = long, y = lat, z = prob, fill = prob), alpha = 0.8) +
ggtitle("Frost probability") +
xlab("Longitude") +
ylab("Latitude") +
scale_fill_continuous(name = "Probability (%)",
low = "red", high = "blue") +
theme_bw() +`enter code here`
theme(plot.title = element_text(size = 25, face = "bold"),
legend.title = element_text(size = 15),
axis.text = element_text(size = 15),
axis.title.x = element_text(size = 20, vjust = -0.5),
axis.title.y = element_text(size = 20, vjust = 0.2),
legend.text = element_text(size = 10)) +
coord_map()
Related
Suppose we want to plot this data:
library(ggplot2)
library(sf)
library(raster)
library(colorRamps)
min_lon <- 10
max_lon <- 17
min_lat <- 8
max_lat <- 17
grid_size <- 0.5
lon_grids <- 1 + ((max_lon - min_lon)/grid_size)
lat_grids <- 1 + ((max_lat - min_lat)/grid_size)
points <- data.frame(lon = rep(seq(min_lon, max_lon, grid_size), lat_grids), lat = rep(seq(min_lat, max_lat, grid_size), each = lon_grids))
points$Var <- runif(min= 10, max = 48, 285)
points$value <-cut(points$Var, breaks= seq(10.08, 47.80, length.out = 13), dig.lab = 1)
ggplot() +
coord_sf(xlim = c(min_lon, max_lon), ylim = c(min_lat, max_lat)) +
theme_bw()+
geom_raster(data = points, aes(x = lon, y = lat, fill = value), interpolate = FALSE) +
labs(x="Longitude", y="Latitude")+
scale_fill_manual(values = matlab.like(n = 13), name = "[m]",
labels = sprintf("%.2f", seq(10.08, 47.80, length.out = 13)),
guide = guide_legend(reverse = TRUE))+theme(legend.position = "bottom")
This code produces the following graph:
Two problems I am facing here:
To make it discrete, I used the cut function. I chose the breaks= seq(10.08, 47.80, length.out = 13) arbitrary based on the minimum and maximum values with a random length of 13. Is there any criteria to decide the correct range?
Is there any way to make the legend look like this?
One option would be to use e.g. scale_fill_stepsn with guide_binswhich does not require to manually discretize the variable mapped on fill. Additionally I use a custom function to set the breaks of the legend instead of the default mechanism to set the number of breaks.
set.seed(123)
library(ggplot2)
library(colorRamps)
base <- ggplot() +
coord_sf(xlim = c(min_lon, max_lon), ylim = c(min_lat, max_lat)) +
theme_bw() +
geom_raster(data = points, aes(x = lon, y = lat), interpolate = FALSE) +
labs(x = "Longitude", y = "Latitude") +
theme(legend.position = "bottom")
base +
aes(fill = Var) +
scale_fill_stepsn(colors = matlab.like(n = 13), name = "[m]",
breaks = function(x) seq(x[[1]], x[[2]], length.out = 13),
labels = ~ sprintf("%.0f", .x),
guide = guide_bins(axis = FALSE,
show.limits = TRUE))
I generated a heatmap with ggplot, and order the samples by using hclust, However, I still need more reordering to get all the similar values corespondent with one of the samples in the ordered cluster. Here I generate a samples data to explain better.
set.seed(99)
M <- data.frame(names = paste0("g", seq(1,30)), S1 = runif(30, 0 , 8), S2 = runif(30, -4, 5), S3 = runif(30, -5, 5))
M.mat <- M %>%
tibble::column_to_rownames('names') %>%
as.matrix()
M.dendro <- as.dendrogram(hclust(d = dist(x = M.mat)))
dendro.plot <- ggdendrogram(data = M.dendro, rotate = TRUE) +
theme(axis.text.y = element_text(size = 6))
print(dendro.plot)
str(M.dendro)
dend.order <- order.dendrogram(M.dendro)
df <- melt(M, id.vars = "names")
df$names <- factor(x = df$names,
levels = M$names[dend.order],
ordered = TRUE)
ggplot(df, aes(x = names, y = variable, fill = value)) +
geom_tile(color = "black") +
scale_fill_gradient2(low = muted("steelblue"), mid = "white", high = muted("red3"),
midpoint = 0, space = "Lab", na.value = "grey50",
guide = "colourbar", aesthetics = "fill"
) +
theme(axis.text.x = element_text(angle = 90, hjust=1), legend.key.size = unit(0.4, "cm")) +
coord_fixed()
For the generated heatmap, I need reorder it such that all the dark blue be on the bottom, the middle color and then the red on the top based on samples S3. Thank you
I'm encountering an issue with the geom_errorbar argument where I receive the error Error: geom_errorbar requires the following missing aesthetics: x or y, xmin and xmax.
I have several datasets and would like to use them all to create a single geographical ggplot. Below is a workflow and some example data. The desired plot will have background location data in dat, the centroids in centroids and x and y errorbars/standard deviation ranges for for the centroids which are calculated in the centroids dataframe (i.e., "Longitude_weighted_sd" and "Latitude_weighted_sd".
#packages
packages<-c('tidyverse','sf','rgdal','rnaturalearth','ggspatial','raster','sp', 'cowplot',
'dplyr','ggplot2','lubridate','stargazer', 'purrr', 'geosphere', 'purrr')
lapply(packages, library, character.only = T)
library(ggplot2)
library(sf)
library(rnaturalearth)
library(rgdal)
library(ggspatial)
library(spData)
library(cowplot)
library(tidyverse)
#download geographical and upload personal/mock data
world <- ne_countries(scale = "medium", returnclass = "sf")
states <- map_data("state")
data("us_states", package = "spData")
dat <- data.frame(Latitude = c(35.8, 35.85, 36.7, 35.2, 36.1, 35.859, 36.0, 37.0, 35.1, 35.2),
Longitude = c(-89.4, -89.5, -89.4, -89.8, -90, -89.63, -89.7, -89, -88.9, -89),
Period = c("early", "early", "early", "early", "early", "late", "late", "late", "late", "late"),
State = c("A", "A", "A", "T", "T", "T", "T", "A", "A", "A"))
#function to calculate weighted variance, sd, and se
weighted.var <- function(x, w = NULL, na.rm = FALSE) {
if (na.rm) {
na <- is.na(x) | is.na(w)
x <- x[!na]
w <- w[!na]
}
sum(w * (x - weighted.mean(x, w)) ^ 2) / (sum(w) - 1)
}
weighted.sd <- function(x, w, na.rm = TRUE) sqrt(weighted.var(x, w, na.rm = TRUE))
weighted.se <- function(x, w, na.rm = TRUE) sqrt(weighted.var(x, w, na.rm = TRUE))/sqrt(length(x))
#calculate centroids for "early" and "late" periods weighted by "State" observations
centroids <- dat %>%
group_by(Period, State) %>%
mutate(weight = 1/n()) %>%
group_by(Period) %>%
summarise(across(starts_with("L"),
list(weighted_mean = ~ weighted.mean(.x, w = weight),
weighted_sd = ~ weighted.sd(.x, w = weight),
weighted_se = ~ weighted.se(.x, w = weight))))
If I take out the geom_errorbar argument everything works great. However when I add it in I receive the error that geom_error requires the following missing aesthetics:x or y, xmin and xmax however, I thought that I've specified everything. Below is the ggplot2 code. Any help would be greatly appreciated!
plot1 <- ggplot(data = world) +
geom_sf(fill = "gray92") + #light gray
geom_polygon(data = states, aes(x = long, y = lat, group = group), #states outline
color = "black", fill = NA) +
geom_point(data = dat, aes(x = Longitude, y = Latitude, color = Period), #background data
alpha = 0.2, size = 1) +
geom_point(data = centroids, aes(x = Longitude_weighted_mean, y = Latitude_weighted_mean,
fill = period), size = 6, pch = 21) + #centroids
geom_errorbar(data = centroids,
aes(ymin = Latitude_weighted_mean - Latitude_weighted_sd,
ymax = Latitude_weighted_mean + Latitude_weighted_sd,
xmin = Longitude_weighted_mean + Longitude_weighted_sd,
xmax = Longitude_weighted_mean + Longitude_weighted_sd), #errorbars
) +
theme_bw() +
coord_sf(crs = "+proj=aea +lat_1=29.5 +lat_2=45.5 +lat_0=37.5 +lon_0=-96 +x_0=0 +y_0=0 +ellps=GRS80 +datum=NAD83 +units=m +no_defs") +
coord_sf(xlim = c(-92, -88), ylim = c(33.5, 36.7), expand = TRUE) +
theme(plot.title = element_text(size = 20),
legend.title = element_text(size = 20),
legend.text = element_text(size = 16),
axis.title = element_text(size = 20),
axis.text = element_text(size = 16),
axis.text.x = element_text(angle = 45, hjust = 1),
element_line(color = "black"))+
annotate("text", label = "TN", size = 7, x = -88.3, y = 35.3) +
annotate("text", label = "AR", size = 7, x = -91.7, y = 36) +
annotate("text", label = "MS", size = 7, x = -89, y = 34) +
xlab("Longitude") + ylab("Latitude")
plot1
Thank you in advance for anyone willing to assist. -nm
The issue is that you try two add the error bars via one geom_errorbar and as the error message is telling you you neither provided x nor y. Instead I would suggest to add your error bars via two geom_errorbars like so:
library(ggplot2)
library(rnaturalearth)
library(tidyverse)
ggplot(data = world) +
geom_sf(fill = "gray92") + # light gray
geom_polygon(
data = states, aes(x = long, y = lat, group = group), # states outline
color = "black", fill = NA
) +
geom_point(
data = dat, aes(x = Longitude, y = Latitude, color = Period), # background data
alpha = 0.2, size = 1
) +
geom_point(data = centroids, aes(
x = Longitude_weighted_mean, y = Latitude_weighted_mean,
fill = Period
), size = 6, pch = 21) + # centroids
geom_errorbar(
data = centroids,
aes(
x = Longitude_weighted_mean,
ymin = Latitude_weighted_mean - Latitude_weighted_sd,
ymax = Latitude_weighted_mean + Latitude_weighted_sd
)
) +
geom_errorbar(
data = centroids,
aes(
y = Latitude_weighted_mean,
xmin = Longitude_weighted_mean - Longitude_weighted_sd,
xmax = Longitude_weighted_mean + Longitude_weighted_sd
)
) +
theme_bw() +
coord_sf(xlim = c(-92, -88), ylim = c(33.5, 36.7), expand = TRUE) +
theme(
plot.title = element_text(size = 20),
legend.title = element_text(size = 20),
legend.text = element_text(size = 16),
axis.title = element_text(size = 20),
axis.text = element_text(size = 16),
axis.text.x = element_text(angle = 45, hjust = 1),
element_line(color = "black")
) +
annotate("text", label = "TN", size = 7, x = -88.3, y = 35.3) +
annotate("text", label = "AR", size = 7, x = -91.7, y = 36) +
annotate("text", label = "MS", size = 7, x = -89, y = 34) +
xlab("Longitude") +
ylab("Latitude")
I am new to Spatial data & cartogram lib and getting some issues while trying to recreate plot from: https://www.r-graph-gallery.com/a-smooth-transition-between-chloropleth-and-cartogram.html
Lib & Data
library(tidyverse)
library(maptools)
library(cartogram)
library(viridis)
library(sf)
data("wrld_simpl")
afr_cartogram = wrld_simpl[wrld_simpl$REGION==2,]
After this, I had some error: like st_transform ..... which I fixed it after some googling using sf lib.
afr_sf <- st_as_sf(afr_cartogram)
afr_sf_proj = st_transform(afr_sf,3857)
afr_plot <- cartogram::cartogram(afr_sf_proj, "POP2005", itermax =7)
ISSUE: Now after this step I am unable to recreate the code as it is in the demo website as I do not have column group in my data.
ggplot() +
geom_polygon(data = afr_plot, aes(fill = POP2005/1000000, x = LON, y = LAT, group = group) , size=0, alpha=0.9) +
theme_void()
From where can I get group column ???
Code used in website:
data(wrld_simpl)
afr=wrld_simpl[wrld_simpl$REGION==2,]
afr_cartogram <- cartogram(afr, "POP2005", itermax=7)
# Transform these 2 objects in dataframe, plotable with ggplot2
afr_cartogram_df <- tidy(afr_cartogram) %>% left_join(. , afr_cartogram#data, by=c("id"="ISO3"))
afr_df <- tidy(afr) %>% left_join(. , afr#data, by=c("id"="ISO3"))
# And using the advices of chart #331 we can custom it to get a better result:
ggplot() +
geom_polygon(data = afr_df, aes(fill = POP2005/1000000, x = long, y = lat, group = group) , size=0, alpha=0.9) +
theme_void() +
scale_fill_viridis(name="Population (M)", breaks=c(1,50,100, 140), guide = guide_legend( keyheight = unit(3, units = "mm"), keywidth=unit(12, units = "mm"), label.position = "bottom", title.position = 'top', nrow=1)) +
labs( title = "Africa", subtitle="Population per country in 2005" ) +
ylim(-35,35) +
theme(
text = element_text(color = "#22211d"),
plot.background = element_rect(fill = "#f5f5f4", color = NA),
panel.background = element_rect(fill = "#f5f5f4", color = NA),
legend.background = element_rect(fill = "#f5f5f4", color = NA),
plot.title = element_text(size= 22, hjust=0.5, color = "#4e4d47", margin = margin(b = -0.1, t = 0.4, l = 2, unit = "cm")),
plot.subtitle = element_text(size= 13, hjust=0.5, color = "#4e4d47", margin = margin(b = -0.1, t = 0.4, l = 2, unit = "cm")),
legend.position = c(0.2, 0.26)
) +
coord_map()
The group columns are produced in these lines
afr_cartogram_df <- tidy(afr_cartogram) %>%
left_join(afr_cartogram#data, by = ("id" = "ISO3"))
afr_df <- tidy(afr) %>%
left_join(afr#data, by = c("id" = "ISO3"))
by the tidy function from package broom which is not attached in your code!
Attach broom using library(broom) or call tidy() from its namespace like this: broom::tidy(...).
The 'data section' in your code should look like this:
data(wrld_simpl)
afr <- wrld_simpl[wrld_simpl$REGION==2, ]
afr_cartogram <- wrld_simpl[wrld_simpl$REGION == 2,]
afr_sf <- st_as_sf(afr_cartogram)
afr_sf_proj <- st_transform(afr_sf, 3857)
afr_plot <- cartogram_cont(afr_sf_proj, "POP2005", itermax =7)
afr_cartogram_df <- broom::tidy(afr_cartogram) %>%
left_join(afr_cartogram#data, by=c("id" = "ISO3"))
afr_df <- broom::tidy(afr) %>%
left_join(afr#data, by=c("id" = "ISO3"))
The subsequent ggplot code works fine then:
I'm trying to add an interactive heatmap to my Shiny app, but I also have interactive graphs using ggiraph. I'm currently using the d3heatmap package, but the heatmaps don't render in the app. I've created a toy example to illustrate this:
library(shiny)
library(ggiraph)
library(d3heatmap)
ui <- fluidPage(
d3heatmapOutput('d3'),
ggiraphOutput('gg')
)
server <- function(input, output, session) {
# Create heatmap
output$d3 <- renderD3heatmap({
d3heatmap(matrix(1:100, nrow = 100, ncol = 100))
})
# Create ggiraph
output$gg <- renderggiraph({
p <- ggplot(iris, aes(x = Sepal.Length, y = Petal.Width,
color = Species, tooltip = iris$Species) ) +
geom_point_interactive()
ggiraph(code = {print(p)})
})
}
shinyApp(ui = ui, server = server)
Together, only the ggiraph renders, but the heatmap does not. However, if you comment out the ggiraph code, the heatmap renders. I tried switching the order of loading the packages, but that still didn't work.
I'm currently running on R 3.2.2 (I have to use this version because the company servers only run on this version, and neither my manager nor I have the authority to update it). I tried downloading the shinyheatmap, heatmaply, and heatmap.2 packages, but because of versioning issues, the installations were unsuccessful.
So right now, I've just used pheatmap to create the heatmaps, but they aren't interactive (i.e., I can't get values when I hover over individual cells, and I can't zoom in). Is there any workaround for this, or are there other interactive heatmap packages out there that would work? I'd like to avoid changing all of my ggiraph graphs to plotly graphs since there are a lot of them in my code.
Please let me know if there's any other information you need. Any suggestions would be much appreciated!
(just to let you know I am the author of ggiraph)
There is a conflict between ggiraph and d3heatmap because ggiraph is using d3.js version 4 and d3heatmap is using D3.js version 3. I don't think there is a solution to solve that conflict.
However, building an interactive heatmap with ggplot2/ggiraph is not that difficult. See below:
library(dplyr)
library(tidyr)
library(ggplot2)
library(ggiraph)
library(ggdendro)
# mydata <- cor(mtcars)
mydata <- matrix(runif(2500, min = -2, max = 2), ncol = 50)
row.names(mydata) <- paste0("row_", seq_len(nrow(mydata)))
colnames(mydata) <- paste0("col_", seq_len(ncol(mydata)))
# dendrogram for rows
hc <- hclust(dist(mydata), "ave")
dhr <- as.dendrogram(hc)
order_r <- rownames(mydata)[hc$order]
# dendrogram for columns
hc <- hclust(dist(t(mydata)), "ave")
dhc <- as.dendrogram(hc)
order_c <- colnames(mydata)[hc$order]
# the data
expr_set <- bind_cols(
data_frame(rowvar = rownames(mydata)),
as.data.frame(mydata)
)
expr_set <- gather(expr_set, colvar, measure, -rowvar)
expr_set$rowvar <- factor( expr_set$rowvar, levels = order_r )
expr_set$colvar <- factor( expr_set$colvar, levels = order_c )
expr_set <- arrange(expr_set, rowvar, colvar)
# get data for dendrograms - IMHO, ggdendro is the hero here...
data_c <- dendro_data(dhc, type = "rectangle")
data_c <- segment(data_c) %>% mutate(
y = y + length(order_r) + .5,
yend = yend + length(order_r) + .5
)
data_r <- dendro_data(dhr, type = "rectangle")
data_r <- segment(data_r)
data_r <- data_r %>%
mutate( x_ = y + length(order_c) + .5,
xend_ = yend + length(order_c) + .5,
y_ = x,
yend_ = xend )
expr_set <- expr_set %>%
mutate(
tooltip = sprintf("Row: %s<br/>Col: %s<br/>measure: %.02f",
rowvar, colvar, measure) ,
data_id = sprintf("%s_%s", rowvar, colvar)
)
# all data are tidy and can be now used with ggplot
p <- ggplot(data = expr_set, aes(x = colvar, y = rowvar) ) +
geom_tile_interactive(aes(fill = measure, tooltip = tooltip, data_id = data_id), colour = "white") +
scale_fill_gradient(low = "white", high = "#BC120A") +
geom_segment(
data = data_c,
mapping = aes(x = x, y = yend, xend = xend, yend = y),
colour = "gray20", size = .2) +
geom_segment(
data = data_r,
mapping = aes(x = x_, y = y_, xend = xend_, yend = yend_),
colour = "gray20", size = .2) +
coord_equal()
# cosmetics
p <- p + theme_minimal() +
theme(
legend.position = "right",
panel.grid.minor = element_line(color = "transparent"),
panel.grid.major = element_line(color = "transparent"),
axis.ticks.length = unit(2, units = "mm"),
plot.title = element_text(face = "bold", hjust = 0.5, size = 12),
axis.title = element_text(size = 9, colour = "gray30"),
axis.text.y = element_text(hjust = 1, size = 5, colour = "gray40"),
axis.text.x = element_text(angle = 90, hjust = 1, size = 5, colour = "gray40"),
legend.title=element_text(face = "bold", hjust = 0.5, size=8),
legend.text=element_text(size=6)
)
ggiraph(ggobj = p)
Hope it helps
I know that this question is answered some time ago but I've ran into the same problem and i was not able to use ggplot2 because it was just to slow to work with my Shiny application. The heatmaply package is allot faster and easier to implement. I performed a mini-benchmark (n= 20).
with ggplot2 took an average time of 64 seconds. With heatmaply it took only 2 seconds. both methods use the 'ave' method of hclust.I hope this is helpfull.
mini-benchmark n= 20 of ggplot vs heatmaply
here is the code i used:
library(tidyr)
library(ggplot2)
library(ggiraph)
library(ggdendro)
library(heatmaply)
# mydata <- cor(mtcars)
create_data <- function(){
df <- matrix(runif(2500, min = -2, max = 2), ncol = 50)
row.names(df) <- paste0("row_", seq_len(nrow(df)))
colnames(df) <- paste0("col_", seq_len(ncol(df)))
return(df)
}
gg2heat <- function(mydata){
# dendrogram for rows
hc <- hclust(dist(mydata), "ave")
dhr <- as.dendrogram(hc)
order_r <- rownames(mydata)[hc$order]
# dendrogram for columns
hc <- hclust(dist(t(mydata)), "ave")
dhc <- as.dendrogram(hc)
order_c <- colnames(mydata)[hc$order]
# the data
expr_set <- bind_cols(
data_frame(rowvar = rownames(mydata)),
as.data.frame(mydata)
)
expr_set <- gather(expr_set, colvar, measure, -rowvar)
expr_set$rowvar <- factor( expr_set$rowvar, levels = order_r )
expr_set$colvar <- factor( expr_set$colvar, levels = order_c )
expr_set <- arrange(expr_set, rowvar, colvar)
# get data for dendrograms - IMHO, ggdendro is the hero here...
data_c <- dendro_data(dhc, type = "rectangle")
data_c <- segment(data_c) %>% mutate(
y = y + length(order_r) + .5,
yend = yend + length(order_r) + .5
)
data_r <- dendro_data(dhr, type = "rectangle")
data_r <- segment(data_r)
data_r <- data_r %>%
mutate( x_ = y + length(order_c) + .5,
xend_ = yend + length(order_c) + .5,
y_ = x,
yend_ = xend )
expr_set <- expr_set %>%
mutate(
tooltip = sprintf("Row: %s<br/>Col: %s<br/>measure: %.02f",
rowvar, colvar, measure) ,
data_id = sprintf("%s_%s", rowvar, colvar)
)
# all data are tidy and can be now used with ggplot
p <- ggplot(data = expr_set, aes(x = colvar, y = rowvar) ) +
geom_tile_interactive(aes(fill = measure, tooltip = tooltip, data_id = data_id), colour = "white") +
scale_fill_gradient(low = "white", high = "#BC120A") +
geom_segment(
data = data_c,
mapping = aes(x = x, y = yend, xend = xend, yend = y),
colour = "gray20", size = .2) +
geom_segment(
data = data_r,
mapping = aes(x = x_, y = y_, xend = xend_, yend = yend_),
colour = "gray20", size = .2) +
coord_equal()
# cosmetics
p <- p + theme_minimal() +
theme(
legend.position = "right",
panel.grid.minor = element_line(color = "transparent"),
panel.grid.major = element_line(color = "transparent"),
axis.ticks.length = unit(2, units = "mm"),
plot.title = element_text(face = "bold", hjust = 0.5, size = 12),
axis.title = element_text(size = 9, colour = "gray30"),
axis.text.y = element_text(hjust = 1, size = 5, colour = "gray40"),
axis.text.x = element_text(angle = 90, hjust = 1, size = 5, colour = "gray40"),
legend.title=element_text(face = "bold", hjust = 0.5, size=8),
legend.text=element_text(size=6)
)
ggiraph(ggobj = p)
}
htmp_gg <- c()
htmp_maply <-c()
for (i in 1:20){
df <- create_data()
time_gg <- (system.time(gg2heat(df)))[3]
htmp_gg<- append(htmp_gg, values = time_gg)
time_heatmaply <- (system.time(heatmaply::heatmaply(df, hclust_method = 'ave')))[3]
htmp_maply<- append(htmp_maply, values = time_heatmaply)
rm(df)
}
score <- data.frame(htmp_gg, htmp_maply)%>% gather(key = 'method', value = 'time')
p <- ggplot(score, aes(x = method, y = time, fill = method))+geom_violin()+ stat_summary(fun.y=median, geom="point", size=2, color="black")
print(p)