Conditional triggering of Loop in RShiny

Question

I'm new to R and Shiny and I'm trying to plot different budget scenarios of a betting model depending on the staking strategy selected by the user. For each staking strategy I wrote a for loop to calculate the generated profit within the given time span. While the individual loops work with no issue outside of Shiny, inside the app I have difficulties to implement them in response to user input. Instead of getting the right plot I just get a straight horizontal line at 100, indicating that the loops have done nothing at all.

I was hoping somebody could help me with that cause it is really giving me a headache. I attached a script so that you can rebuild what I have so far.

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

One thing I noticed: you have spaces between words for "Fractional System" and "Fixed Amount" - this should match exactly in your if statement.

Also, I would avoid the nested reactive expression inside of your observeEvent. Instead, you could put all of your calculations inside the reactive expression.

You also might want to consider separating out your detailed modeling/calculations to another function.

Let me know if this works for you.

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")})
}