RShiny - Прогнозирование значений в среде "наблюдения" - PullRequest
Новая
       126

RShiny - Прогнозирование значений в среде "наблюдения"

0 голосов
/ 06 августа 2020

Я пытаюсь научить себя R-Shiny и создать веб-приложение, которое, помимо прочего, генерирует прогнозы для футбольных матчей. Сгенерированные прогнозы будут различаться в зависимости от модели прогнозирования, которую пользователь выбирает в виджете выбора.

Однако, когда я запускаю приложение, я получаю следующую ошибку: «к объект класса null '

Я использую add_predictions, и вне контекста shiny это работает отлично. Когда я использую 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 ]

2 голосов
/ 06 августа 2020

Иногда мы можем видеть потенциальные утечки памяти внутри 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 голос
/ 06 августа 2020

Попробуйте 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)

вывод

...