R中的交互式绘图
Posted
技术标签:
【中文标题】R中的交互式绘图【英文标题】：Interactive Plots in R 【发布时间】：2021-06-16 08:56:41 【问题描述】：使用 plotly 库，我在 R 中制作了以下绘图：
library(dplyr)
library(ggplot2)
library(plotly)
set.seed(123)
df <- data.frame(var1 = rnorm(1000,10,10),
var2 = rnorm(1000,5,5))
df <- df %>% mutate(var3 = ifelse(var1 <= 5 & var2 <= 5, "a", ifelse(var1 <= 10 & var2 <= 10, "b", "c")))
plot = df %>%
ggplot() + geom_point(aes(x=var1, y= var2, color= var3))
ggplotly(plot)
这是一个简单的散点图 - 生成两个随机变量，然后点的颜色由某些标准决定（例如，如果 var1 和 var2 在特定范围内）。
从这里，我还可以汇总统计数据：
df$var3 = as.factor(df$var3)
summary = df %>%
group_by(var3) %>%
summarize(Mean_var1 = mean(var1), Mean_var2 = mean(var2), count=n())
# A tibble: 3 x 4
var3 Mean_var1 Mean_var2 count
* <fct> <dbl> <dbl> <int>
1 a -1.70 0.946 158
2 b 4.68 4.94 260
3 c 15.8 6.49 582
我的问题：是否可以在此图中添加一些按钮，以允许用户根据自定义选择为点着色？例如。像这样：
现在，用户可以在他们想要的任何范围内输入 - 点的颜色会发生变化，并且会生成一些摘要统计信息。
谁能告诉我如何在 R 中做到这一点？
我有这个想法 - 首先我会创建一个巨大的表，它会创建“var1”和“var2”的所有可能范围组合：
vec1 <- c(-20:40,1)
vec2 <- c(-20:40,1)
a <- expand.grid(vec1, vec2)
for (i in seq_along(vec1))
for (j in seq_along(vec2))
df <- df %>% mutate(var3 = ifelse(var1 <= i & var2 <= i, "a", ifelse(var1 <= j & j <= 10, "b", "c")))
然后，根据用户想要的范围 - SQL 风格的语句将这些行从对应于这些范围的海量表中分离出来：
custom_df = df[df$var1 > -20 & df$var1 <10 & df$var1 > -20 & df$var2 <10 , ]
然后，将对“custom_df”进行单独的抓取，并为“custom_df”记录汇总统计信息：
summary = custom_df %>%
group_by(var3) %>%
summarize(Mean_var1 = mean(var1), Mean_var2 = mean(var2), count=n())
但我不确定如何在 R 中巧妙而有效地做到这一点。
有人可以告诉我怎么做吗？
谢谢
【问题讨论】：
您在shiny寻找解决方案吗？
最初我试图只使用 plotly 来解决这个问题 - 但现在我认为这只能使用闪亮来解决。我正在尝试从这个网站 (mastering-shiny.org/action-dynamic.html) 学习一些基本的闪亮知识。你有什么建议？
这可能需要一些努力，这可能是目前还没有答案的原因。如果您没有得到答案，您也可以选择筹集小额赏金以让更多人关注它
这些链接真的很有用。如果你自学，对回答这些问题会有很大帮助
谢谢，现在可能会得到更多关注
【参考方案1】：
我已经构建了一个闪亮的小应用程序来满足您的大部分要求。根据您预定义的大型数据框df，用户可以定义以下内容：
-
为变量
var1 和var2 选择最小值和最大值。
选择标准来定义变量var3，用于显示不同颜色的数据点。现在是一个范围。
将绘图保存为 HTML 文件。
以表格形式显示的汇总统计信息。
您可以定义更多选项，为用户提供选择颜色等的选项。为此，也许你应该在谷歌上搜索如何使用scale_color_manual()。
更新：添加了根据 var1 和 var2 范围值选择红色和绿色的用户选项。
library(shiny)
library(plotly)
library(dplyr)
library(DT)
### define a large df
set.seed(123)
df <- data.frame(var1 = rnorm(1000,10,10),
var2 = rnorm(1000,15,15))
ui <- fluidPage(
titlePanel(p("My First Test App", style = "color:red")),
sidebarLayout(
sidebarPanel(
p("Choose Variable limits"),
# Horizontal line ----
tags$hr(),
uiOutput("var1a"), uiOutput("var1b"),
uiOutput("var2a"), uiOutput("var2b"),
uiOutput("criteria")
),
mainPanel(
DTOutput("summary"), br(),
plotlyOutput("plot"),
br(), br(), br(),
uiOutput("saveplotbtn")
)
)
)
server <- function(input, output, session)
output$var1a <- renderUI(
tagList(
numericInput("var11", "Variable 1 min",
min = min(df$var1), max = max(df$var1), value = min(df$var1))
)
)
output$var1b <- renderUI(
if (is.null(input$var11))
low1 <- min(df$var1)
else low1 <- max(min(df$var1),input$var11) ## cannot be lower than var 1 minimum
tagList(
numericInput("var12", "Variable 1 max", min = low1, max = max(df$var1), value = max(df$var1))
)
)
output$var2a <- renderUI(
tagList(
numericInput("var21", "Variable 2 min",
min = min(df$var2), max = max(df$var2), value = min(df$var2))
)
)
output$var2b <- renderUI(
if (is.null(input$var21))
low2 <- min(df$var2)
else low2 <- max(min(df$var2),input$var21) ## cannot be lower than var 2 minimum
tagList(
numericInput("var22", "Variable 2 max", min = low2, max = max(df$var2), value = max(df$var2))
)
)
output$criteria <- renderUI(
req(input$var11,input$var12,input$var21,input$var22)
tagList(
sliderInput("crit11", "Variable 1 red color range:",
min = -10, max = 0, value = c(-10,0)),
sliderInput("crit12", "Variable 2 red color range:",
min = -25, max = 0, value = c(-25,0)),
sliderInput("crit21", "Variable 1 green color range:",
min = 0.1, max = 10, value = c(0.1,10)),
sliderInput("crit22", "Variable 2 green color range:",
min = 0.1, max = 20, value = c(0.1,20))
)
)
dat <- reactive(
req(input$crit11,input$crit12,input$crit21,input$crit22)
df <- df %>% filter(between(var1, input$var11, input$var12)) %>%
filter(between(var2, input$var21, input$var22))
# df1 <- df %>% mutate(var3 = ifelse(var1 <= i & var2 <= i, "a", ifelse(var1 <= j & var2 <= j , "b", "c")))
df1 <- df %>% mutate(var3 = ifelse(between(var1, input$crit11[1], input$crit11[2]) & between(var2, input$crit12[1], input$crit12[2]), "a",
ifelse(between(var1, input$crit21[1], input$crit21[2]) & between(var2, input$crit22[1], input$crit22[2]), "b", "c")))
)
summari <- reactive(
req(dat())
df1 <- dat()
df1$var3 = as.factor(df1$var3)
summary = df1 %>%
group_by(var3) %>%
dplyr::summarize(Mean_var1 = mean(var1), Mean_var2 = mean(var2), count=n())
)
output$summary <- renderDT(summari())
rv <- reactiveValues()
observe(
req(dat())
p <- ggplot(data=dat()) + geom_point(aes(x=var1, y= var2, color= var3))
pp <- ggplotly(p)
rv$plot <- pp
)
output$plot <- renderPlotly(
rv$plot
)
output$saveplotbtn <- renderUI(
div(style="display: block; padding: 5px 350px 5px 50px;",
downloadBttn("saveHTML",
HTML("HTML"),
style = "fill",
color = "default",
size = "lg",
block = TRUE,
no_outline = TRUE
) )
)
output$saveHTML <- downloadHandler(
filename = function()
paste("myplot", Sys.Date(), ".html", sep = "")
,
content = function(file)
htmlwidgets::saveWidget(as_widget(rv$plot), file, selfcontained = TRUE) ## self-contained
)
shinyApp(ui, server)
【讨论】：
非常感谢您的回答！我正在考虑用“变量 3 范围”代替“标准 1”和“标准 2”。是否可以有另一个框来记录每个范围组合的汇总统计信息？非常感谢您的帮助！ 是否可以用文本框替换滑块？最终结果可以保存为html文件吗？ 如果答案让您满意，请点击复选标记接受。如果你还没有这样做，你也应该考虑支持这个解决方案。 @iamericfletcher ：我赞成该解决方案。我试图从这个解决方案中解决一些问题（我在 cmets 中提到了它们）。谢谢！ @stats555，接受已回答您的 OP 的答案被认为是礼貌的。这有助于其他正在为相同/相似查询寻找解决方案的人。此外，人们可能愿意在您未来的查询中为您提供帮助。以上是关于R中的交互式绘图的主要内容，如果未能解决你的问题，请参考以下文章