R Shiny - 在 'observe' 环境中预测值

Question

我正在尝试自学 R-Shiny 并构建一个网络应用程序，除其他外，该应用程序还可以为足球比赛生成预测。生成的预测应根据用户在 select 小部件中选择的预测模型而有所不同。

但是，当我运行应用程序时，我会收到以下错误：'no applicable method for 'predict' applied to an object of class null'

我使用 add_predictions 并且在闪亮的上下文之外，这非常有效。当我使用 predict 时，我得到同样的错误。

我该如何解决？我创建了一个可重现的示例，希望能够说明我正在尝试做什么以及发生错误的位置。非常感谢任何帮助。

library(shiny)
library(dplyr)
library(purrr)

# training data and prediction models

Home<-c("A","B","C","D","E","F","G")
Away<-c("H","I","J","K","L","M","N")
Result<-c(1, 0, 0, 1, 1, 0, 1)
OddsHome<-c(1.85, 1.96, 1.90, 1.43, 2.17, 2.22, 2.34)
OddsAway<-c(2.17, 2.04, 2.11, 3.33, 1.85, 1.81, 1.75)
ShotsH<-c(8, 7, 6, 4, 5, 2, 9)
ShotsA<-c(6, 8, 3, 4, 9, 5, 4)
Result<-c(1, 0, 0, 1, 1, 0, 1)

train<-data.frame(Home, Away, OddsHome, OddsAway, ShotsH, ShotsA, Result)

pred1<-glm(Result~ShotsH + ShotsA, data=train, family=binomial)
pred2<-glm(Result~ShotsH + ShotsA + OddsHome, data=train, family=binomial)

# test data
Home<-c("A","B","C","D","E","F","G")
Away<-c("H","I","J","K","L","M","N")
OddsHome<-c(1.60, 2.18, 2.20, 3.35, 1.09, 3.07, 2.88)
OddsAway<-c(2.67, 1.85, 1.84, 1.43, 12.11, 1.48, 1.53)
ShotsH<-c(13,5,2,8,9,8,1)
ShotsA<-c(4,7,4,8,6,7,2)
Result<-c(0,0,1,0,1,1,1)

test<-data.frame(Home, Away, OddsHome, OddsAway, ShotsH, ShotsA, Result)

 
ui<- fluidPage(
h1("Germany"),


selectInput(inputId="Model", label= "Prediction Model",
            choice=c("pred1", "pred2")),
plotOutput('Odds-compared')

)
 
server<- function(input, output){
  
  
observe({
    pred <-if (input$Model == "pred1")
  {pred<-pred1}
    else if (input$Model == "pred2")
    {pred<- pred2}
    
#mutate new columns with predictions     
    df <- 
      test%>%
      modelr::add_predictions(pred,var="MyProbsH", type="response")%>%
      mutate(MyProbsA=1-MyProbsH)%>%
      mutate(MyOddsH=1/MyProbsH)%>%
      mutate(MyOddsA=1/MyProbsA)

#create plot
    output$Odds-compared<-renderPlot({plot(df$MyOddsH, df$OddsHome)})
  })
    
}
shinyApp(ui = ui, server = server)

Answer 1

尝试observeEvent如下所示

# test data
Home<-c("A","B","C","D","E","F","G")
Away<-c("H","I","J","K","L","M","N")
OddsHome<-c(1.60, 2.18, 2.20, 3.35, 1.09, 3.07, 2.88)
OddsAway<-c(2.67, 1.85, 1.84, 1.43, 12.11, 1.48, 1.53)
ShotsH<-c(13,5,2,8,9,8,1)
ShotsA<-c(4,7,4,8,6,7,2)
Result<-c(0,0,1,0,1,1,1)

test<-data.frame(Home, Away, OddsHome, OddsAway, ShotsH, ShotsA, Result)


ui<- fluidPage(
  h1("Germany"),
  
  selectInput(inputId="Model", label= "Prediction Model",
              choice=c("pred1", "pred2")),
  plotOutput('Odds_compared')
  
)

server<- function(input, output, session){
  
observeEvent(input$Model, {
  req(input$Model)
  if (input$Model == "pred1") {
    pred <- glm(Result~ShotsH + ShotsA, data=test, family=binomial)
  }else if (input$Model == "pred2") {
    pred <- glm(Result~ShotsH + ShotsA + OddsHome, data=test, family=binomial)
  }
  
  #mutate new columns with predictions     
  dfa <- reactive({
    test %>%
      modelr::add_predictions(pred,var="MyProbsH", type="response") %>%
      mutate(MyProbsA=1-MyProbsH) %>%
      mutate(MyOddsH=1/MyProbsH) %>%
      mutate(MyOddsA=1/MyProbsA)
  })
    
  #create plot
  output$Odds_compared<-renderPlot({plot(dfa()$MyOddsH, dfa()$OddsHome)})
})

}

shinyApp(ui = ui, server = server)

Answer 2

有时我们可以看到潜在的内存泄漏发生在 observer 我建议你不要在里面做任何繁重的事情，因为它们通常是为轻操作保留的。你做这样的事情：

library(shiny)
library(dplyr)
library(purrr)

# test data
Home<-c("A","B","C","D","E","F","G")
Away<-c("H","I","J","K","L","M","N")
OddsHome<-c(1.60, 2.18, 2.20, 3.35, 1.09, 3.07, 2.88)
OddsAway<-c(2.67, 1.85, 1.84, 1.43, 12.11, 1.48, 1.53)
ShotsH<-c(13,5,2,8,9,8,1)
ShotsA<-c(4,7,4,8,6,7,2)
Result<-c(0,0,1,0,1,1,1)

test<-data.frame(Home, Away, OddsHome, OddsAway, ShotsH, ShotsA, Result)

ui<- fluidPage(
  h1("Germany"),
  
  selectInput(inputId="Model", label= "Prediction Model",
              choice=c("pred1", "pred2")),
  plotOutput('Odds_compared')
  
)

server<- function(input, output, session){
  
  my_pred <- eventReactive(input$Model,{
    if(input$Model == "pred1") {
      pred <- glm(Result~ShotsH + ShotsA, data=test, family=binomial)
    }else if (input$Model == "pred2") {
      pred <- glm(Result~ShotsH + ShotsA + OddsHome, data=test, family=binomial)
    }else{
      return()
    }
    pred
  })
  
  dfa <- eventReactive(my_pred(),{
    test %>%
      modelr::add_predictions(my_pred(),var="MyProbsH", type="response") %>%
      mutate(MyProbsA=1-MyProbsH) %>%
      mutate(MyOddsH=1/MyProbsH) %>%
      mutate(MyOddsA=1/MyProbsA)
  })
  
  output$Odds_compared <- renderPlot({
    plot(dfa()$MyOddsH, dfa()$OddsHome)
  })
  
}

shinyApp(ui = ui, server = server)

R Shiny - 在 'observe' 环境中预测值

RShiny - Predict values in 'observe' environment

r

prediction

shiny

reactive