使用 plotly 库，我在 R 中制作了以下绘图:

Using the plotly library, I made the following plot in 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 在特定范围内).

This is a simple scatter plot - two random variables are generated, and then the colors of the points are decided by some criteria (e.g. if var1 and var2 are between certain ranges).

从这里，我还可以汇总统计数据:

From here, I could also summary statistics:

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

我的问题:是否可以在此图中添加一些按钮，以允许用户根据自定义选择为点着色?例如.像这样:

My question: is it possible to add some buttons to this plot which would allow the user to color the points based on custom choices? E.g. something like this :

现在，用户可以在他们想要的任何范围内输入 - 点的颜色会发生变化，并且会生成一些汇总统计信息.

Now, the user can type in any range they want - and the color of the points change, and the some summary statistics are generated.

谁能告诉我如何在 R 中做到这一点?

Can someone please show me how to do this in R?

我有这个想法——首先我会创建一个巨大的表，它会创建var1"的所有可能的范围组合.和var2":

I had this idea - first I would create this massive table that would create all possible range combinations of "var1" and "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 样式语句将这些行从对应于这些范围的庞大表中分离出来:

Then, depending on which ranges the user wants - an SQL style statement isolate the rows from this massive table corresponding to those ranges :

custom_df = df[df$var1 > -20 & df$var1 <10 & df$var1 > -20 & df$var2 <10 , ]    

然后，将针对custom_df"进行单独的抓取.并且还将记录custom_df"的摘要统计信息:

Then, an individual grap would be made for "custom_df" and summary statistics would also be recorded for "custom_df":

summary = custom_df %>%
    group_by(var3) %>%
    summarize(Mean_var1 = mean(var1), Mean_var2 = mean(var2), count=n())

但我不确定如何在 R 中巧妙而有效地做到这一点.

But I am not sure how to neatly and efficiently do this in R.

有人可以告诉我怎么做吗?

Can someone please show me how to do this?

谢谢

推荐答案

我已经构建了一个闪亮的小应用程序来满足您的大部分要求.根据您预定义的大数据框 df，用户可以定义以下内容:

I have built a small shiny app to perform most of your requirements. Based on your pre-defined large dataframe df, user can define the following:

为变量 var1 和 var2 选择最小值和最大值.选择标准来定义变量var3，用于显示不同颜色的数据点.现在是一个范围.将绘图保存为 HTML 文件.以表格形式显示的汇总统计数据. Choose the minimum and maximum value for variables var1 and var2. Choose criteria to define the variable var3, which is used to display different colors of data points. This is a range now. Save plot as a HTML file. Summary stats displayed as a table.

您可以定义更多选项，为用户提供选择颜色等的选项.为此，也许您应该谷歌了解如何使用 scale_color_manual().

You can define further options to provide the user the option to choose color and so on. For that perhaps you should google on how to use scale_color_manual().

更新:添加了根据 var1 和 var2 范围值选择红色和绿色的用户选项.

Update: Added user option to choose red and green color based on var1 and var2 range values.

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)