从Shiny加入输入$ plot_click与原始数据时的非匹配值

时间：2018-04-10 14:08:09

标签： r shiny

目标

我想保存点击数据框中的绘图的点。然后我想用原始数据帧（用于创建绘图）加入这个新的数据帧。然后，新列将用作算法中的输入来操作整个数据集。

问题

我正在使用shiny的互动功能来实现上述目标。但是，我从input$plot_click获得的值与原始数据帧列的有效数字不同。因此，他们不匹配。我熟悉nearPoints()，但仅限于打印，并且不知道如何通过点击图直接过滤和保存原始数据框。

您可以运行shiny应用，看到新创建的数据框中的Time列与原始数据框Time中的c2列不完全匹配。如何通过单击？

获取原始值

我尝试了什么

以下是我的代码和数据集，用于一个小的，可重现的示例：

代码：

library(shiny)
library(tidyverse)

# Global
if (!exists('c2', envir = .GlobalEnv, inherits = FALSE)) {
  print("Please load c2 dataframe")
}

## Get the unique file.ID2 from the data:
file_ID <- unique(c2$file.ID2)



# UI
ui <- fluidPage(


  titlePanel("Select Initial Changepoints in Gas Pedal Position"),


  sidebarLayout(
    sidebarPanel(
      fluidRow(
        # Menu for selecting the file.ID2/Scenario
        selectInput("fileid", label = h3("Select scenario"), 
                    choices = file_ID)
      ),

      verbatimTextOutput("info"),

      # Button
      downloadButton("downloadData", "Download complete table")
    ),


    mainPanel(
      fluidRow(
        h4("Click plot to add points"),
        actionButton("rem_point", "Remove Last Point"),
        plotOutput("plot1", click = "plot_click",
                   hover = "plot_hover")),
      fluidRow(
        h4("Table of points on plot"),
        tableOutput("table")))
  )
)







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

  # 1. Create data for a given file.ID2:
  ## Filter c2 according to fileid:
  data_gas <- reactive({c2 %>% 
      filter(file.ID2==input$fileid)})


  # 2. set up reactive dataframe to store data
  values <- reactiveValues()
  values$DT <- data.frame(file.ID2 = character(),
                          Time = numeric(),
                          acc_pedal_pos = numeric())


  # 3. Create the gas pedal plot 
  output$plot1 = renderPlot({
    ggplot() +
      geom_point(data = data_gas(),
                 aes(x = Time, y = acc_pedal_pos)) +
      geom_point(data  = values$DT,
                 aes(x = Time, y = acc_pedal_pos, color = file.ID2), size = 2) 
  })


  # 4. add new row to reactive dataframe upon clicking plot 
  observeEvent(input$plot_click, {
    # each input is a factor so levels are consistent for plotting characteristics
    add_row <- data.frame(file.ID2 = input$fileid,
                          Time = input$plot_click$x,
                          acc_pedal_pos = input$plot_click$y)
    # add row to the data.frame
    values$DT <- rbind(values$DT, add_row)
  })

  # 5. remove row on actionButton click 
  observeEvent(input$rem_point, {
    rem_row <- values$DT[-nrow(values$DT), ]
    values$DT <- rem_row
  })

  # 6. render a table of the growing dataframe 
  output$table <- renderTable({
    values$DT
  })



  # 
  output$info <- renderPrint({
    nearPoints(data_gas()[,c("file.ID2","Time", "acc_pedal_pos")], 
               input$plot_hover, threshold = 1)
  })




  # 7. Downloadable csv of selected dataset ----
  output$downloadData <- downloadHandler(
    filename = function() {
      paste("gas_pedal_CP_data", ".csv", sep = "")
    },
    content = function(file) {
      write.csv(values$DT, file, row.names = FALSE)
    }
  )


}

# Run the application 
shinyApp(ui = ui, server = server)

数据

> dput(c2)
structure(list(file.ID2 = c("Cars_02", "Cars_02", "Cars_02", 
"Cars_02", "Cars_02", "Cars_02", "Cars_02", "Cars_02", "Cars_02", 
"Cars_02", "Cars_02", "Cars_02", "Cars_02", "Cars_02", "Cars_02", 
"Cars_02", "Cars_02", "Cars_02", "Cars_02", "Cars_02", "Cars_02", 
"Cars_02", "Cars_02", "Cars_02", "Cars_02", "Cars_02", "Cars_02", 
"Cars_02", "Cars_02", "Cars_02", "Cars_02", "Cars_02", "Cars_02", 
"Cars_02", "Cars_02", "Cars_02", "Cars_02", "Cars_02", "Cars_02", 
"Cars_02", "Cars_02", "Cars_02", "Cars_02", "Cars_02", "Cars_02", 
"Cars_02", "Cars_02", "Cars_02", "Cars_02", "Cars_02", "Cars_02", 
"Cars_02", "Cars_02", "Cars_02", "Cars_02", "Cars_02", "Cars_02", 
"Cars_02", "Cars_02", "Cars_02", "Cars_02", "Cars_02", "Cars_02", 
"Cars_02", "Cars_02", "Cars_02", "Cars_02", "Cars_02", "Cars_02", 
"Cars_02", "Cars_02", "Cars_02", "Cars_02", "Cars_02", "Cars_02", 
"Cars_02", "Cars_02", "Cars_02", "Cars_02", "Cars_02", "Cars_02", 
"Cars_02", "Cars_02", "Cars_02", "Cars_02", "Cars_02", "Cars_02", 
"Cars_02", "Cars_02", "Cars_02", "Cars_02", "Cars_02", "Cars_02", 
"Cars_02", "Cars_02", "Cars_02", "Cars_02", "Cars_02", "Cars_02", 
"Cars_02", "Cars_02"), Time = c(96.05, 96.0666666666667, 96.0833333333333, 
96.1, 96.1166666666667, 96.1333333333333, 96.15, 96.1666666666667, 
96.1833333333333, 96.2, 96.2166666666667, 96.2333333333333, 96.25, 
96.2666666666667, 96.2833333333333, 96.3, 96.3166666666667, 96.3333333333333, 
96.35, 96.3666666666667, 96.3833333333333, 96.4, 96.4166666666667, 
96.4333333333333, 96.45, 96.4666666666667, 96.4833333333333, 
96.5, 96.5166666666667, 96.5333333333333, 96.55, 96.5666666666667, 
96.5833333333333, 96.6, 96.6166666666667, 96.6333333333333, 96.65, 
96.6666666666667, 96.6833333333333, 96.7, 96.7166666666667, 96.7333333333333, 
96.75, 96.7666666666667, 96.7833333333333, 96.8, 96.8166666666667, 
96.8333333333333, 96.85, 96.8666666666667, 96.8833333333333, 
96.9, 96.9166666666667, 96.9333333333333, 96.95, 96.9666666666667, 
96.9833333333333, 97, 97.0166666666667, 97.0333333333333, 97.05, 
97.0666666666667, 97.0833333333333, 97.1, 97.1166666666667, 97.1333333333333, 
97.15, 97.1666666666667, 97.1833333333333, 97.2, 97.2166666666667, 
97.2333333333333, 97.25, 97.2666666666667, 97.2833333333333, 
97.3, 97.3166666666667, 97.3333333333333, 97.35, 97.3666666666667, 
97.3833333333333, 97.4, 97.4166666666667, 97.4333333333333, 97.45, 
97.4666666666667, 97.4833333333333, 97.5, 97.5166666666667, 97.5333333333333, 
97.55, 97.5666666666667, 97.5833333333333, 97.6, 97.6166666666667, 
97.6333333333333, 97.65, 97.6666666666667, 97.6833333333333, 
97.7, 97.7166666666667), acc_pedal_pos = c(0.143937006592751, 
0.145196855068207, 0.146771654486656, 0.14866141974926, 0.150236219167709, 
0.154960632324219, 0.155590549111366, 0.154960632324219, 0.155275583267212, 
0.155275583267212, 0.155275583267212, 0.155905514955521, 0.157165348529816, 
0.156850397586823, 0.156535431742668, 0.156535431742668, 0.15748031437397, 
0.156850397586823, 0.155905514955521, 0.155590549111366, 0.154015749692917, 
0.152125984430313, 0.148976370692253, 0.146771654486656, 0.143307089805603, 
0.140157476067543, 0.135748028755188, 0.131023615598679, 0.124409452080727, 
0.115590550005436, 0.104251965880394, 0.0881889760494232, 0.0636220499873161, 
0.0349606312811375, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
0, 0, 0, 0, 0, 0, 0, 0.025826770812273, 0.0343307070434093, 0.0450393706560135, 
0.0566929131746292, 0.0667716562747955, 0.0740157514810562, 0.0762204751372337, 
0.0771653577685356, 0.0765354335308075, 0.0771653577685356, 0.0762204751372337, 
0.0781102329492569, 0.0796850398182869, 0.0840944871306419, 0.0897637829184532, 
0.0973228365182877, 0.106456689536572, 0.116220474243164, 0.125669285655022, 
0.135748028755188, 0.143622040748596, 0.149291336536407, 0.152755901217461, 
0.155905514955521, 0.154960632324219, 0.155590549111366, 0.154645666480064, 
0.154015749692917, 0.154330715537071, 0.154960632324219, 0.154960632324219, 
0.155275583267212, 0.155590549111366, 0.154645666480064, 0.154645666480064, 
0.153385832905769, 0.154645666480064, 0.154330715537071, 0.154015749692917, 
0.154645666480064, 0.154960632324219, 0.154330715537071, 0.154645666480064, 
0.154645666480064, 0.154330715537071, 0.154645666480064)), .Names = c("file.ID2", 
"Time", "acc_pedal_pos"), row.names = c(NA, -101L), class = c("tbl_df", 
"tbl", "data.frame"))

1 个答案:

答案 0 :(得分：1)

我想这样的事情应该有效：

  observeEvent(input$plot_click, {
    # each input is a factor so levels are consistent for plotting characteristics

    add_row <- data.frame(file.ID2 = input$fileid,
                          Time = c2 %>% 
                            filter(file.ID2==input$fileid) %>%
                            mutate(diff = Time - input$plot_click$x) %>%
                            filter(diff == min(abs(diff))) %>%
                            select(Time),
                          acc_pedal_pos =c2 %>% 
                            filter(file.ID2==input$fileid) %>%
                            mutate(diff = Time - input$plot_click$x) %>%
                            filter(diff == min(abs(diff))) %>%
                            select(acc_pedal_pos))
    # add row to the data.frame
    values$DT <- rbind(values$DT, add_row)
  })

在这里，我通过创建列diff mutate(diff = Time - input$plot_click$x)来选择与所选点的最接近时间的点，并过滤最接近零{diff} filter(diff == min(abs(diff)))的diff值。然后，您可以通过选择正确的列select(acc_pedal_pos))

来指定时间值和acc_pedal_pos
相关问题
最新问题