Shiny Plot中

Question

这是我的第一个问题，所以请耐心等待我。我试图将数据集传递到交互式闪亮图中。这是我在服务器端所拥有的要点。

    # Load all necessary packages
load <- c(
  "shiny",
  "shinythemes",
  "ggplot2",
  "BH",
  "DT",
  "rCharts",
  "markdown",
  "data.table",
  "dplyr"
)
loaded <- lapply(load, function(x) {
  if (!require(x, character.only = T)) {
    install.packages(x)
    require(x, character.only = T)
  }
})

# Define UI for application that draws a histogram
ui <- navbarPage(
  "Testkit",
  # Tabpanel for Upload and Overview ----
  tabPanel(
    "Upload & Overview",

    # Sidebar layout with input and output definitions ----
    sidebarLayout(
      # Sidebar panel for inputs ----
      sidebarPanel(
        # Input: Select a file ----
        fileInput(
          "file1",
          "Choose CSV File",
          multiple = TRUE,
          accept = c("text/csv",
                     "text/comma-separated-values,text/plain",
                     ".csv")
        ),

        # Horizontal line ----
        tags$hr(),

        # Input: Checkbox if file has header ----
        checkboxInput("header", "Header", TRUE),

        # Input: Select separator ----
        radioButtons(
          "sep",
          "Separator",
          choices = c(
            Comma = ",",
            Semicolon = ";",
            Tab = "\t"
          ),
          selected = ","
        ),

        # Input: Select quotes ----
        radioButtons(
          "quote",
          "Quote",
          choices = c(
            None = "",
            "Double Quote" = '"',
            "Single Quote" = "'"
          ),
          selected = '"'
        ),

        # Horizontal line ----
        tags$hr(),

        # Input: Select number of rows to display ----
        radioButtons(
          "disp",
          "Display",
          choices = c(Head = "head",
                      All = "all"),
          selected = "head"
        ),

        # Horizontal line ----
        tags$hr(),

        # Input: First Variable ----
        selectizeInput(
          'e1',
          '1. Select First Variables',
          choices = NULL,
          multiple = FALSE
        ),

        # Horizontal line ----
        tags$hr(),

        # Input: Second Variable ----
        selectizeInput(
          'e2',
          '2. Select Seconed Variables',
          choices = NULL,
          multiple = FALSE
        )
      ),
      # end of sidebarPanel

      # Main panel for displaying outputs ----
      mainPanel(
        # Tabset panels for displaying outputs
        tabsetPanel(
          tabPanel(p(icon("area-chart"), "Single Graph"),
                   fluidPage(fluidRow(
                     column(
                       width = 12,
                       plotOutput(
                         "sPlot",
                         height = 700,
                         click = "sPlot_click",
                         brush = brushOpts(id = "sPlot_brush")
                       ),
                       actionButton("exclude_toggle", "Toggle points"),
                       actionButton("exclude_reset", "Reset")
                     )
                   ))) 
# end of Single Graph tab) # end of tabPanel ) # end of mainPanel)))

          # Define server logic required to draw a histogram
          server <-
            function(input, output, session) {
              # Function for file upload ----
              my_data <- reactive({
                # input$file1 will be NULL initially. After the user selects
                # and uploads a file, head of that data file by default,
                # or all rows if selected, will be shown.

                req(input$file1)

                df <- read.csv(
                  input$file1$datapath,
                  header = input$header,
                  sep = input$sep,
                  quote = input$quote
                )

                if (input$disp == "head") {
                  return(head(df))
                }
                else {
                  return(df)
                }

              })

              # Pass list of variables to selectize ----
              observe(updateSelectizeInput(session, 'e1', choices = colnames(select(
                my_data(), contains("Var_")
              ))))
              observe(updateSelectizeInput(session, 'e2', choices = colnames(select(
                my_data(), contains("Var_")
              ))))

              # Function for sectioning table ----
              sliceData <- reactive({
                sData <- my_data() %>%
                  select(one_of(c(input$e1, input$e2)))
                return(sData)
              })

              # Create output for interactive plot tab ----

              vals <-
                reactiveValues(keeprows = rep(TRUE, nrow(sliceData())))

              IA_Plot <- reactive({
                # Plot the kept and excluded points as two separate data sets
                keep    <-
                  sliceData()[vals$keeprows, , drop = FALSE]
                exclude <-
                  sliceData()[!vals$keeprows, , drop = FALSE]

                IAP <-
                  ggplot(keep, aes(input$e1, input$e1)) + geom_point() +
                  geom_smooth(method = lm,
                              fullrange = TRUE,
                              color = "black") +
                  geom_point(
                    data = exclude,
                    shape = 21,
                    fill = NA,
                    color = "black",
                    alpha = 0.25
                  ) +
                  coord_cartesian(xlim = c(1.5, 5.5), ylim = c(5, 35))
                IAP
              })

              # Create single graph plot for interaction ----
              output$sPlot <- renderPlot({
                IA_Plot()
              })

              # Toggle points that are clicked ----
              observeEvent(input$sPlot_click, {
                res <- nearPoints(sliceData(), input$sPlot_click, allRows = TRUE)
                vals$keeprows <-
                  xor(vals$keeprows, res$selected_)
              })

              # Toggle points that are brushed, when button is clicked ----
              observeEvent(input$exclude_toggle, {
                res <- brushedPoints(sliceData(), input$sPlot_brush, allRows = TRUE)
                vals$keeprows <-
                  xor(vals$keeprows, res$selected_)
              })

              # Reset all points ----
              observeEvent(input$exclude_reset, {
                vals$keeprows <- rep(TRUE, nrow(sliceData()))
              })

            }

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

以下是我从R Studio收到的错误：

警告：.getReactiveEnvironment（）中的错误$ currentContext：没有活动的响应上下文时不允许操作。 （你试图做一些只能在反应式表达式或观察者内部完成的事情。）

有人可以帮助我解决我所缺少的问题吗？

谢谢！

Answer 1

您收到的错误来自vals <- reactiveValues(keeprows = rep(TRUE, nrow(sliceData())))。您只能在observe

中阅读反应式表达式

尝试将该语句放在observe中，如下所示：

observe({ vals <-reactiveValues(keeprows = rep(TRUE, nrow(sliceData()))) })

希望它有所帮助！