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.
Related
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.
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)
Trying to use selectInput in a form.
the choices are fetched from a collection in mongodB.
when user
completes the form and submits (which inserts to another collection
in mongo), data in selectInput is not captured.
tried to make it reactive or use observeEvent /updateSelectInput in the server but could not make it work.
here is the entire code:
library(shiny)
library(mongolite)
library(jsonlite)
# which fields get saved
fieldsAll <- c("Name", "selectOne", "tags")
saveData <- function(data) {
# Connect to the database
}
# load all responses into a data.frame
loadData <- function() {
# Connect to the database
}
fetchData <- function() {
# Connect to the database
}
shinyApp(
ui = tagList(
navbarPage(
tabPanel("Technology",
sidebarPanel(
textInput("Name",label ='Name:'),
selectInput('selectOne',
label ='Select One:',
choices=head(fetchData()),
selected = "",
multiple = FALSE),
selectizeInput("tags", "Tags:", NULL, multiple = TRUE, options=list(create=TRUE)),
actionButton("submit", "Submit", class = "btn-primary")
),
mainPanel(
tabsetPanel(
tabPanel("Table",
uiOutput("adminPanelContainer")
)
)
)
)
)
),
server = function(input, output, session) {
formData <- reactive({
fieldsAll
data <- sapply(fieldsAll, function(x) input[[x]])
data <- t(data)
data
})
observeEvent(input$submit, {
saveData(formData())
},
)
# render the admin panel
output$adminPanelContainer <- renderUI({
DT::dataTableOutput("responsesTable")
})
# Update the responses table whenever a new submission is made
responses_data <- reactive({
input$submit
data <- loadData()
data
})
# Show the responses in the admin table
output$responsesTable <- DT::renderDataTable({
DT::datatable(
responses_data(),
rownames = FALSE,
options = list(searching = TRUE, lengthChange = FALSE)
)
})
}
)
adding a column to the df with selected value worked:
formData <- reactive({
fieldsAll
data <- sapply(fieldsAll, function(x) input[[x]])
data <- c(data,selectOne= input$selectOne) #added line
data <- t(data)
data
})
I have a Shiny Application that uses a MongoDB (using mongolite). The application loads and saves to the database with no issues but I am trying to find a way to edit the MongoDB through a datatable(using DT) where when the user edits or deletes a row that they can press an actionbutton to update the mongoDB. When I try to run it currently I am getting
"Warning: Error in : argument must be bson or json."
Is there a way for me to edit from DT, convert it to the JSON Mongo is expecting from the Shiny app? Below is the code.
library(shiny)
library(DT)
library(mongolite)
ui <- fluidPage(
# Application title
titlePanel("MongoTest"),
# Sidebar
sidebarLayout(
sidebarPanel(
actionButton("submit", "Submit"),
actionButton("load","Load"),
actionButton("update","update"),
actionButton("deleteRows", "Delete Rows")
),
#Main UI
mainPanel(
fluidPage(
fluidRow(h2("Interactive Table", align="center")),
tags$hr(),
fluidRow(
DT::dataTableOutput("Interactive_Table")
)
)
)
)
)
server = function(input, output, session){
#Function that loads the information from the mongoDB
loadData <- function() {
# Connect to the database
db = mongo(collection = "collectionhere",db ="SET", url = "mongodb://localhost:27017")
# Read all the entries
data <- db$find()
return(data)
}
READ_IN_DATA=loadData()
values <- reactiveValues(dfWorking = READ_IN_DATA)
#Function that saves data to DB
saveData <- function(data) {
# Connect to the database
db = mongo(collection = "collectionhere",db ="SET", url = "mongodb://localhost:27017")
data <- as.data.frame(t(data))
db$insert(data)
}
updateData = function(data){
# Connect to the database
db = mongo(collection = "collectionhere",db ="SET", url = "mongodb://localhost:27017")
data <- as.data.frame(t(data))
#subjects$update('{}', '{"$set":{"has_age": false}}', multiple = TRUE)
db$update(data)
}
#Loading In the Data
observeEvent(input$load, {
loadData()
})
#Update the DB based off changes to the table
observeEvent(input$update, {
updated_df=as.data.frame(values$dfWorking)
updateData(t(updated_df))
})
#Deleting Rows
observeEvent(input$deleteRows,{
if (!is.null(input$Interactive_Table_rows_selected)) {
values$dfWorking <- values$dfWorking[-as.numeric(input$Interactive_Table_rows_selected),]
}
})
#DT Table
output$Interactive_Table = renderDataTable({
datatable(values$dfWorking,editable=TRUE
)
})
}
# Run the application
shinyApp(ui = ui, server = 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.
# })
})
)