R Shiny中循环的条件触发

Question

我是 R 和 Shiny 的新手，我正在尝试根据用户选择的赌注策略绘制投注模型的不同预算方案。 对于每个赌注策略，我编写了一个 for 循环来计算给定时间跨度内产生的利润。 虽然单个循环在 Shiny 之外没有问题，但在应用程序内部，我很难响应用户输入来实现它们。我没有得到正确的绘图，而是在 100 处得到一条水平直线，表明循环根本没有做任何事情。

我希望有人能帮我解决这个问题，因为这真的让我头疼。我附上了一个脚本，以便您可以重建我目前所拥有的。

library(shiny)
library(dplyr)
library(purrr)
library(tidyverse)
# training data 

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)

train <-data.frame(Home, Away, OddsHome, OddsAway, ShotsH, ShotsA, Result)
#  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")),
selectInput(inputId="Staking", label="Staking Strategy",
            choice= c("Fractional System", "Fixed Amount")),
plotOutput('Odds_compared'),
plotOutput('budget')

)
 
server<- function(input, output,session){
  
# generate linear model for prediction  
observeEvent(input$Model,{
  req(input$Model)
    if (input$Model == "pred1")
    {pred<- glm(Result~ShotsH + ShotsA, data=train, family=binomial)
    }else if (input$Model == "pred2")
     {pred<-glm(Result~ShotsH + ShotsA + OddsHome, data=train, family=binomial)}
    
#mutate new columns with predictions     

    df <- reactive({
      test%>%
      modelr::add_predictions(pred,var="MyProbsH", type="response")%>%
      mutate(MyProbsA=1-MyProbsH)%>%
      mutate(MyOddsH=1/MyProbsH)%>%
      mutate(MyOddsA=1/MyProbsA)%>%
      mutate(profit = 0)%>%
      mutate(budget= 100)%>%
      mutate(fixture=1:n())%>%
      drop_na("fixture") 
    })

#calculate staking strategy    
req(input$Staking)
    if (input$Staking == "FractionalSystem")
    {
      for(i in 2:NROW(df()[1]))
      {
        if(df()[i, 10]<df()[i,3] && df()[i,10]<=2 && df()[i,7]==1)
        {df()[i,12]<-(0.1*df()[i-1,13] *df()[i, 3])-(0.1*df()[i-1, 13])
        df()[i,13]<-df()[i-1,13]+df()[i,12]}
        else if(df()[i, 10]<df()[i,3] && df()[i,10]<=2 && df()[i,7]==0)
        {df()[i,12]<- -0.1*df()[i-1, 13]
        df()[i,13]<-df()[i-1,13]+df()[i,12]}
        else 
        {
          df()[i,13]<-df()[i-1,13]
          df()[i, 12]<-as.numeric(0)}}}
      else if (input$Staking == "FixedAmount")
      {
        for(i in 2:NROW(df()[1]))
        {
          if(df()[i, 10]<df()[i,3] && df()[i,10]<=2 && df()[i,7]==1)
          {df()[i,12]<- 10*df()[i, 3]- 10
          df()[i,13]<-df()[i-1,13]+df()[i,12]}
          else if(df()[i, 10]<df()[i,3] && df()[i,10]<=2 && df()[i,7]==0)
          {df()[i,12]<- -10
          df()[i,13]<-df()[i-1,13]+df()[i,12]}
          else 
          {
            df()[i,13]<-df()[i-1,13]
            df()[i, 12]<-as.numeric(0)}}
      }

#

#create plot
    output$Odds_compared<-renderPlot({plot(df()$MyOddsH, df()$OddsHome)})
    output$budget<-renderPlot({plot(df()$fixture, df()$budget, type="l", col="blue")})

  })
}
shinyApp(ui = ui, server = server)

Answer 1

我注意到一件事：“分数系统”和“固定金额”的单词之间有空格 - 这应该与您的 if 语句完全匹配。

另外，我会避免在 observeEvent 中使用嵌套的 reactive 表达式。相反，您可以将所有计算放入 reactive 表达式中。

您可能还需要考虑将详细的建模/计算分离到另一个函数中。

让我知道这是否适合你。

server<- function(input, output, session){

  #perform modeling      
  df <- reactive({
    req(input$Model, input$Staking)
    
    if (input$Model == "pred1")
    {pred<- glm(Result~ShotsH + ShotsA, data=train, family=binomial)
    }else if (input$Model == "pred2")
    {pred<-glm(Result~ShotsH + ShotsA + OddsHome, data=train, family=binomial)}
    
    d <- test %>%
      modelr::add_predictions(pred,var="MyProbsH", type="response")%>%
      mutate(MyProbsA=1-MyProbsH)%>%
      mutate(MyOddsH=1/MyProbsH)%>%
      mutate(MyOddsA=1/MyProbsA)%>%
      mutate(profit = 0)%>%
      mutate(budget= 100)%>%
      mutate(fixture=1:n())%>%
      drop_na("fixture") 
    
    if (input$Staking == "Fractional System")
    {
      for(i in 2:nrow(d[1]))
      {
        if(d[i, 10]<d[i,3] && d[i,10]<=2 && d[i,7]==1)
        {d[i,12]<-(0.1*d[i-1,13] *d[i, 3])-(0.1*d[i-1, 13])
        d[i,13]<-d[i-1,13]+d[i,12]}
        else if(d[i, 10]<d[i,3] && d[i,10]<=2 && d[i,7]==0)
        {d[i,12]<- -0.1*d[i-1, 13]
        d[i,13]<-d[i-1,13]+d[i,12]}
        else 
        {
          d[i,13]<-d[i-1,13]
          d[i, 12]<-as.numeric(0)}}}
    else if (input$Staking == "Fixed Amount")
    {
      for(i in 2:nrow(d[1]))
      {
        if(d[i, 10]<d[i,3] && d[i,10]<=2 && d[i,7]==1)
        {d[i,12]<- 10*d[i, 3]- 10
        d[i,13]<-d[i-1,13]+d[i,12]}
        else if(d[i, 10]<d[i,3] && d[i,10]<=2 && d[i,7]==0)
        {d[i,12]<- -10
        d[i,13]<-d[i-1,13]+d[i,12]}
        else 
        {
          d[i,13]<-d[i-1,13]
          d[i, 12]<-as.numeric(0)}}
    }
    return(d)
  })
  
  #create plots
  output$Odds_compared<-renderPlot({plot(df()$MyOddsH, df()$OddsHome)})
  output$budget<-renderPlot({plot(df()$fixture, df()$budget, type="l", col="blue")})
}