Question

我用新思路扩展了上一个问题的结果。 Error in Running R Shiny App: Operation not allowed without an active reactive context

这次，除了Iris数据中的聚类点（请参阅我的上一个问题）之外，我还要显示所选点的回归线（在图上），斜率和截距（在侧栏上），如下所示：可以在此处获得回归代码（单独的server.R和ui.R文件）：

library(shiny)
shinyServer(function(input, output) {
  model <- reactive({
    brushed_data <- brushedPoints(iris, input$brush1,
                            xvar = "Petal.Length", yvar = "Petal.Width")
    if(nrow(brushed_data) < 2){
      return(NULL)
    }
    lm(Petal.Width ~ Petal.Length, data = brushed_data)
  })

  output$slopeOut <- renderText({
    if(is.null(model())){
      "No Model Found"
    } else {
      model()[[1]][2]
    }
  })

  output$intOut <- renderText({
    if(is.null(model())){
      "No Model Found"
    } else {
      model()[[1]][1]
    }
  })

  output$plot1 <- renderPlot({
    plot(iris$Petal.Length, iris$Petal.Width, xlab = "Petal.Length",
         ylab = "Petal.Width", main = "Iris Dataset",
         cex = 1.5, pch = 16, bty = "n")
    if(!is.null(model())){
      abline(model(), col = "blue", lwd = 2)
    }
  })


})

和

library(shiny)
shinyUI(fluidPage(
  titlePanel("Visualize Many Models"),
  sidebarLayout(
    sidebarPanel(

      h3("Slope"),
      textOutput("slopeOut"),

      h3("Intercept"),
      textOutput("intOut")
    ),
    mainPanel(
      plotOutput("plot1", brush = brushOpts(
        id = "brush1"
      ))
    )
  )
))

我使用了以下代码。但是，我在合并这两个想法时遇到问题，并且未显示该图：

这是此问题的主要代码（服务器和ui在一个文件中）：

# Loading Libraries and data
library(shiny)
library(caret)
library(ggplot2)
data(iris)


ui <- pageWithSidebar(

  # heading 1
  headerPanel(h1("Clustering Iris Data")),

  sidebarPanel(
    sliderInput("k", "Number of clusters:",
                min = 1, max = 5,  value = 3),

    sliderInput("prob", "Training percentage:",
                min=0.5, max=0.9, value = 0.7),

    # bold text
    tags$b("Slope:"),
    textOutput("slopeOut"),

    # empty line
    br(),

    # bold text
    tags$b("Intercept:"),
    textOutput("intOut")
    ),

  # Enabling the submit button disables the hovering feature  
  # submitButton("submit")),

  mainPanel(
    # img(src='iris_types.jpg', align = "center", height="50%", width="50%"),

    plotOutput("plot1", 
               click = "plot_click", 
               brush = brushOpts(id = "brush1")
               ),
    verbatimTextOutput("info")
  )
)


#----------------------------------------------------------------------------

server <- function(input, output) {

  # the clustering part

  get_training_data <- reactive({ 

    inTrain  <- createDataPartition(y=iris$Species, 
                                    p=input$prob, 
                                    list=FALSE)
    training <- iris[ inTrain,]
    testing  <- iris[-inTrain,]

    kMeans1 <- kmeans(subset(training,
                             select=-c(Species)),
                             centers=input$k)

    training$clusters <- as.factor(kMeans1$cluster)
    training
  })

  #-------------------------
  # the linear model part

  model <- reactive({
    brushed_data <- brushedPoints(iris, input$brush1,
                                  xvar = "Petal.Length", yvar = "Petal.Width")
    if(nrow(brushed_data) < 2){
      return(NULL)
    }
    lm(Petal.Width ~ Petal.Length, data = brushed_data)
  })

  #  reactive
  output$slopeOut <- renderText({
    if(is.null(model())){
      "No Model Found"
    } else {
      model()[[1]][2]
    }
  })

  #  reactive
  output$intOut <- renderText({
    if(is.null(model())){
      "No Model Found"
    } else {
      model()[[1]][1]
    }
  })

  #------------------------------------------------

  # if (x()<4) 1 else 0

  output$plot1  <- reactive({ 

  if(is.null(model())) {

# If no regression model exists, show the regular scatter plot 
# with clustered points and hovering feature

  renderPlot({
    plot(Petal.Width,
          Petal.Length,

          colour = clusters,
          data   = get_training_data(),

          xlab="Petal Width",
          ylab="Petal Length")
             })

  output$info <- renderPrint({
    # With ggplot2, no need to tell it what the x and y variables are.
    # threshold: set max distance, in pixels
    # maxpoints: maximum number of rows to return
    # addDist: add column with distance, in pixels
    nearPoints(iris, input$plot_click, threshold = 10, maxpoints = 1,
               addDist = FALSE)
                            })

  # closing if
  }

  else
    # If there is a regression model, show the plot with the regression line for the brushed points

    renderPlot({
      plot(Petal.Width,
           Petal.Length,

           colour = clusters,
           data   = get_training_data(),

           xlab = "Petal.Length",
           ylab = "Petal.Width", 
           main = "Iris Dataset",

           cex = 1.5, pch = 16, bty = "n")

      if(!is.null(model())){
        abline(model(), col = "blue", lwd = 2)
      }
    })

  # closing reactive statement
  })

  # curly brace for server function
  }

shinyApp(ui, server)

Answer 1

您为output$plot1分配了错误的数据类型。

它期望函数renderPlot(...)在给它一个reactive(...)的结果时创建。

重组代码，以便您立即分配

output$plot1 <- renderPlot(...)

由于renderPlot打开了反应性环境，就像reactive一样，您只需替换函数即可。但是请确保从环境中删除renderPlot调用。

更改此设置后，您将在代码中遇到更多错误，但是我敢打赌，您可以从那里解决它。

在Shiny上显示图形时出现问题：将聚类和线性回归结合起来

1 个答案: