R Shiny ggiraph 和 d3heatmap 兼容性问题
R Shiny ggiraph and d3heatmap Compatibility Issues
我正在尝试向我的 Shiny 应用程序添加交互式热图，但我也有使用 ggiraph 的交互式图表。我目前正在使用 d3heatmap 包，但热图不会在应用程序中呈现。我创建了一个玩具示例来说明这一点：
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)
一起，只有 ggiraph 呈现，但热图不呈现。但是，如果您注释掉 ggiraph 代码，热图就会呈现。我试过切换加载包的顺序，但还是不行。
我目前运行正在使用R 3.2.2（我必须使用这个版本，因为公司服务器只有运行这个版本，我和我的经理都没有权限更新它）。我尝试下载了 shinyheatmap、heatmaply 和 heatmap.2 包，但由于版本问题，安装不成功。
所以现在，我刚刚使用 pheatmap 创建了热图，但它们不是交互式的（即，当我将鼠标悬停在单个单元格上时，我无法获取值，也无法放大） .是否有任何解决方法，或者是否有其他可用的交互式热图包？我想避免将我所有的 ggiraph 图更改为 plotly 图，因为我的代码中有很多这样的图。
如果您需要任何其他信息，请告诉我。任何建议将不胜感激！
（只是想让你知道我是 ggiraph 的作者）
ggiraph 和 d3heatmap 之间存在冲突，因为 ggiraph 使用 d3.js 版本 4 而 d3heatmap 使用 D3.js 版本 3 .我认为没有解决该冲突的方法。
然而，使用 ggplot2/ggiraph 构建交互式热图并不难。见下文：
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)
希望对您有所帮助
我知道这个问题很久以前就有人回答了，但我 运行 遇到了同样的问题，但我无法使用 ggplot2，因为我的工作速度很慢Shiny 申请。 heatmaply 包分配得更快，更容易实现。我执行了一个小型基准测试 (n= 20)。
ggplot2 平均耗时 64 秒。使用 heatmaply 只用了 2 秒。这两种方法都使用 hclust 的 'ave' 方法。希望对您有所帮助。
mini-benchmark n= 20 of ggplot vs heatmaply
这是我使用的代码：
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)
我正在尝试向我的 Shiny 应用程序添加交互式热图，但我也有使用 ggiraph 的交互式图表。我目前正在使用 d3heatmap 包，但热图不会在应用程序中呈现。我创建了一个玩具示例来说明这一点：
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)
一起，只有 ggiraph 呈现，但热图不呈现。但是，如果您注释掉 ggiraph 代码，热图就会呈现。我试过切换加载包的顺序，但还是不行。
我目前运行正在使用R 3.2.2（我必须使用这个版本，因为公司服务器只有运行这个版本，我和我的经理都没有权限更新它）。我尝试下载了 shinyheatmap、heatmaply 和 heatmap.2 包，但由于版本问题，安装不成功。
所以现在，我刚刚使用 pheatmap 创建了热图，但它们不是交互式的（即，当我将鼠标悬停在单个单元格上时，我无法获取值，也无法放大） .是否有任何解决方法，或者是否有其他可用的交互式热图包？我想避免将我所有的 ggiraph 图更改为 plotly 图，因为我的代码中有很多这样的图。
如果您需要任何其他信息，请告诉我。任何建议将不胜感激！
（只是想让你知道我是 ggiraph 的作者） ggiraph 和 d3heatmap 之间存在冲突，因为 ggiraph 使用 d3.js 版本 4 而 d3heatmap 使用 D3.js 版本 3 .我认为没有解决该冲突的方法。
然而，使用 ggplot2/ggiraph 构建交互式热图并不难。见下文：
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)
希望对您有所帮助
我知道这个问题很久以前就有人回答了，但我 运行 遇到了同样的问题，但我无法使用 ggplot2，因为我的工作速度很慢Shiny 申请。 heatmaply 包分配得更快，更容易实现。我执行了一个小型基准测试 (n= 20)。
ggplot2 平均耗时 64 秒。使用 heatmaply 只用了 2 秒。这两种方法都使用 hclust 的 'ave' 方法。希望对您有所帮助。
mini-benchmark n= 20 of ggplot vs heatmaply
这是我使用的代码：
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)