Building app on Shiny with defined function-CodePudding

I'm just starting to build apps with Shiny, and so far I think I understand the basics; however, I am trying to build an app which shows a plot that combines both a mock data and a defined function scripted as follows:

sales<- structure(list(Fecha = structure(c(1235865600, 1238544000, 1241136000, 
                                           1243814400, 1246406400, 1249084800, 1251763200, 1254355200, 1257033600, 
                                           1259625600, 1262304000, 1264982400, 1267401600, 1270080000, 1272672000, 
                                           1275350400, 1277942400, 1280620800, 1283299200, 1285891200, 1288569600), class = c("POSIXct", "POSIXt"), tzone = "UTC"), 
                        Cantidad_ = c(60631, 15311, 17635, 25404, 18102, 4154, 23003, 
                                      37984, 45470, 42076, 55612, 17472, 107381, 46243, 95794, 
                                      108466, 18917, 11321, 52434, 85373, 67603)), row.names = c(NA, -21L), class = "data.frame")

sales= ts(sales$Cantidad_, frequency = 12, start(2009,3))

Y=cumsum(sales)
Y=ts(Y, frequency = 12, start(2009,3))
Y= c(0, Y[1:(length(Y)-1)])
Ysq= Y^2
out= lm(sales~Y Ysq)

a=out$coef[1]
b=out$coef[2]
c=out$coef[3]

m1= (-b-sqrt(b^2-4*a*c))/(2*c)
m2= (-b sqrt(b^2-4*a*c))/(2*c)
m= max(m1,m2)
p=a/m
q=-m*c

bassmodel= function(p,q,m,T=21)
{
  
  S=double(T)
  Y=double(T 1)
  Y[1]=0
  for(t in 1:T)
  {
    S[t]= p*m (q-p)*Y[t]-(q/m)*Y[t]^2
    Y[t 1]= Y[t]  S[t]
  }
  return(list(sales=S, cumSales=cumsum(S)))
}

Spred= bassmodel(p,q,m,T=21)$sales
Spred= ts(Spred,frequency = 12, start(2009,3))
ts.plot(sales, Spred, col=c("blue", "red"))

Now, I don't get how I can implement this in the server part. My unsuccesful attempt has been:

ui <- fluidPage(
  titlePanel("Bass Diffusion Model Visualisation"),
  
  sidebarLayout(
    sidebarPanel(
      h2("Baseline model"),
      sliderInput(
        "p",
        "Innovation effect:",
        min = 0,
        max = 1,
        value = 0.03, 
        animate=TRUE
      ),
      sliderInput(
        "q",
        "Imitation effect:",
        min = 0,
        max = 1,
        value = 0.38, 
        animate=TRUE
      ),
      sliderInput(
        "m",
        "Tamaño del mercado:",
        min = 0,
        max = 300000,
        value = 100000, 
        animate=TRUE
      ),
    ),
    
    mainPanel(
      h2("Rate of adoption"),
      plotOutput("adoptionPlot"),
      )
  ))


server <- function(input, output) {
  output$adoptionPlot <- renderPlot({
    
    x<- sales1[,1:2]
    bass_base <-
      
       function(p,q,m,T=160)
        {
          
          S=double(T)
          Y=double(T 1)
          Y[1]=0
          for(t in 1:T)
          {
            S[t]= p*m (q-p)*Y[t]-(q/m)*Y[t]^2
            Y[t 1]= Y[t]  S[t]
          }
          return(list(sales=S, cumSales=cumsum(S)))
        }
        
        Spred= bass_base(input$p,input$q,input$m,T=160)$x
        Spred= ts(Spred,frequency = 12, start(2009,3))
        ts.plot(x, Spred, col=c("blue", "red"))
    
  })
}

shinyApp(ui = ui, server = server)

But it returns: Error in ts: 'ts' object must have one or more observations.

Thanks in advance!

CodePudding user response：

I tried reproducing your code, but it is difficult without a

Shiny Result:

Shiny App Code:

ui <- fluidPage(
  titlePanel("Bass Diffusion Model Visualisation"),

  sidebarLayout(
    sidebarPanel(
      h2("Baseline model"),
      sliderInput(
        "p",
        "Innovation effect:",
        min = 0,
        max = 1,
        value = 0.03,
        animate=TRUE
      ),
      sliderInput(
        "q",
        "Imitation effect:",
        min = 0,
        max = 1,
        value = 0.38,
        animate=TRUE
      ),
      sliderInput(
        "m",
        "Tamaño del mercado:",
        min = 0,
        max = 300000,
        value = 100000,
        animate=TRUE)
    ),

    mainPanel(
      h2("Rate of adoption"),
      plotOutput("adoptionPlot"),
    )
  ))


server <- function(input, output) {
  output$adoptionPlot <- renderPlot({

    sales<- structure(list(Fecha = structure(c(1235865600, 1238544000, 1241136000,
                                               1243814400, 1246406400, 1249084800, 1251763200, 1254355200, 1257033600,
                                               1259625600, 1262304000, 1264982400, 1267401600, 1270080000, 1272672000,
                                               1275350400, 1277942400, 1280620800, 1283299200, 1285891200, 1288569600), class = c("POSIXct", "POSIXt"), tzone = "UTC"),
                           Cantidad_ = c(60631, 15311, 17635, 25404, 18102, 4154, 23003,
                                         37984, 45470, 42076, 55612, 17472, 107381, 46243, 95794,
                                         108466, 18917, 11321, 52434, 85373, 67603)), row.names = c(NA, -21L), class = "data.frame")

    sales= ts(sales$Cantidad_, frequency = 12, start(2009,3))

    bass_base <-

      function(p,q,m,T=160)
      {

        S=double(T)
        Y=double(T 1)
        Y[1]=0
        for(t in 1:T)
        {
          S[t]= p*m (q-p)*Y[t]-(q/m)*Y[t]^2
          Y[t 1]= Y[t]  S[t]
        }
        return(list(sales=S, cumSales=cumsum(S)))
      }

    Spred= bass_base(input$p,input$q,input$m,T=160)$sales
    Spred= stats::ts(Spred,frequency = 12, start(2009,3))
    ts.plot(sales, Spred, col=c("blue", "red"))

  })
}

shinyApp(ui = ui, server = server)

I suppose is it what are you looking for?