Selenium for live data in shiny for data refresh

shiny
rstudio

#1

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.


#2

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.


#3
#>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)
'''

#4

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.


#5

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


#6

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