如何在闪亮中创建可点击的直方图？ [英] How to create a clickable histogram in Shiny?

问题描述

我想在shiny中创建可点击的直方图，但我不知道这是否可行。

几个月前，我看到一个可点击的火山图，它为您提供了点击内容的表格。

来源：https://2-bitbio.com/2017/12/clickable-volcano-plots-in-shiny.html

我找到的最接近创建可点击直方图的帖子是这篇Click to get coordinates from multiple histogram in shiny

但是，我不想得到坐标。我需要数据帧的行名。

有了此数据帧，我是否可以在每次单击直方图中的条形图时都获得行名？

mtcars <- mtcars %>% 
  select("hp")
mtcars <- as.matrix(mtcars)

SHILY中的一个示例(但不可点击)：

library(shiny)
library(ggplot2)
library(scales)
library(dplyr)

ui <- fluidPage(
  
  titlePanel("Histogram"),
  
  sidebarLayout(
    sidebarPanel(
    ),
    
    mainPanel(
      plotOutput("hist"),
    )
  )
)

mtcars <- mtcars %>% 
  select("hp")
mtcars <- as.matrix(mtcars)

server <- function(input, output) {
  
  output$hist <- renderPlot({
    
    pp <- qplot(mtcars, geom = "histogram", bins = 10, xlab="values", 
                ylab="Frequency", main="Histogram",
                fill=I("red"), col=I("black"), alpha=I(0.4))
    
   pp + scale_x_continuous(breaks=pretty(mtcars, n=10))
  })
  
  
}

shinyApp(ui = ui, server = server)

有人知道怎么做吗？

提前感谢！

问候

推荐答案

这是一个很好的问题，让它具有挑战性的是q图/g图是静电图片。下面的app.r是我将如何做的一个示例。我很想看看其他方法。

实质：

1. 创建一个数字序列，该序列将用作直方图中的分隔符和数据帧中的间隔。我基于用户输入，但您可以对它们进行硬编码。
2. 根据值落入的间隔为数据帧中的每行分配一个值(&Q；bin&q；)。
3. 记录用户单击事件的x坐标，并根据同一组间隔分配该值(&q；bin&q；)。
4. 子集您的数据框并仅保留数据的"；bin"；值与用户单击事件的x坐标的"；bin"；值匹配的那些记录。

否则，如果您愿意使用d3路线，您可以浏览由R视图发布的something like this。

#Load libraries ----------------------------------------------------
library(shiny)
library(ggplot2)
library(scales)
library(dplyr)


# Prepare data -----------------------------------------------------
df <- mtcars
df <- cbind(model = rownames(df), data.frame(df, row.names = NULL)) # setting the rownames as the first column
dm <- df$hp %>% as.matrix()


# UI function ------------------------------------------------------
ui <- fluidPage(

  titlePanel("Histogram"),

  sidebarLayout(
    sidebarPanel(

      tags$h5("I added the below text output only to demonstrate shiny's way for tracking user interaction on static plots. You can click, double-click, or click & drag (i.e. brushing). These functions are AWESOME when exploring scatterplots."),

      tags$h3("Chart click and brushing"),

      verbatimTextOutput("info"),

      tags$h5("Now I'm applying the below UI inputs to the `vec` and `breaks` arguments in `findInterval()` and `qplot()` respectively; I'm using `findInterval()` to bin the values in the dataframe AND to bin the x-value of the user's click event input on the chart. Then we can return the dataframe rows with the same bin values as the x-value of the click input."),

      sliderInput("seq_from_to"
                  , label = h3("Sequence 'From' and 'To'")
                  , min = 0
                  , max = 500
                  , value = c(50, 350)
                  ),

      sliderInput("seq_by"
                  , label = h3("Sequence 'By'")
                  , min = 25
                  , max = 200
                  , value = 50
                  , step = 5)

    ),

    mainPanel(

      plotOutput("hist",
                 click = "plot_click",
                 dblclick = "plot_dblclick",
                 hover = "plot_hover",
                 brush = "plot_brush"),

      dataTableOutput("table")

    )
  )
)


# Server function --------------------------------------------------
server <- function(input, output) {

  # Render Histogram Plot
  output$hist <- renderPlot({

    # Using the same `qplot` function but inserting the user inputs to set the breaks values in the plot
    pp <- qplot(dm
                , geom = "histogram"
                , breaks = seq(from = input$seq_from_to[1], to = input$seq_from_to[2], by = input$seq_by)
                , xlab = "values"
                , ylab = "Frequency"
                , main = "Histogram"
                , fill = I("red")
                , col = I("black")
                , alpha = I(0.4)
                )

    # Also using the user inputs to set the breaks values for the x-axis
    pp + scale_x_continuous(breaks = seq(from = input$seq_from_to[1], to = input$seq_from_to[2], by = input$seq_by))
  })

  # This is purely explanatory to help show how shiny can read user interaction on qplot/ggplot objects
  # It's taken from the Shiny docs here: https://shiny.rstudio.com/articles/plot-interaction.html
  output$info <- renderText({

    # Retain the x and y coords of the user click event data
    xy_str <- function(e) {
      if(is.null(e)) return("NULL
")
      paste0("x=", round(e$x, 1), " y=", round(e$y, 1), "
")
    }

    # Retain the x and y range coords of click & drag (brush) data
    xy_range_str <- function(e) {
      if(is.null(e)) return("NULL
")
      paste0("xmin=", round(e$xmin, 1), " xmax=", round(e$xmax, 1),
             " ymin=", round(e$ymin, 1), " ymax=", round(e$ymax, 1))
    }

    # Paste this together so we can read it in the UI function for demo purposes
    paste0(
      "click: ", xy_str(input$plot_click),
      "dblclick: ", xy_str(input$plot_dblclick),
      "hover: ", xy_str(input$plot_hover),
      "brush: ", xy_range_str(input$plot_brush)
    )
  })

  # Back to the story. Set a listener to trigger when one of the following is updated:
  toListen <- reactive({list(
    input$plot_click    # user clicks on the plot
    , input$seq_from_to # user updates the range slider
    , input$seq_by      # user updates the number input
    )
  })

  # When one of those events are triggered, update the datatable output
  observeEvent(toListen(), {

    # Save the user click event data
    click_data <- input$plot_click
    print(click_data) # during your app preview, you can watch the R Console to see what click data is accessible

    # Assign bin values to each row using the intervals that are set by the user input
    df$bin <- findInterval(dm, vec = seq(from = input$seq_from_to[1], to = input$seq_from_to[2], by = input$seq_by))

    # Similarly assign a bin value to the click event based on what interval the x values falls within
    click_data$x_bin <- findInterval(click_data$x, vec = seq(from = input$seq_from_to[1], to = input$seq_from_to[2], by = input$seq_by))

    # Lastly, subset the df to only those records within the same interval as the click event x-value
    df_results <- subset(df, bin == click_data$x_bin)

    # Select what values to view in the table
    df_results <- df_results %>% select(model, hp)

    # And push these back out to the UI
    output$table <- renderDataTable(df_results,
                                     options = list(
                                       pageLength = 5
                                     )
    )

  })


}

shinyApp(ui = ui, server = server)

这篇关于如何在闪亮中创建可点击的直方图？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！