RShiny-预测“观察”环境中的值

时间:2020-08-06 10:23:50

标签: r shiny prediction reactive

我正在尝试自学R-Shiny,并构建一个网络应用程序,其中包括生成足球比赛的预测。 生成的预测将根据用户在选择小部件中选择的预测模型而有所不同。

但是,当我运行该应用程序时,会出现以下错误:“没有适用于'预测'的适用方法应用于空类的对象'

我使用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)


2 个答案:

答案 0 :(得分: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)

答案 1 :(得分: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)

output