Host Shiny app in AWS

Hi,

I wanted to know the steps for hosting shiny app in AWS where the data is refreshed on the basis of selenium for live data scrapping.

3 Likes

Can you please expand some more on your question? It could be that you have two questions, but it's unclear to me where you need most help:

  1. How to set up a Shiny Server in AWS?
  2. How to update and refresh data that originates from some web scraping process that includes selenium?

To answer question number one, the process is essentially to follow the steps in the Shiny Server admin guide, and you can also refer to the support article FAQ for RStudio Server Pro AWS. You should also consider using RStudio Connect for your app, since you can use Connect for both shiny apps and scheduled R scripts via Rmarkdown.

To answer question 2, can you please provide some more information on how you intend to embed the web scraping with your app?

  • Do you do the web scraping in selenium using some batch mechanism?
  • Do you store the scraped data in a database or a set of files?
  • Do you intend to perform the scraping interactively after some user input in the shiny app?
  • Have you already considered using Reactive polling or reactive file readers in the design of your shiny app?

The more information you can provide the easier it would be to give some guidance.

1 Like

For data scrapping, i will schedule the job and write the set of excel files in a location.
I need to update these data in the shiny app every 1 hour maybe.
I want to host this in AWS.
I am not sure about the steps.
According to me:
Script1: data scrapping using scheduler
Script2: to fetch the data and do the calculations and display it in the shiny app.

Please help me on the same.

i am very new to shiny, here is my code till date:

#>R_code<-######### Required packages ##########
install.packages("devtools") 
devtools::install_github("ropensci/RSelenium") 
library(devtools)
install.packages("RSelenium")
library(RSelenium)
install.packages("xlsx")
library(xlsx)
install.packages("lubridate")
library(lubridate)
install.packages("sqldf")
library("sqldf")
install.packages("date")
library(date)
install.packages("chron")
library(chron)
install_version("binman", version = "0.1.0", repos = "https://cran.uni-muenster.de/")
install_version("wdman", version = "0.2.2", repos = "https://cran.uni-muenster.de/")
install_version("RSelenium", version = "1.7.1", repos = "https://cran.uni-muenster.de/") 
install.packages("reshape")
library(reshape)
install.packages("reshape2")
library(reshape2)
install.packages("shinydashboard")
library(shinydashboard)
install.packages("dplyr")
library(dplyr)
install.packages("shiny")
library(shiny)
install.packages("purrr")
library(purrr)
install.packages("highcharter")
library(highcharter)
install.packages("DT")
library(DT)
install.packages("htmltools")
library(htmltools)
install.packages("httpuv")
library(httpuv)
install.packages("ggplot2")
library(ggplot2)
install.packages("rjava")
library(rJava)

########### removing previous file ############
rm(list=ls())

.jinit()
jRobot <- .jnew("java/awt/Robot")
.jcall(jRobot,, "setAutoDelay",as.integer(500))

rD<-RSelenium::rsDriver(port=4234L,browser=c("chrome","firefox","phantomjs", "internet explorer"),version="latest",chromever = "latest", geckover = "latest", iedrver = NULL, phantomver = "2.1.1", ,verbose=TRUE)
remDr <- rD[["client"]]
remDr$maxWindowSize()
#remDr$setWindowPosition(-2000,0) 

remDr$navigate("https://isro.corp.amazon.com/Prospective/Prospective.jsp")
Sys.sleep(20)

click <- remDr$findElement(using='xpath',"//a[contains(@href,'Rawtab')]")$clickElement()
Sys.sleep(30)

search_type <- remDr$findElement(using='xpath',"(//tfoot//tr//th[3]//input[contains(@type,'text')])[5]")
search_type$sendKeysToElement(list('SPN'))
Sys.sleep(10)

search_dm <- remDr$findElement(using='xpath',"(//tfoot//tr//th[8]//input[contains(@type,'text')])[5]")
search_dm$sendKeysToElement(list('ARR'))
Sys.sleep(10)

webElem <- remDr$findElement("css", "body")
webElem$sendKeysToElement(list(key = "home"))

click_copy <- remDr$findElement(using='xpath',"//div[contains(@id,'rawdata_wrapper')]//div[contains(@class,'dt-buttons btn-group')]//a[contains(@class,'btn btn-secondary buttons-copy')]")
location <- click_copy$getElementLocation()
location_unlist <- unlist(location)
location_df <- data.frame(location_unlist)

x <- location_df[1,]
y <- location_df[2,]
.jcall(jRobot,, "mouseMove",as.integer(x),as.integer(y))
#click<-remDr$findElement(using='xpath',"//div[contains(@id,'rawdata_wrapper')]//div[contains(@class,'dt-buttons btn-group')]//a[contains(@class,'btn btn-secondary buttons-copy')]//span")
click_copy$clickElement()

prospective_table <- read.table("clipboard",sep="\t",skip =2, header = TRUE)
#write.xlsx(table,"Final_prospective_table.xlsx",col.names = FALSE)
remDr$close()

prospective_table[,16] <-  Sys.Date()
colnames(prospective_table)[16] <- "sys_date"

prospective_table$Schedule.Date <- as.Date(prospective_table$Schedule.Date , format = "%Y-%m-%d")

######## Rawdata ########
raw_data <- sqldf("Select * from prospective_table
                  where [Schedule.Date] >= [sys_date]
                  ")
colnames(raw_data)[7] <- "Schdeuled_date"
#raw_data[is.na(raw_data)] <-'0'

FBA_rawdata <- sqldf("Select * from raw_data
                     where [GL] like '%FBA%'
                     ")

CT_rawdata <- sqldf("Select * from raw_data
                    where [GL] NOT LIKE '%FBA%' and [GL] NOT LIKE '%SM2%'
                    ")

Appario_rawdata <- sqldf("Select * from raw_data
                         where [GL] like '%SM2%'
                         ")

############################################################## SCAC Level #########################################################
################# FBA Scheduled ###################
FBA_data <- sqldf("Select distinct FC,SCAC,Schdeuled_date,Eaches
                  from FBA_rawdata
                  ")

FBA <- sqldf("Select FC,SCAC,Schdeuled_date,
             Sum(Eaches) as 'Schdeuled_units'
             from FBA_data
             group by FC,SCAC,Schdeuled_date
             order by FC
             ")

FBA_display <- as.data.frame(FBA)
value <- FBA_display$Schdeuled_date

FBA_display$Schdeuled_date <- as.character(FBA_display$Schdeuled_date)

fba_melt <- melt(FBA_display, FC = c("FC","SCAC"))
fba_melt$variable <- weekdays(value)

fba_cast <- cast(fba_melt, FC+SCAC ~ Schdeuled_date + variable)
fba_cast[is.na(fba_cast)] <-'0'

################# CT Scheduled ###################
CT_data <- sqldf("Select distinct FC,SCAC,Schdeuled_date,Eaches
                 from CT_rawdata
                 
                 ")

CT <- sqldf("Select FC,SCAC,Schdeuled_date,
            Sum(Eaches) as 'Schdeuled_units'
            from CT_data
            group by FC,SCAC,Schdeuled_date
            order by FC
            ")

CT_display <- as.data.frame(CT)
value <- CT_display$Schdeuled_date

CT_display$Schdeuled_date <- as.character(CT_display$Schdeuled_date)

CT_melt <- melt(CT_display, FC = c("FC","SCAC"))
CT_melt$variable <- weekdays(value)

CT_cast <- cast(CT_melt, FC+SCAC ~ Schdeuled_date + variable)
CT_cast[is.na(CT_cast)] <-'0'

################# Appario Scheduled ###################
Appario_data <- sqldf("Select distinct FC,SCAC,Schdeuled_date,Eaches
                      from Appario_rawdata
                      
                      ")

Appario <- sqldf("Select FC,SCAC,Schdeuled_date,
                 Sum(Eaches) as 'Schdeuled_units'
                 from Appario_data
                 group by FC,SCAC,Schdeuled_date
                 order by FC
                 ")

Appario_display <- as.data.frame(Appario)
value <- Appario_display$Schdeuled_date

Appario_display$Schdeuled_date <- as.character(Appario_display$Schdeuled_date)

Appario_melt <- melt(Appario_display, FC = c("FC","SCAC"))
Appario_melt$variable <- weekdays(value)

Appario_cast <- cast(Appario_melt, FC+SCAC ~ Schdeuled_date + variable)
Appario_cast[is.na(Appario_cast)] <-'0'

############################################################## GL Level #########################################################
################# FBA Scheduled ###################
FBA_GL_data <- sqldf("Select distinct FC,GL,Schdeuled_date,Eaches
                     from FBA_rawdata
                     ")

FBA_GL <- sqldf("Select FC,GL,Schdeuled_date,
                Sum(Eaches) as 'Schdeuled_units'
                from FBA_GL_data
                group by FC,GL,Schdeuled_date
                order by FC
                ")

FBA_GL_display <- as.data.frame(FBA_GL)
value <- FBA_GL_display$Schdeuled_date

FBA_GL_display$Schdeuled_date <- as.character(FBA_GL_display$Schdeuled_date)

fba_GL_melt <- melt(FBA_GL_display, FC = c("FC","GL"))
fba_GL_melt$variable <- weekdays(value)

fba_GL_cast <- cast(fba_GL_melt, FC+GL ~ Schdeuled_date + variable)
fba_GL_cast[is.na(fba_GL_cast)] <-'0'

################# CT Scheduled ###################
CT_GL_data <- sqldf("Select distinct FC,GL,Schdeuled_date,Eaches
                    from CT_rawdata
                    ")

CT_GL <- sqldf("Select FC,GL,Schdeuled_date,
               Sum(Eaches) as 'Schdeuled_units'
               from CT_GL_data
               group by FC,GL,Schdeuled_date
               order by FC
               ")

CT_GL_display <- as.data.frame(CT_GL)
value <- CT_GL_display$Schdeuled_date

CT_GL_display$Schdeuled_date <- as.character(CT_GL_display$Schdeuled_date)

CT_GL_melt <- melt(CT_GL_display, FC = c("FC","GL"))
CT_GL_melt$variable <- weekdays(value)

CT_GL_cast <- cast(CT_GL_melt, FC+GL ~ Schdeuled_date + variable)
CT_GL_cast[is.na(CT_GL_cast)] <-'0'

################# Appario Scheduled ###################
Appario_GL_data <- sqldf("Select distinct FC,GL,Schdeuled_date,Eaches
                         from Appario_rawdata
                         ")

Appario_GL <- sqldf("Select FC,GL,Schdeuled_date,
                    Sum(Eaches) as 'Schdeuled_units'
                    from Appario_GL_data
                    group by FC,GL,Schdeuled_date
                    order by FC
                    ")

Appario_GL_display <- as.data.frame(Appario_GL)
value <- Appario_GL_display$Schdeuled_date

Appario_GL_display$Schdeuled_date <- as.character(Appario_GL_display$Schdeuled_date)

Appario_GL_melt <- melt(Appario_GL_display, FC = c("FC","GL"))
Appario_GL_melt$variable <- weekdays(value)

Appario_GL_cast <- cast(Appario_GL_melt, FC+GL ~ Schdeuled_date + variable)
Appario_GL_cast[is.na(Appario_GL_cast)] <-'0'

################ Standing Appointment ################
Standing_Appointment_data <- sqldf(" Select * from raw_data
                                     where [SCAC] like '%AZSP%'
                                  ")

Standing_appt_data <- sqldf("Select distinct FC,GL,Schdeuled_date,Eaches
                             from Standing_Appointment_data
                         ")

Standing_appt <- sqldf("Select FC,GL,Schdeuled_date,
                    Sum(Eaches) as 'Schdeuled_units'
                    from Standing_appt_data
                    group by FC,GL,Schdeuled_date
                    order by FC
                    ")

Standing_appt_display <- as.data.frame(Standing_appt)
value <- Standing_appt_display$Schdeuled_date

Standing_appt_display$Schdeuled_date <- as.character(Standing_appt_display$Schdeuled_date)

Standing_appt_melt <- melt(Standing_appt_display, FC = c("FC","GL"))
Standing_appt_melt$variable <- weekdays(value)

Standing_appt_cast <- cast(Standing_appt_melt, FC+GL ~ Schdeuled_date + variable)
Standing_appt_cast[is.na(Standing_appt_cast)] <-'0'

############################ Shiny dashboard ##########################
################# UI #######################
ui <- dashboardPage(
  header <- dashboardHeader(title = "Domestic Shipping")  ,
  sidebar <- dashboardSidebar(
    sidebarMenu(id="sidebar",
                menuItem("FBA Shipments",tabName = "FBA_Shipments",icon=icon("dashboard")),
                menuItem("CT Shipments",tabName = "CT_Shipments",icon=icon("dashboard")),
                menuItem("Appario Shipments",tabName = "Appario_Shipments",icon=icon("dashboard")),
                menuItem("Standing Appointment", tabName = "Standing_Appointment",icon=icon("dashboard")),
                menuItem("Rawdata", tabName = "Rawdata",icon=icon("dashboard"))
                
    )
  ),
  
  body <- dashboardBody(
    
    tabItems(
      tabItem(tabName="FBA_Shipments",class = "active",
              tabBox(
                title = "Scheduled units",
                # The id lets us use input$tabset1 on the server to find the current tab
                id = "tabset1", height = "900px", width = "50px",
                tabPanel("FBA Shipments : GL",  dataTableOutput("FBA_GL_cast")),
                tabPanel("FBA Shipments : Provider Level",  dataTableOutput("Fba_data"))
                
              )
      ),
      
      tabItem(tabName="CT_Shipments",
              tabBox(
                title = "Scheduled units",
                # The id lets us use input$tabset1 on the server to find the current tab
                id = "tabset1", height = "900px", width = "50px",
                tabPanel("CT Shipments : GL",  dataTableOutput("CT_GL_cast")),
                tabPanel("CT Shipments : Provider Level",  dataTableOutput("CT_data"))
                
              )
      ),
      tabItem(tabName="Appario_Shipments",
              tabBox(
                title = "Scheduled units",
                # The id lets us use input$tabset1 on the server to find the current tab
                id = "tabset1", height = "900px", width = "50px",
                tabPanel("Appario Shipments : GL",  dataTableOutput("appario_GL_cast")),
                tabPanel("Appario Shipments : Provider Level",  dataTableOutput("appario_data"))
                
              )
      ),
      tabItem(tabName="Standing_Appointment",
              tabBox(
                title = "Scheduled units",
                # The id lets us use input$tabset1 on the server to find the current tab
                id = "tabset1", height = "900px", width = "50px",
                tabPanel("Standing Appointment Tracker",  dataTableOutput("Standing_appt_cast"))
                #tabPanel("Appario Shipments : Provider Level",  dataTableOutput("appario_data"))
                
              )
      ),
      tabItem(tabName="Rawdata",
              tabBox(
                title = "Scheduled units",
                # The id lets us use input$tabset1 on the server to find the current tab
                id = "tabset1", height = "1200px", width = "50px",
                tabPanel("Rawdata",  dataTableOutput("rawdata"))
                
              )
      )
      
      
    )
  )
  
)

ui <- dashboardPage(title = 'forecast', header, sidebar, body, skin='red')

################################## Server ###############################
server <- function(input, output) 
{
  
  output$Fba_data <- renderDataTable(fba_cast, options = list(pageLength = 15))
  output$FBA_GL_cast <- renderDataTable(fba_GL_cast, options = list(pageLength = 15))
  output$CT_data <- renderDataTable(CT_cast, options = list(pageLength = 15))
  output$CT_GL_cast <- renderDataTable(CT_GL_cast, options = list(pageLength = 15))
  output$appario_data <- renderDataTable(Appario_cast, options = list(pageLength = 15))
  output$appario_GL_cast <- renderDataTable(Appario_GL_cast, options = list(pageLength = 15))
  output$Standing_appt_cast <- renderDataTable(Standing_appt_cast, options = list(pageLength = 15))
  output$rawdata <- renderDataTable(raw_data,options = list(pageLength = 15))
  
}

######################## Deploy ###############################
shinyApp(ui, server)
'''
1 Like

I'm sorry but I won't be able to help you with code review or detailed implementation.

I suggest you solve your problems individually, and ask help when you get stuck on specific topics.

It seems your first question is how to install Shiny Server or RStudio Connect on AWS. I have already tried to answer this in my earlier response:

the process is essentially to follow the steps in the Shiny Server admin guide, and you can also refer to the support article FAQ for RStudio Server Pro AWS. You should also consider using RStudio Connect for your app, since you can use Connect for both shiny apps and scheduled R scripts via Rmarkdown.

Regarding your steps to solve the actual problem, you suggest yourself a course of action:

  • Script 1: data scraping using scheduler
  • Script 2: to fetch the data and do the calculations and display it in the shiny app.

This makes sense to me. Your scheduled script can run once an hour, scrape the data, and write this to a local database or set of files (including csv). I wouldn't use Excel files for this step, since this simply introduces unnecessary complexity. I suggest sticking to csv files, or ideally write the data to a local database.

The shiny app then reads this data and displays to the user.

Some high level comments on your code:

  • Do not use install.packages() in your script. This takes time, and every time you install a new package, it is possible that the package can change and break your code.
  • I highly recommend you use the tidyverse packages for your analysis, in particular dplyr. This will make your code much easier to write and maintain. A good place to start learning about this is https://dplyr.tidyverse.org/

thanks for your help, i just need one more help in rendering the table data and refreshing the values in shiny every 1 hour in particular how will i enable my app to search for latest data and display without crashing the app?

Have you looked at Reactive polling or reactive file readers as I suggested in my first response?

The idea is that you set up polling function that is cheap to compute.

From ?reactiveFileReader:

works by periodically checking the file's last modified time; if it has changed, then the file is re-read and any reactive dependents are invalidated.

The demo describes in detail how this works, complete with code you can copy and reuse.

Sure, i will go through and apply, will get back if i face issues.

Hi @richapriya,

It seems that this question is nearly an exact duplicate to this question, only now it is further complicated by trying to host the app in addition to getting the web scraping to work on a schedule.

selenium piece is sorted and writing csv files in one location.
Yes, i need to host this in aws and i am not understanding the process.

i want shiny app to display the data first time it is deployed and then every 30 minutes the data tables are getting updated in the app.
I am using rselenium for fetching live data.


This topic and replies below were merged with duplicate questions.

@economicurtis

Hi! Welcome to RStudio Community!

What have you tried so far? Can you provide a small toy example app that attempts to simulate what you are trying to do? It is hard for the community to provide detailed help without knowing what the structure of you app looks like.

If you already have the app the way you want it and the data scraping is running smoothly, you may just be looking for reactiveTimer in the shiny package. This allows you to invalidate any reactive expression you want on a certain time interval, which sounds pretty close to what you are looking for.

#>R_code<-######### Required packages ##########
install.packages("devtools") 
devtools::install_github("ropensci/RSelenium") 
library(devtools)
install.packages("RSelenium")
library(RSelenium)
install.packages("xlsx")
library(xlsx)
install.packages("lubridate")
library(lubridate)
install.packages("sqldf")
library("sqldf")
install.packages("date")
library(date)
install.packages("chron")
library(chron)
install_version("binman", version = "0.1.0", repos = "https://cran.uni-muenster.de/")
install_version("wdman", version = "0.2.2", repos = "https://cran.uni-muenster.de/")
install_version("RSelenium", version = "1.7.1", repos = "https://cran.uni-muenster.de/") 
install.packages("reshape")
library(reshape)
install.packages("reshape2")
library(reshape2)
install.packages("shinydashboard")
library(shinydashboard)
install.packages("dplyr")
library(dplyr)
install.packages("shiny")
library(shiny)
install.packages("purrr")
library(purrr)
install.packages("highcharter")
library(highcharter)
install.packages("DT")
library(DT)
install.packages("htmltools")
library(htmltools)
install.packages("httpuv")
library(httpuv)
install.packages("ggplot2")
library(ggplot2)
install.packages("rjava")
library(rJava)

########### removing previous file ############
rm(list=ls())

.jinit()
jRobot <- .jnew("java/awt/Robot")
.jcall(jRobot,, "setAutoDelay",as.integer(500))

rD<-RSelenium::rsDriver(port=4234L,browser=c("chrome","firefox","phantomjs", "internet explorer"),version="latest",chromever = "latest", geckover = "latest", iedrver = NULL, phantomver = "2.1.1", ,verbose=TRUE)
remDr <- rD[["client"]]
remDr$maxWindowSize()
#remDr$setWindowPosition(-2000,0) 

remDr$navigate("https://isro.corp.amazon.com/Prospective/Prospective.jsp")
Sys.sleep(20)

click <- remDr$findElement(using='xpath',"//a[contains(@href,'Rawtab')]")$clickElement()
Sys.sleep(30)

search_type <- remDr$findElement(using='xpath',"(//tfoot//tr//th[3]//input[contains(@type,'text')])[5]")
search_type$sendKeysToElement(list('SPN'))
Sys.sleep(10)

search_dm <- remDr$findElement(using='xpath',"(//tfoot//tr//th[8]//input[contains(@type,'text')])[5]")
search_dm$sendKeysToElement(list('ARR'))
Sys.sleep(10)

webElem <- remDr$findElement("css", "body")
webElem$sendKeysToElement(list(key = "home"))

click_copy <- remDr$findElement(using='xpath',"//div[contains(@id,'rawdata_wrapper')]//div[contains(@class,'dt-buttons btn-group')]//a[contains(@class,'btn btn-secondary buttons-copy')]")
location <- click_copy$getElementLocation()
location_unlist <- unlist(location)
location_df <- data.frame(location_unlist)

x <- location_df[1,]
y <- location_df[2,]
.jcall(jRobot,, "mouseMove",as.integer(x),as.integer(y))
#click<-remDr$findElement(using='xpath',"//div[contains(@id,'rawdata_wrapper')]//div[contains(@class,'dt-buttons btn-group')]//a[contains(@class,'btn btn-secondary buttons-copy')]//span")
click_copy$clickElement()

prospective_table <- read.table("clipboard",sep="\t",skip =2, header = TRUE)
#write.xlsx(table,"Final_prospective_table.xlsx",col.names = FALSE)
remDr$close()

prospective_table[,16] <-  Sys.Date()
colnames(prospective_table)[16] <- "sys_date"

prospective_table$Schedule.Date <- as.Date(prospective_table$Schedule.Date , format = "%Y-%m-%d")

######## Rawdata ########
raw_data <- sqldf("Select * from prospective_table
                  where [Schedule.Date] >= [sys_date]
                  ")
colnames(raw_data)[7] <- "Schdeuled_date"
#raw_data[is.na(raw_data)] <-'0'

FBA_rawdata <- sqldf("Select * from raw_data
                     where [GL] like '%FBA%'
                     ")

CT_rawdata <- sqldf("Select * from raw_data
                    where [GL] NOT LIKE '%FBA%' and [GL] NOT LIKE '%SM2%'
                    ")

Appario_rawdata <- sqldf("Select * from raw_data
                         where [GL] like '%SM2%'
                         ")

############################################################## SCAC Level #########################################################
################# FBA Scheduled ###################
FBA_data <- sqldf("Select distinct FC,SCAC,Schdeuled_date,Eaches
                  from FBA_rawdata
                  ")

FBA <- sqldf("Select FC,SCAC,Schdeuled_date,
             Sum(Eaches) as 'Schdeuled_units'
             from FBA_data
             group by FC,SCAC,Schdeuled_date
             order by FC
             ")

FBA_display <- as.data.frame(FBA)
value <- FBA_display$Schdeuled_date

FBA_display$Schdeuled_date <- as.character(FBA_display$Schdeuled_date)

fba_melt <- melt(FBA_display, FC = c("FC","SCAC"))
fba_melt$variable <- weekdays(value)

fba_cast <- cast(fba_melt, FC+SCAC ~ Schdeuled_date + variable)
fba_cast[is.na(fba_cast)] <-'0'

################# CT Scheduled ###################
CT_data <- sqldf("Select distinct FC,SCAC,Schdeuled_date,Eaches
                 from CT_rawdata
                 
                 ")

CT <- sqldf("Select FC,SCAC,Schdeuled_date,
            Sum(Eaches) as 'Schdeuled_units'
            from CT_data
            group by FC,SCAC,Schdeuled_date
            order by FC
            ")

CT_display <- as.data.frame(CT)
value <- CT_display$Schdeuled_date

CT_display$Schdeuled_date <- as.character(CT_display$Schdeuled_date)

CT_melt <- melt(CT_display, FC = c("FC","SCAC"))
CT_melt$variable <- weekdays(value)

CT_cast <- cast(CT_melt, FC+SCAC ~ Schdeuled_date + variable)
CT_cast[is.na(CT_cast)] <-'0'

################# Appario Scheduled ###################
Appario_data <- sqldf("Select distinct FC,SCAC,Schdeuled_date,Eaches
                      from Appario_rawdata
                      
                      ")

Appario <- sqldf("Select FC,SCAC,Schdeuled_date,
                 Sum(Eaches) as 'Schdeuled_units'
                 from Appario_data
                 group by FC,SCAC,Schdeuled_date
                 order by FC
                 ")

Appario_display <- as.data.frame(Appario)
value <- Appario_display$Schdeuled_date

Appario_display$Schdeuled_date <- as.character(Appario_display$Schdeuled_date)

Appario_melt <- melt(Appario_display, FC = c("FC","SCAC"))
Appario_melt$variable <- weekdays(value)

Appario_cast <- cast(Appario_melt, FC+SCAC ~ Schdeuled_date + variable)
Appario_cast[is.na(Appario_cast)] <-'0'

############################################################## GL Level #########################################################
################# FBA Scheduled ###################
FBA_GL_data <- sqldf("Select distinct FC,GL,Schdeuled_date,Eaches
                     from FBA_rawdata
                     ")

FBA_GL <- sqldf("Select FC,GL,Schdeuled_date,
                Sum(Eaches) as 'Schdeuled_units'
                from FBA_GL_data
                group by FC,GL,Schdeuled_date
                order by FC
                ")

FBA_GL_display <- as.data.frame(FBA_GL)
value <- FBA_GL_display$Schdeuled_date

FBA_GL_display$Schdeuled_date <- as.character(FBA_GL_display$Schdeuled_date)

fba_GL_melt <- melt(FBA_GL_display, FC = c("FC","GL"))
fba_GL_melt$variable <- weekdays(value)

fba_GL_cast <- cast(fba_GL_melt, FC+GL ~ Schdeuled_date + variable)
fba_GL_cast[is.na(fba_GL_cast)] <-'0'

################# CT Scheduled ###################
CT_GL_data <- sqldf("Select distinct FC,GL,Schdeuled_date,Eaches
                    from CT_rawdata
                    ")

CT_GL <- sqldf("Select FC,GL,Schdeuled_date,
               Sum(Eaches) as 'Schdeuled_units'
               from CT_GL_data
               group by FC,GL,Schdeuled_date
               order by FC
               ")

CT_GL_display <- as.data.frame(CT_GL)
value <- CT_GL_display$Schdeuled_date

CT_GL_display$Schdeuled_date <- as.character(CT_GL_display$Schdeuled_date)

CT_GL_melt <- melt(CT_GL_display, FC = c("FC","GL"))
CT_GL_melt$variable <- weekdays(value)

CT_GL_cast <- cast(CT_GL_melt, FC+GL ~ Schdeuled_date + variable)
CT_GL_cast[is.na(CT_GL_cast)] <-'0'

################# Appario Scheduled ###################
Appario_GL_data <- sqldf("Select distinct FC,GL,Schdeuled_date,Eaches
                         from Appario_rawdata
                         ")

Appario_GL <- sqldf("Select FC,GL,Schdeuled_date,
                    Sum(Eaches) as 'Schdeuled_units'
                    from Appario_GL_data
                    group by FC,GL,Schdeuled_date
                    order by FC
                    ")

Appario_GL_display <- as.data.frame(Appario_GL)
value <- Appario_GL_display$Schdeuled_date

Appario_GL_display$Schdeuled_date <- as.character(Appario_GL_display$Schdeuled_date)

Appario_GL_melt <- melt(Appario_GL_display, FC = c("FC","GL"))
Appario_GL_melt$variable <- weekdays(value)

Appario_GL_cast <- cast(Appario_GL_melt, FC+GL ~ Schdeuled_date + variable)
Appario_GL_cast[is.na(Appario_GL_cast)] <-'0'

################ Standing Appointment ################
Standing_Appointment_data <- sqldf(" Select * from raw_data
                                     where [SCAC] like '%AZSP%'
                                  ")

Standing_appt_data <- sqldf("Select distinct FC,GL,Schdeuled_date,Eaches
                             from Standing_Appointment_data
                         ")

Standing_appt <- sqldf("Select FC,GL,Schdeuled_date,
                    Sum(Eaches) as 'Schdeuled_units'
                    from Standing_appt_data
                    group by FC,GL,Schdeuled_date
                    order by FC
                    ")

Standing_appt_display <- as.data.frame(Standing_appt)
value <- Standing_appt_display$Schdeuled_date

Standing_appt_display$Schdeuled_date <- as.character(Standing_appt_display$Schdeuled_date)

Standing_appt_melt <- melt(Standing_appt_display, FC = c("FC","GL"))
Standing_appt_melt$variable <- weekdays(value)

Standing_appt_cast <- cast(Standing_appt_melt, FC+GL ~ Schdeuled_date + variable)
Standing_appt_cast[is.na(Standing_appt_cast)] <-'0'

############################ Shiny dashboard ##########################
################# UI #######################
ui <- dashboardPage(
  header <- dashboardHeader(title = "Domestic Shipping")  ,
  sidebar <- dashboardSidebar(
    sidebarMenu(id="sidebar",
                menuItem("FBA Shipments",tabName = "FBA_Shipments",icon=icon("dashboard")),
                menuItem("CT Shipments",tabName = "CT_Shipments",icon=icon("dashboard")),
                menuItem("Appario Shipments",tabName = "Appario_Shipments",icon=icon("dashboard")),
                menuItem("Standing Appointment", tabName = "Standing_Appointment",icon=icon("dashboard")),
                menuItem("Rawdata", tabName = "Rawdata",icon=icon("dashboard"))
                
    )
  ),
  
  body <- dashboardBody(
    
    tabItems(
      tabItem(tabName="FBA_Shipments",class = "active",
              tabBox(
                title = "Scheduled units",
                # The id lets us use input$tabset1 on the server to find the current tab
                id = "tabset1", height = "900px", width = "50px",
                tabPanel("FBA Shipments : GL",  dataTableOutput("FBA_GL_cast")),
                tabPanel("FBA Shipments : Provider Level",  dataTableOutput("Fba_data"))
                
              )
      ),
      
      tabItem(tabName="CT_Shipments",
              tabBox(
                title = "Scheduled units",
                # The id lets us use input$tabset1 on the server to find the current tab
                id = "tabset1", height = "900px", width = "50px",
                tabPanel("CT Shipments : GL",  dataTableOutput("CT_GL_cast")),
                tabPanel("CT Shipments : Provider Level",  dataTableOutput("CT_data"))
                
              )
      ),
      tabItem(tabName="Appario_Shipments",
              tabBox(
                title = "Scheduled units",
                # The id lets us use input$tabset1 on the server to find the current tab
                id = "tabset1", height = "900px", width = "50px",
                tabPanel("Appario Shipments : GL",  dataTableOutput("appario_GL_cast")),
                tabPanel("Appario Shipments : Provider Level",  dataTableOutput("appario_data"))
                
              )
      ),
      tabItem(tabName="Standing_Appointment",
              tabBox(
                title = "Scheduled units",
                # The id lets us use input$tabset1 on the server to find the current tab
                id = "tabset1", height = "900px", width = "50px",
                tabPanel("Standing Appointment Tracker",  dataTableOutput("Standing_appt_cast"))
                #tabPanel("Appario Shipments : Provider Level",  dataTableOutput("appario_data"))
                
              )
      ),
      tabItem(tabName="Rawdata",
              tabBox(
                title = "Scheduled units",
                # The id lets us use input$tabset1 on the server to find the current tab
                id = "tabset1", height = "1200px", width = "50px",
                tabPanel("Rawdata",  dataTableOutput("rawdata"))
                
              )
      )
      
      
    )
  )
  
)

ui <- dashboardPage(title = 'forecast', header, sidebar, body, skin='red')

################################## Server ###############################
server <- function(input, output) 
{
  
  output$Fba_data <- renderDataTable(fba_cast, options = list(pageLength = 15))
  output$FBA_GL_cast <- renderDataTable(fba_GL_cast, options = list(pageLength = 15))
  output$CT_data <- renderDataTable(CT_cast, options = list(pageLength = 15))
  output$CT_GL_cast <- renderDataTable(CT_GL_cast, options = list(pageLength = 15))
  output$appario_data <- renderDataTable(Appario_cast, options = list(pageLength = 15))
  output$appario_GL_cast <- renderDataTable(Appario_GL_cast, options = list(pageLength = 15))
  output$Standing_appt_cast <- renderDataTable(Standing_appt_cast, options = list(pageLength = 15))
  output$rawdata <- renderDataTable(raw_data,options = list(pageLength = 15))
  
}

######################## Deploy ###############################
shinyApp(ui, server)
'''
1 Like

Basically i want the correct place to write the selenium part followed by calculations in the code and then display the data with the UI at first deployment and then refresh the table data wwhile calling the selenium part every 30 minutes.
Please help on the same. i have a deadline of 17th June 2018.

@tbradley : can you please help me with the data refresh part every 30 minutes please.

Did you look at the link I posted above about reactiveTimer? This should let you do what you want if you move your data scraping into your server code. Right now, you are only rendering static tables in your server code. You need to move your data scraping and data manipulation into reactive functions in your server code and use it in combination with reactiveTimer to achieve what you want

4 Likes

hey yeah i used reactive, it solved my problem.

I want to host shinyapp on local system as in intranet of my org, is it possible and if yes can people view it without installing r in their system?

You have a few options for deployment.
Hosting and deployment of your shiny app.

It sounds like Shiny Server will serve you well in this case.