server.R

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

  ###
  output$sliders <- renderUI({
    xv <- input$xaxisGrp
    # First, create a list of sliders each with a different name
    sliders <- lapply(1:length(xv), function(i) {
      inputName <- xv[i]
      sliderInput(
        inputId = inputName,
        label = inputName,
        min = 0,
        max = 100,
        value = 0,
        post = "%"
      )
    })
    # Create a tagList of sliders (this is important)
    do.call(tagList, sliders)
  })

  ###
  observeEvent(input$calcbtn, {

    n <- isolate(input$calcbtn)
    if (n == 0) return()

    output$forecast_summary <- renderPrint({
      n<-pred.model()
      n<-data.frame(n)
      row.names(n)<-NULL
      print(n)
    })

    output$capacity_summary <- renderPrint({
      n<-pred.model()
      n<-data.frame(n)
      row.names(n)<-NULL
      #c<-round(peak.scalability(usl.model()),digits=0)
      available<-round(((c-n[1,1])/c)*100,digits=0)
      row.names(available)<-NULL
      print(paste0(available,"%"))

    })

  ###pred function
  pred.model <- reactive({
    xv <- input$xaxisGrp
    yv <- input$yaxisGrp

    #latest_df<-do.call(data.frame,setNames(lapply(xv,function(e) vector(typeof(e))),xv))
    latest_df<-data.frame()
    new_df1 = data.frame()


    for(i in 1:length(xv)){
     ##xv[i]<-as.numeric(input$xv[i])

   # capacity<-as.numeric(input$capacity)
    #add_capacity<-as.numeric(input$add_capacity)

      df <- data_set()
      if (!is.null(df)){

         if (!is.null(xv) & !is.null(yv)){

            if (sum(xv[i] %in% names(df))>0){ # supress error when changing files
          #usl.model <- usl(as.formula(paste(yv, '~', xv)), data = df)

            #new_growth<-tail(df[,xv],1)*(1+capacity/100)
            new_growth<-quantile(df[,xv[i]],0.95)*(1+input$xv[i]/100)
            new_cap<-new_growth

            new_df1[1,i] = setNames(data.frame(new_cap),xv[i])

            row.names(new_df1)<-NULL
            }
         }
      }
    }
    latest_df=new_df1

    prediction<-predict(usl.model(),newdata = latest_df)
    prediction<-data.frame(prediction)
    prediction<-prediction[1,1]

    return(prediction)
})
  ##end of pred function

    output$plot_forecast <- renderPlot({
      df <- data_set()
      new_df<- pred.model()

      print(sliders)
      if (!is.null(df)){

        xv <- input$xaxisGrp
        yv <- input$yaxisGrp
        print(xv)
        print(yv)
        if (!is.null(xv) & !is.null(yv)){

          if (sum(xv %in% names(df))>0){ # supress error when changing files

            df1<-data.frame(usl.model()$fitted)
            colnames(df1)<-c("Model")
            df<-cbind(df,df1)
            Model=c("Model")

            Ninety_Fifth_Perc<-quantile(df[,2], 0.95)
            new_d<-pred.model()

            ggplot(df, aes_string(xv,yv)) +
              geom_point(size=4, shape=21, fill="blue") +
              geom_line(data=df, aes_string(xv, Model),
                        colour="orange", size=1) +
              geom_point(data=new_df, aes(new_df[, 1], new_df[, 2]),
                         colour="red", size=10) +
              theme_bw() +
              theme(legend.position = "none") +
              geom_vline(xintercept=new_df[, 1], colour="green", size=1.5)
          }
        }
      }
    })
  })

  ###visualize section
  dsnames <- c()

  data_set <- reactive({
    inFile <- input$file1
    data(specsdm91)
    if (is.null(inFile))
      return(specsdm91)

    data_set<-read.csv(inFile$datapath, header=input$header,
                       sep=input$sep, quote=input$quote,stringsAsFactors=F)
  })

  output$contents <- renderTable({data_set()})

  observe({
    dsnames <- names(data_set())
    cb_options <- list()
    cb_options[ dsnames] <- dsnames
    updateCheckboxGroupInput(session, "xaxisGrp",
                       label = "X-Axis",
                       choices = cb_options,
                       selected = "")
    updateRadioButtons(session, "yaxisGrp",
                             label = "Y-Axis",
                             choices = cb_options,
                             selected = "")
  })
  output$choose_dataset <- renderUI({
    selectInput("dataset", "Data set", as.list(data_sets))
  })

  usl.model <- reactive({

    df <- data_set()
    if (!is.null(df)){

      xv <- input$xaxisGrp
      yv <- input$yaxisGrp
      print(xv)
      print(yv)
      if (!is.null(xv) & !is.null(yv)){

        if (sum(xv %in% names(df))>0){ # supress error when changing files
          xv <- paste(xv, collapse="+")

          lim <- lm(as.formula(paste(yv, '~', xv)), data = df)

          return(lim)

        }
      }
    }
  })


  ##plot
  output$plot = renderPlot({

    df <- data_set()
    if (!is.null(df)){

      xv <- input$xaxisGrp
      yv <- input$yaxisGrp
      print(xv)
      print(yv)
      if (!is.null(xv) & !is.null(yv)){

        if (sum(xv %in% names(df))>0){ # supress error when changing files

          #plot(as.formula(paste(yv, '~', xv)), data = df, pch = 21)

          #plot(usl.model(),add=TRUE)

          df1<-data.frame(usl.model()$fitted)
          colnames(df1)<-c("Best_Fit_Model")
          #df<-cbind(df,df1)
          Model<-c("Best_Fit_Model")
          df1<-cbind(df[yv],df1)

          #max_capacity<-round(peak.scalability(usl.model()),digits=0)
          #Ninety_Fifth_Perc<-quantile(df[,2], 0.95)
          #peak<-round(peak.scalability(usl.model()),digits=0)
          #available<-round(((max_capacity-Ninety_Fifth_Perc)/max_capacity)*100,digits=0)
          #new_d<-pred.model()
          df.melt=melt(df, id=yv)
          xx<-c("value")

          ggplot(df.melt,aes_string(x = xx, y = yv)) + geom_point() +facet_wrap(~variable, scale="free")+theme_bw()+
            geom_smooth(method="lm", se=F, colour="red")

         # p2<-ggplot(df1,aes_string(x = yv, y = Model)) + geom_point() + theme_bw()+
          #  geom_smooth(method="lm", se=F, colour="red")



        }
      }
    }

  } )

  ##
  output$summary <- renderPrint({

    summary(usl.model())

  })


  output$choose_columns <- renderUI({

    if(is.null(input$dataset))
      return()
    colnames <- names(contents)
    checkboxGroupInput("columns", "Choose columns",
                       choices  = colnames,
                       selected = colnames)
  })


}

test.csv

ui.R

library(shiny)
library(shinydashboard)
library(leaflet)
library(data.table)
library(ggplot2)
library(ggthemes)
library(usl)

ui <- dashboardPage(
  skin = "green",
  dashboardHeader(
    title = "ADM Logical Capacity Planning Service",
    titleWidth = 350
  ),
  dashboardSidebar(
    sidebarMenu(
      menuItem(
        "Visualize & Create Model",
        tabName = "visualize",
        icon = icon("area-chart")
      ),
      menuItem(
        "Forecast",
        tabName = "capacity",
        icon = icon("line-chart")
      )
    )
  ),
  dashboardBody(
    tags$head(
      tags$style(
        HTML('
          .skin-blue .main-header .logo {
            background-color: #3c8dbc;
          }

          .menuItem .main-header .logo:hover {
            background-color: #3c8dbc;
          }
        ')
      )
    ),
    tabItems(
      tabItem(
        "capacity",
        fluidRow(
          column(3,
            wellPanel(
              span("Given the growth rate, forecast the underlying dependent variable")
            ),
            wellPanel(
              # Create a uiOutput to hold the sliders
              uiOutput("sliders")
            ),
            # Generate a row with a sidebar
            #sliderInput("capacity", "Growth Rate in Volume:", min=0, max=100, value=0,post="%"),
            #br(),
            #sliderInput("add_capacity", "Add Capacity in %:", min=0, max=100, value=0,post="%"),
            br(),
            wellPanel(
              actionButton("calcbtn", "Calculate Forecast")
            )
          ),
          mainPanel(
            h4("Prediction"),
            verbatimTextOutput("forecast_summary"),

            h4("Available Capacity"),
            verbatimTextOutput("capacity_summary")

            #h4("Peak Capacity"),
            #verbatimTextOutput("peak_capacity")
          )
        )
      ),
      tabItem(
        "visualize",
        pageWithSidebar(
          headerPanel("Logical Capacity Planning Dashboard"),
          sidebarPanel(
            fileInput(
              'file1',
              'Upload CSV File to Create a Model',
              accept = c('text/csv', 'text/comma-separated-values',
                         'text/plain','.csv')
            ),
            tags$hr(),
            checkboxInput('header', 'Header', TRUE),
            fluidRow(
              column(6,
                checkboxGroupInput(
                  inputId = "xaxisGrp",
                  label = "X-Axis:",
                  choices = c("1" = "1",
                              "2" = "2")
                )
              ),
              column(6,
                radioButtons(
                  inputId = "yaxisGrp",
                  label = "Y-axis:",
                  choices = c("1" = "1",
                              "2" = "2")
                )
              )
            ),
            radioButtons(
              inputId = 'sep',
              label = 'Separator',
              choices = c(Comma = ',',
                          Semicolon = ';',
                          Tab = '\t'),
              selected = ','
            ),
            radioButtons(
              inputId = 'quote',
              label = 'Quote',
              choices = c(None = '',
                          'Double Quote' = '"',
                          'Single Quote' = "'"),
              selected = '"'
            ),
            uiOutput("choose_columns")
          ),
          mainPanel(
            tabsetPanel(
              tabPanel("Data",
                tableOutput('contents')
              ),
              tabPanel("Create Model & Plot",
                plotOutput("plot"),verbatimTextOutput("PeakCapacity")
              ),
              tabPanel("Model Summary",
                verbatimTextOutput("summary")
              )
            )
          )
        )
      )
    )
  )
)