Проблема в отображении графика на Shiny: объединение кластеризации и линейной регрессии

Question

Я расширил результат моего последнего вопроса новой идеей. Ошибка при запуске приложения R Shiny: операция невозможна без активного реактивного контекста

На этот раз в дополнение к кластеризованным точкам в данных 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"
      ))
    )
  )
))

Я использовал следующий код. Однако у меня есть проблема с объединением этих двух идей, и сюжет не показан:

Вот основной код для этого вопроса (сервер и пользовательский интерфейс в одном файле):

# 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 изнутри среды.

После изменения этого параметра вы столкнетесь с некоторыми другими ошибками, которые у вас есть в коде, но я уверен, что вы сможете решить их оттуда.