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