I have a shiny app with reactivePoll for fetching data from MySQL server. Rendering plots is taking too long, 5 to 8 minutes. I have profiled the App with profVis and realized that the code which is consuming time in the App is loading data from reactivePoll for all the plots. How can i improve the performance of this app.
The connection and query code is as follows:
con <- dbConnect(MySQL(),
user = ('root'),
password = ('ruvimboML55AMG'),
host = ('localhost'),
dbname = ('healthcare_mining'))
onStop(function(){
dbDisconnect(con)
})
get_data <- function(con) {
MBA_Online <- dbGetQuery(con, "SELECT Transaction,Item, Date, Quantity, CustomerID, UnitPrice, Amount FROM onlineRetail WHERE Amount > 0 and Quantity > 0;")
# return(MBA_Online)
}
# Reactive poll for main data
MBA_Online <- reactivePoll(1800000, session,
checkFunc = function(){
print("Entered Check")
Sys.time()
print(Sys.time())
# get max date from database table to determine if data has been updated
max_date <- dbGetQuery(con, "SELECT UNIX_TIMESTAMP(date_updated) FROM onlineRetail as last_updated;")
return(max_date)
},
valueFunc = function(){
print("Entered Value")
Sys.time()
print(Sys.time())
get_data(con)
# return(MBA_Online)
}
)
``` r
I then render the plots as follows:
## Graph of transactions per month
output$TransMonthPlot <- renderPlot({
req(credentials()$user_auth)
withProgress(message = 'Calculation in progress',
detail = 'This may take a while...', value = 0, {
for (i in 1:15) {
incProgress(1/15)
Sys.sleep(15)
}
})
**g1 <- MBA_Online() %>%**
mutate(tDate=as.Date(Date)) %>%
filter(tDate >= as.Date(input$dRange[1]) & tDate <= as.Date(input$dRange[2])) %>%
# dplyr::mutate(Month = as.factor(month(as.Date(Date)))) %>%
mutate(Month=as.factor(month(Date))) %>%
# dplyr::rename(item = Item) %>%
dplyr::group_by(Month) %>%
# dplyr::summarise(n_distinct(Transaction)) %>%
dplyr::summarize(Transactions = n_distinct(Transaction)) %>%
# dplyr::summarise(Count=n()) %>%
ggplot(aes(x=Month, y = Transactions, fill = Month)) +
geom_bar(stat="identity") +
geom_label(aes(label= format(Transactions, big.mark = ",")))+
theme(legend.position="none")+
theme(panel.background = element_blank())+
labs(x = "Month", y = "Transactions", title = "Transactions per month")
## Plot items per transaction per month
**x1 <- MBA_Online() %>%**
mutate(tDate=as.Date(Date)) %>%
filter(tDate >= as.Date(input$dRange[1]) & tDate <= as.Date(input$dRange[2])) %>%
# dplyr::mutate(Day = as.factor(weekdays(as.Date(Date)))) %>%
dplyr::mutate(Month = as.factor(month(Date))) %>%
group_by(Month) %>%
dplyr::summarise(Count = n())
**x2 <- MBA_Online() %>%**
mutate(tDate=as.Date(Date)) %>%
filter(tDate >= as.Date(input$dRange[1]) & tDate <= as.Date(input$dRange[2])) %>%
# dplyr::mutate(Day = as.factor(weekdays(as.Date(Date)))) %>%
dplyr::mutate(Month = as.factor(month(Date))) %>%
group_by(Month, Transaction) %>%
dplyr::summarise(n_distinct(Transaction)) %>%
dplyr::summarise(Count =n())
x3 <- data.frame(x1, x2[2], x1[2]/x2[2])
colnames(x3) <- c("Month", "Line", "Unique", "Items.Trans")
g2 <- ggplot(x3,aes(x=Month, y = Items.Trans, fill=Month))+
theme_fivethirtyeight()+
geom_bar(stat = "identity")+
# labs(x = "Month", y = "Transactions", title = "Items per transaction per Month")+
# ggtitle("Items per transaction per Month")+
theme(legend.position = "none")+
geom_text(aes(label=round(Items.Trans,0)), vjust=2) +
labs(
x="Month",
y="Items",
title = paste(
"Items per transaction per Month"
)
)
grid.arrange(g1,g2)
}, height = 600, width = 800)
The reading of reactive data is the process taking too long i.e. the MBA_Online() marked with *** in the code
Regards
.