In this shiny app, three SQLs are running at startup.
However, this puts a heavy load on startup.
Is it possible to run SQL when each tab is selected?
ui.R
shinyUI(
navbarPage(title = NULL,
tabPanel("home","hello"),
tabPanel("1",
tableOutput("table1")),
tabPanel("2",
tableOutput("table2")),
tabPanel("3",
tableOutput("table3")))
)
server.R
shinyServer(function(input, output) {
output$table1 <- renderTable({
sql <- "SELECT * FROM City WHERE ID = '1';"
query <- sqlInterpolate(pool, sql)
dbGetQuery(pool, query)
})
output$table2 <- renderTable({
sql <- "SELECT * FROM City WHERE ID = '2';"
query <- sqlInterpolate(pool, sql)
dbGetQuery(pool, query)
})
output$table3 <- renderTable({
sql <- "SELECT * FROM City WHERE ID = '3';"
query <- sqlInterpolate(pool, sql)
dbGetQuery(pool, query)
})
})
global.R
library(shiny)
library(DBI)
library(pool)
pool <- dbPool(
drv = RMySQL::MySQL(),
dbname = "shinydemo",
host = "shiny-demo.csa7qlmguqrf.us-east-1.rds.amazonaws.com",
username = "guest",
password = "guest"
)
You can try reactive as the code bellow:
shinyServer = function(input, output){
reactive({
if (req(input$navbar) == "table1")
# Run your sql1
if (req(input$navbar) == "table2")
# Run your sql2
if (req(input$navbar) == "table3")
# Run your sql3
})
Hope it helps.
Related
I'm trying to build a Shiny application which will be connected to an unstable PostgreSQL Database with DBI. It works fine when the database is stable, but gives Whitelabel Error whenever the database is slow or down for a moment. How can I configure my application so that it will keep trying to connect a number of times before throwing error? A sample code is given below:
library(shiny)
library(DBI)
con <- dbConnect(
RPostgres::Postgres(),
host = "myip",
port = "myport",
dbname = "mydb",
user = "user",
password = "password"
)
ui <- fluidPage(
tableOutput("mytable")
)
server <- function(input, output, session){
output$mytable <- renderTable(
dbGetQuery(
con,
"select * from mytable;"
)
)
}
shinyApp(ui, server)
We can try purrr::insistently() with rate_backoff as suggested by #r2evans, to retry the query waiting longer between each time up to a maximum of 4 in this case.
library(shiny)
library(DBI)
library(purrr)
con <- dbConnect(
RPostgres::Postgres(),
host = "myip",
port = "myport",
dbname = "mydb",
user = "user",
password = "password"
)
my_rate <- rate_backoff(
pause_base = 1,
pause_cap = 60,
pause_min = 1,
max_times = 4,
jitter = FALSE
)
ui <- fluidPage(
tableOutput("mytable")
)
server <- function(input, output, session) {
output$mytable <- renderTable(
insistently(~
dbGetQuery(
con,
"select * from mytable;"
), rate = my_rate, quiet = FALSE)()
)
}
shinyApp(ui, server)
i use app.
ui.R
shinyUI(
fluidPage(
actionButton("clear_ui", "clear_ui"),
actionButton("clear_date", "clear_date"),
uiOutput("date_ui"),
textOutput("date_text")
)
)
server.R
shinyServer(function(input, output) {
observeEvent(input$clear_ui,{
output$date_ui <- renderUI({NULL})
})
observeEvent(input$clear_date,{
output$date <- NULL
})
output$date_ui <- renderUI({
dateRangeInput("date", "a", start = "2001-01-01", end = "2010-12-31")
})
output$date_text <- renderText({
input$date
})
})
global.R
library(shiny)
library(DBI)
library(pool)
pool <- dbPool(
drv = RMySQL::MySQL(),
dbname = "shinydemo",
host = "shiny-demo.csa7qlmguqrf.us-east-1.rds.amazonaws.com",
username = "guest",
password = "guest"
)
By using "clear_ui", ui of daterangeInput can be deleted.
However, the contents of the output "date" will remain.
Is it possible to delete "date" data by using "clear_date"?
You need to replace output$date by output$date_text in:
observeEvent(input$clear_date,{
output$date <- NULL
})
Note: The following is not a 'reproducible' example since it relies on a DB back end, but hopefully has enough to provide workable solution ideas.
I want to refresh my data if the database table changes. I am using a reactivePoll() for this one, happily. However, I want the reactivePoll() to forcibly kick in when input date range (or whatever input) changes and not wait for the poll interval to expire. How can I do both?
Here is the general idea of the code I have, but need to be improved to achieve the above result.
getTableData <- function(session, startDate, endDate) {
tableData <- reactivePoll(
60000, session,
checkFunc = function() {
dbconn <- dbConnect(MySQL(), group = 'mysql')
query <- dbSendQuery(
dbconn,
paste0('SELECT MAX(CREATED_AT) as lastCreated FROM MYDBTABLE;')
)
lastFeedback <- dbFetch(query, -1)
dbClearResult(query)
dbDisconnect(dbconn)
lastFeedback$lastCreated
},
valueFunc = function() {
query <- paste0(
"SELECT * FROM MYDBTABLE ",
"WHERE MY_DATE BETWEEN '",
startDate, "' AND '", endDate, "';"
)
dbconn <- dbConnect(MySQL(), group = 'mysql')
query <- dbSendQuery(dbconn, query)
refreshedData <- dbFetch(query, -1)
dbClearResult(query)
dbDisconnect(dbconn)
refreshedData
}
)
return(tableData())
}
server <- function(session, input, output) {
output$mydata <- renderDataTable({
datatable(mydbdata(session, input$mydates[1], input$mydates[2]))
})
}
ui <- fluidPage(
dateRangeInput(
'mydates', 'Select Dates:', start = Sys.Date() - 90, end = Sys.Date()
),
dataTableOutput('mydata')
)
shinyApp(ui = ui, server = server)
Following up on my comment, here's a possible alternative. Note that output$test is updated whenever slider is changed or invalidateLater() is fired -
library(shiny)
ui <- fluidPage(align = "center",
sliderInput("s", "slider", 1, 10, 1, step = 1),
verbatimTextOutput("test")
)
server <- shinyServer(function(input, output, session) {
x <- reactiveValues(x = NULL)
observeEvent(input$s, {
x$x <- "updated via slider" # simulates date changes
})
observe({
invalidateLater(5000, session) # simulates reactivePoll
x$x <- "updated via Poll"
})
output$test <- renderPrint({
x$x
})
})
shinyApp(ui, server)
i worked on data from SQL Server in R using RODBC and after getting my result i created ShinyApp to deploy my result But i want to get my data from my SQL query directly without exporting my result to Excel and then import it to shiny,How can i do that?
Test <- odbcDriverConnect("driver={SQL Server};server=localhost;database=Fakahany;trusted_connection=true")
Orders<- sqlQuery(Test,"
SELECT
WHWorkOrderHeaderId
, OtherLangDescription
FROM Warehouse.WHWorkOrderDetails
INNER JOIN Warehouse.WHWorkOrderHeader AS WHH
ON Warehouse.WHWorkOrderDetails.WHWorkOrderHeaderId = WHH.ID
INNER JOIN Warehouse.StockItems
ON Warehouse.WHWorkOrderDetails.StockItemId = Warehouse.StockItems.Id
WHERE Type = 'IO'
ORDER BY OtherLangDescription ASC")
#Creating the correlations
Orders$OtherLangDescription <- as.factor(Orders$OtherLangDescription)
orderList <- unique(Orders$OtherLangDescription)
ListId <- lapply(orderList, function(x) subset(Orders, OtherLangDescription == x)$WHWorkOrderHeaderId)
Initial_Tab <- lapply(ListId, function(x) subset(Orders, WHWorkOrderHeaderId %in% x)$OtherLangDescription)
Correlation_Tab <- mapply(function(Product, ID) table(Product)/length(ID),
Initial_Tab, ListId)
colnames(Correlation_Tab) <- orderList
cor_per<- round(Correlation_Tab*100,2)
DF<-data.frame(row=rownames(cor_per)[row(cor_per)], col=colnames(cor_per)[col(cor_per)], corr=c(cor_per))
and this is my app code:
#loading Packages
library(RODBC)
library(shiny)
library(rsconnect)
ui <- fluidPage(
titlePanel("Item Correlation"),
sidebarPanel(
selectInput("Item2","Select Item",choices= DF$FirstItem),
h6("Powerd By:"),
img(src='edrak.png',height='50px',width='110px')
# ,selectInput("Item","SelectItem",choices= DF$col)
),
mainPanel(
tableOutput("Itemcorr")
)
)
server <- function(input,output){
output$Itemcorr <- renderTable({
subset(DF, DF$FirstItem == input$Item2)
})
}
shinyApp(ui, server)
This should do what you want.
library(RODBCext)
library(shiny)
ui <- shinyUI(
pageWithSidebar(
headerPanel("Hide Side Bar example"),
sidebarPanel(
textInput("CATEGORY", "Enter CATEGORY below"),
submitButton(text="Submit")
),
mainPanel(
tabsetPanel(
tabPanel("Data", tableOutput("tbTable"))
)
)
)
)
server <- function(input, output, session)
{ # NOTE THE BRACE HERE
myData <- reactive({
req(input$CATEGORY)
#connect to database
dbhandle = odbcDriverConnect('driver={SQL Server};server=Server_Name;database=Database_Name;trusted_connection=true')
#build query
query = "SELECT * FROM [Your_Table] where [CATEGORY] = ?"
#store results
res <- sqlExecute(channel = dbhandle,
query = query,
data = list(input$CATEGORY),
fetch = TRUE,
stringsAsFactors = FALSE)
#close the connection
odbcClose(dbhandle)
#return results
res
})
output$tbTable <-
renderTable(myData())
} # AND NOTE THE CLOSING BRACE HERE
shinyApp(ui = ui, server = server)
You may want to consider this as well.
library(shiny)
library(RODBCext)
shinyApp(
ui =
shinyUI(
fluidPage(
uiOutput("select_category"),
tableOutput("display_data")
# plotOutput("plot_data")
)
),
# server needs the function; looks ok
server = shinyServer(function(input, output, session)
{
# A reactive object to get the query. This lets you use
# the data in multiple locations (plots, tables, etc) without
# having to perform the query in each output slot.
QueriedData <- reactive({
req(input$showDrop)
ch <- odbcDriverConnect("driver={SQL Server};server=Server_Name;database=DATABASE_NAME;trusted_connection=true")
showList <- sqlExecute(ch, "SELECT * FROM [Your_Table] WHERE Category = ?",
data = list(Category = input$showDrop),
fetch = TRUE,
stringsAsFactors = FALSE)
odbcClose(ch)
showList
})
# The select input control. These can be managed dynamically
# from the server, and then the control send back to the UI
# using `renderUI`
output$select_category <- renderUI({
ch <- odbcDriverConnect("driver={SQL Server};server=Server_Name;database=DATABASE_NAME;trusted_connection=true")
showList <- sqlExecute(ch, "Select Distinct Category From [Your_Table] Order by Category",
fetch = TRUE,
stringsAsFactors = FALSE)
odbcClose(ch)
selectInput(inputId = "showDrop",
label = "Select Asset",
showList$Category)
})
# Display the data in a table
output$display_data <- renderTable({
QueriedData()
})
# Display a plot
# output$plot_data <-
# renderPlot({
# plot(QueriedData()) # fill in the plot code you want to use.
# })
})
)
I am trying to do this autocomplete using a list which would be populated dynamically from a database everytime the applications loads. Unfortunately the following approach isn't working.
rm(list = ls())
library(shinysky)
library(shiny)
library(RMySQL)
loadData <- function(publisherId) {
# Connect to the database
mydb = dbConnect(MySQL(), user='root', password='root',host='localhost',dbname="tq")
# Construct the fetching query
query <- sprintf("select * from tq.publisher_dim where publisher_id = %s",publisherId) # Submit the fetch query and disconnect
data <- dbGetQuery(mydb, query)
dbDisconnect(mydb)
data
}
loadPubIds <- function() {
# Connect to the database
mydb = dbConnect(MySQL(), user='root', password='root', host='localhost', dbname="tq")
# Construct the fetching query
query <- sprintf("select distinct publisher_id from tq.publisher_dim" )
# Submit the fetch query and disconnect
data <- dbGetQuery(mydb, query)
dbDisconnect(mydb)
data
}
my_autocomplete_list <- c(loadPubIds())
ui <- fluidPage(
select2Input("txt","",choices = NULL,selected = NULL),
textInput(inputId ="publisherId", label="choose publisherId", value = "", width = NULL, placeholder = NULL),
actionButton("goButton", "Go!"),
dataTableOutput('mytable')
#textOutput('myquery')
)
server <- function(input, output,session) {
test <- reactive({
pubs <- loadPubIds()
})
observe({
pubs <- loadPubIds()
updateSelect2Input(session, 'txt', choices = as.list(pubs), label = "")
})
output$mytable <- renderDataTable({
if (input$goButton == 0)
return()
isolate({ loadData(input$publisherId) })
})
}
shinyApp(ui = ui, server = server)
Any help would be great.