Detecting arrow key (cursor key) in Shiny - shiny

I would like to link an action to the arrow/cursor keys in my Shiny app.
The action is already linked to pressing previous and next buttons. So I would like to add the eventExpr "cursor right" and "cursor left" to it, respectively. This is to plot one plot after another. Here is a simplified example with mtcars dataset.
datasets <- list(mtcars, iris, PlantGrowth)
ui <- fluidPage(
mainPanel(
titlePanel("Simplified example"),
tableOutput("cars"),
actionButton("prevBtn", icon = icon("arrow-left"), ""),
actionButton("nextBtn", icon = icon("arrow-right"), ""),
verbatimTextOutput("rows")
)
)
server <- function(input, output) {
output$cars <- renderTable({
head(dat())
})
dat <- reactive({
if (is.null(rv$nr)) {
d <- mtcars
}
else{
d <- datasets[[rv$nr]]
}
})
rv <- reactiveValues(nr = 1)
set_nr <- function(direction) {
rv$nr <- rv$nr + direction
}
observeEvent(input$nextBtn, { # here I would like add the sec. eventExpr.
set_nr(1)
})
observeEvent(input$prevBtn, { # here I would like add the sec. eventExpr.
set_nr(-1)
})
ro <- reactive({
nrow(dat())
})
output$rows <- renderPrint({
print(paste(as.character(ro()), "rows"))
})
vals <- reactiveValues(needThisForLater = reactive(30 * ro()))
}
shinyApp(ui = ui, server = server)```

You can attach a keydown event handler to the document:
datasets <- list(mtcars, iris, PlantGrowth)
js <- paste(
"$(document).on('keydown', function(event){",
" var key = event.which;",
" if(key === 37){",
" Shiny.setInputValue('arrowLeft', true, {priority: 'event'});",
" } else if(key === 39){",
" Shiny.setInputValue('arrowRight', true, {priority: 'event'});",
" }",
"});"
)
ui <- fluidPage(
tags$head(tags$script(HTML(js))),
mainPanel(
titlePanel("Simplified example"),
tableOutput("cars"),
actionButton("prevBtn", icon = icon("arrow-left"), ""),
actionButton("nextBtn", icon = icon("arrow-right"), ""),
verbatimTextOutput("rows")
)
)
server <- function(input, output) {
output$cars <- renderTable({
head(dat())
})
dat <- reactive({
if (is.null(rv$nr)) {
d <- mtcars
}
else{
d <- datasets[[rv$nr]]
}
})
rv <- reactiveValues(nr = 1)
set_nr <- function(direction) {
rv$nr <- rv$nr + direction
}
observeEvent(list(input$nextBtn, input$arrowRight), {
set_nr(1)
})
observeEvent(list(input$prevBtn, input$arrowLeft), {
set_nr(-1)
})
ro <- reactive({
nrow(dat())
})
output$rows <- renderPrint({
print(paste(as.character(ro()), "rows"))
})
vals <- reactiveValues(needThisForLater = reactive(30 * ro()))
}
shinyApp(ui = ui, server = server)

Related

R Shiny problem with inputs belonging to a bsCollapsePanel

In this shiny App (code below), tabPanel 'Scatter plot', note that the plot is correctly rendered only when the user expand the bsCollapsePanel 'Marker settings' for the first time. Before expanding the panel 'Marker settings' at first time, the message Error: argument is of length zero is shown. Can someone find out where the error is in the code?
library(shiny)
library(shinyBS)
library(tidyverse)
shinyApp(
ui = fluidPage(
tabsetPanel(
tabPanel("mtcars",
dataTableOutput("mtcarsDATA")),
tabPanel("Scatter plot",
sidebarPanel(
bsCollapse(id = "Side panel", open = "Variables",
bsCollapsePanel("Variables",
uiOutput("varx"),
uiOutput("vary"))
)
),
mainPanel(
bsCollapsePanel("Marker settings",
uiOutput("showMrk"),
uiOutput("shpMrk"),
uiOutput("forPorForma"),
uiOutput("forPorVar"),
uiOutput("mrkTrsp")),
plotOutput('SctPlot'))
)
)
),
server <- function(input, output) {
output$mtcarsDATA <- renderDataTable({
data <- mtcars
getModel <- reactive({
names(data) })
output$varx <- renderUI({
selectInput("varsel.x", HTML("Select var X<span style='color: red'>*</span>"),
choices = as.list(getModel()), multiple = F) })
getModelnum <- reactive({
filterNumeric <- data[sapply(data, is.numeric)]
names(filterNumeric) })
output$vary <- renderUI({
selectInput("varsel.y", HTML("Select var Y<span style='color: red'>*</span>(numerical only)"),
choices = as.list(getModelnum()), multiple = F) })
output$showMrk <- renderUI({
checkboxInput("show_Mrk", "Show marker", value=T) })
output$shpMrk <- renderUI({
conditionalPanel(condition = "input.show_Mrk == T",
radioButtons("shp_Mrk", "Format marker",
choices = c("by shape", "by variable"))) })
output$forPorForma <- renderUI({
conditionalPanel(condition = "input.shp_Mrk == 'by shape' & input.show_Mrk == T",
sliderInput("for_PorForma", 'Deslize para mudar o formato do marcador',
min = 1, max=25, value = 16)) })
output$mrkTrsp <- renderUI({
conditionalPanel(condition = "input.show_Mrk == T",
sliderInput("mrk_Trsp", 'Slide to change marker transparency',
min = 0, max=1, value = .5, step=.05)) })
getModelcat <- reactive({
filterCaracter <- data[sapply(data, is.character)]
names(filterCaracter) })
output$forPorVar <- renderUI({
conditionalPanel(condition = "input.show_Mrk == 1 & input.shp_Mrk == 'by variable'",
selectInput("forPorVar.sel", "Select var",
choices = as.list(getModelcat()), multiple = F)) })
output$SctPlot <- renderPlot({
if(input$show_Mrk == T){
if(input$shp_Mrk == "by shape") {
geomPoint <- geom_point(alpha=1-input$mrk_Trsp, shape=input$for_PorForma) } else {
geomPoint <- geom_point(alpha=1-input$mrk_Trsp, aes_string(shape=(input$forPorVar.sel))) }} else {
geomPoint <- geom_point(alpha=0) }
p <- data %>%
ggplot(aes_string(x=input$varsel.x, y=input$varsel.y)) +
geomPoint
p
})
data
})
}
)

Enable/disable selectInput based on value in another selectInput

In my shiny app, I need to disable selectInput Season and selectInput Mesh if the value selected for selectInput Species is "Kemps". Those same two selectInput objects should be enabled for any other species selection. I found some shinyjs code (https://towardsdatascience.com/heres-how-to-spice-up-your-shiny-app-84866ccb69dd) and adapted to my app but I am getting errors. I would appreciate any guidance. Thanks!
spp <- c("Atlantic Sturgeon","Green","Kemps")
seas <- c("Fall","Winter","Spring","Summer")
mus <- c("A","B","C","D","D1","D2","E")
meshes <- c("Large","Small")
ui <- fluidPage(
titlePanel(title=div(img(src="imgPS.png",height=75),"Protected Species Model")),
sidebarLayout(
sidebarPanel(
selectInput("species", "Protected Species", spp),
selectInput("Season", "Season", seas),
selectInput("MU", "Management Unit", mus),
selectInput("Mesh", "Mesh Size", meshes),
numericInput("trip", "n Trips", 1, min = 1),
actionButton("btnEstTakes","Estimate Takes")
),
mainPanel(
h2("Predicted Takes"),
textOutput("prediction_text")
)
)
)
server <- function(input, output, session) {
observeEvent(input$species, {
if(input$species == "Kemps"){
shinyjs::disable(id = "Season")
shinyjs::disable(id = "Mesh")
}
else {
shinyjs::enable(id = "Season")
shinyjs::enable(id = "Mesh")
}
predict_df <- eventReactive(input$btnEstTakes, {
# Validate the user input. I dont trust these people! :)
validate(need(input$species, "Please select a valid Species!"))
validate(need(input$Season, "Please select a Season!"))
validate(need(input$MU, "Please select a Management Unit!"))
validate(need(input$Mesh, "Please select a Mesh Size!"))
validate(need(input$trip > 0, "Enter a valid trip count!"))
validate(need(input$species != "Atlantic Sturgeon" | (input$MU != "D1" & input$MU != "D2"),
"Management Unit selection not valid for Atlantic Sturgeon"))
validate(need(input$species != "Green" | input$MU != "D",
"Management Unit selection not valid for Green"))
validate(need(input$species != "Kemps" | (input$MU != "D" & input$MU != "D1"),
"Management Unit selection not valid for Kemps"))
ITPYear <- c(2013,2014,2015,2016,2017,2018,2019,2020,2021)
Species <- input$species
Season <- input$Season
MU <- input$MU
Mesh <- input$Mesh
LogEffort <- log(input$trip)
# Create data set for Kemps
df1 <- cbind(MU,LogEffort)
df1 <- as.data.frame(df1)
df1$Species <- Species
df1$MU <- as.factor(df1$MU)
df1$LogEffort <- as.double(df1$LogEffort)
# Create data set for Atlantic Sturgeon and Green
df2 <- cbind(Season,MU,Mesh,LogEffort)
df2 <- as.data.frame(df2)
df2 <- df2[rep(1,9),]
df2 <- cbind(ITPYear,df2)
df2$Species <- Species
df2$ITPYear <- as.factor(df2$ITPYear)
df2$Season <- as.factor(df2$Season)
df2$MU <- as.factor(df2$MU)
df2$Mesh <- as.factor(df2$Mesh)
df2$LogEffort <- as.double(df2$LogEffort)
df3 <- df2
df4 <- cbind(Species,Season,MU,Mesh,LogEffort)
df4 <- as.data.frame(df4)
# Predict based on species selection
if(Species=="Kemps"){
df1$Prediction <- predict(mod.kemps,type="response", newdata=df1)
df1$Live <- round(df1$Prediction * (1-kemps.dead), 0)
df1$Dead <- round(df1$Prediction * (kemps.dead), 0)
} else if(Species=="Green") {
df2$Prediction <- predict(mod.green,type="response",newdata=df2)
pred.use <- mean(df2$Prediction)
df4$Live <- round(pred.use * (1-green.dead), 0)
df4$Dead <- round(pred.use * (green.dead), 0)
} else {
df3$Prediction <- predict(mod.astg,type="response",newdata=df3)
pred.use <- mean(df3$Prediction)
df4$Live <- round(pred.use * (1-astg.dead), 0)
df4$Dead <- round(pred.use * (astg.dead), 0)
}
df.pick <- cbind(Species,Season,MU,Mesh)
df.pick <- as.data.frame(df.pick)
if(Species=="Kemps"){
df.pick$Live <- df1$Live
df.pick$Dead <- df1$Dead
} else {
df.pick$Live <- df4$Live
df.pick$Dead <- df4$Dead
}
df.use <- df.pick[,c('Species','Live', 'Dead')]
return(df.use)
})
df <- reactive({
predict_df()
})
output$prediction_text <- renderText({
paste0("The model predicted ", df()$Live, " live ", df()$Species, " and ", df()$Dead, " dead ", " ", df()$Species, ".")
})
}
shinyApp(ui, server)
Your code works fine if you enable {shinyjs} at beginning of ui:
ui <- fluidPage(
shinyjs::useShinyjs(),
...
(also close with }) the observeEvent)
observeEvent(input$species, {
if(input$species == "Kemps"){
shinyjs::disable(id = "Season")
shinyjs::disable(id = "Mesh")
}
else {
shinyjs::enable(id = "Season")
shinyjs::enable(id = "Mesh")
}
})

How to use the Undo button in R shiny to undo earlier operations and recover them

I am working on a R shiny app that reads CSV and produces a dataTable. I am looking for a way to undo prior actions one by one whenever I clik the Undo button (like CTRL+ Z in Windows), however, the code below restores all previous actions once I press the Undo button.
Could someone please assist me in resolving this problem?
csv data
ID Type Range
21 A1 B1 100
22 C1 D1 200
23 E1 F1 300
app.R
library(shiny)
library(reshape2)
library(DT)
library(tibble)
###function for deleting the rows
splitColumn <- function(data, column_name) {
newColNames <- c("Unmerged_type1", "Unmerged_type2")
newCols <- colsplit(data[[column_name]], " ", newColNames)
after_merge <- cbind(data, newCols)
after_merge[[column_name]] <- NULL
after_merge
}
###_______________________________________________
### function for inserting a new column
fillvalues <- function(data, values, columName){
df_fill <- data
vec <- strsplit(values, ",")[[1]]
df_fill <- tibble::add_column(df_fill, newcolumn = vec, .after = columName)
df_fill
}
##function for removing the colum
removecolumn <- function(df, nameofthecolumn){
df[ , -which(names(df) %in% nameofthecolumn)]
}
### use a_splitme.csv for testing this program
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fileInput("file1", "Choose CSV File", accept = ".csv"),
checkboxInput("header", "Header", TRUE),
actionButton("Splitcolumn", "SplitColumn"),
uiOutput("selectUI"),
actionButton("deleteRows", "Delete Rows"),
textInput("textbox", label="Input the value to replace:"),
actionButton("replacevalues", label = 'Replace values'),
actionButton("removecolumn", "Remove Column"),
actionButton("Undo", 'Undo')
),
mainPanel(
DTOutput("table1")
)
)
)
server <- function(session, input, output) {
rv <- reactiveValues(data = NULL, orig=NULL)
observeEvent(input$file1, {
file <- input$file1
ext <- tools::file_ext(file$datapath)
req(file)
validate(need(ext == "csv", "Please upload a csv file"))
rv$orig <- read.csv(file$datapath, header = input$header)
rv$data <- rv$orig
})
output$selectUI<-renderUI({
req(rv$data)
selectInput(inputId='selectcolumn', label='select column', choices = names(rv$data))
})
observeEvent(input$Splitcolumn, {
rv$data <- splitColumn(rv$data, input$selectcolumn)
})
observeEvent(input$deleteRows,{
if (!is.null(input$table1_rows_selected)) {
rv$data <- rv$data[-as.numeric(input$table1_rows_selected),]
}
})
output$table1 <- renderDT({
rv$data
})
observeEvent(input$replacevalues, {
rv$data <- fillvalues(rv$data, input$textbox, input$selectcolumn)
})
observeEvent(input$removecolumn, {
rv$data <- removecolumn(rv$data,input$selectcolumn)
})
observeEvent(input$Undo, {
rv$data <- rv$orig
})
}
We can create a list to host every instance of the table to recover multiple undo's. Note that if the .csv is very big this approach will become inefficient very quick. We can mitigate this infefficiency by implementing a button that clears the undo list up to a point or implementing an append function that saves only the part modified of the table rather than the whole table.
Please, fill free to modify the answer or use it for another answer.
library(shiny)
library(reshape2)
library(DT)
library(tibble)
###function for deleting the rows
splitColumn <- function(data, column_name) {
newColNames <- c("Unmerged_type1", "Unmerged_type2")
newCols <- colsplit(data[[column_name]], " ", newColNames)
after_merge <- cbind(data, newCols)
after_merge[[column_name]] <- NULL
after_merge
}
###_______________________________________________
### function for inserting a new column
fillvalues <- function(data, values, columName){
df_fill <- data
vec <- strsplit(values, ",")[[1]]
tibble::add_column(df_fill, newcolumn = vec, .after = columName)
}
##function for removing the colum
removecolumn <- function(df, nameofthecolumn){
df[ , -which(names(df) %in% nameofthecolumn)]
}
# APP ---------------------------------------------------------------------
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fileInput("file1", "Choose CSV File", accept = ".csv"),
checkboxInput("header", "Header", TRUE),
actionButton("Splitcolumn", "SplitColumn"),
uiOutput("selectUI"),
actionButton("deleteRows", "Delete Rows"),
textInput("textbox", label = "Input the value to replace:"),
actionButton("replacevalues", label = 'Replace values'),
actionButton("removecolumn", "Remove Column"),
actionButton("Undo", 'Undo')
),
mainPanel(
DTOutput("table1")
)
)
)
server <- function(session, input, output) {
#added undo (a list) and counter to accumulate more than one undo
rv <- reactiveValues(data = NULL, orig=NULL, undo = list(), counter = 1)
# csv file ----------------------------------------------------------------
observeEvent(input$file1, {
file <- input$file1
ext <- tools::file_ext(file$datapath)
req(file)
validate(need(ext == "csv", "Please upload a csv file"))
rv$orig <- read.csv(file$datapath, header = input$header)
rv$data <- rv$orig
})
output$selectUI <- renderUI({
req(rv$data)
selectInput(inputId='selectcolumn', label='select column', choices = names(rv$data))
})
# rest of the app ---------------------------------------------------------
observeEvent(input$Splitcolumn, {
rv$undo[[rv$counter]] <- rv$data
rv$counter <- rv$counter + 1
rv$data <- splitColumn(rv$data, input$selectcolumn)
})
observeEvent(input$deleteRows,{
if (!is.null(input$table1_rows_selected)) {
rv$undo[[rv$counter]] <- rv$data
rv$counter <- rv$counter + 1
rv$data <- rv$data[-as.numeric(input$table1_rows_selected),]
}
})
output$table1 <- renderDT({
rv$data
})
observeEvent(input$replacevalues, {
rv$undo[[rv$counter]] <- rv$data
rv$counter <- rv$counter + 1
rv$data <- fillvalues(rv$data, input$textbox, input$selectcolumn)
})
observeEvent(input$removecolumn, {
rv$undo[[rv$counter]] <- rv$data
rv$counter <- rv$counter + 1
rv$data <- removecolumn(rv$data,input$selectcolumn)
})
observeEvent(input$Undo, {
if (rv$counter > 1) {
rv$data <- rv$undo[[rv$counter - 1]]
#index must be more than 1
rv$counter <- rv$counter - 1
}
})
}
shinyApp(ui, server)

avoid ObserveEvent from launching itself several times when the application is launched

I have a button that when you click on it, it displays a table and when you click on a line, it displays the line number in a verbatimTextOutput
I have a reactive variable o() that saves all the lines that have been selected and when no line is selected it displays "nothing".
When I launch the application it displays several times "nothing" I don't understand why.
How could I redo the code to avoid these multiple appearances when launching the application?
library(shiny)
ui <- fluidPage(
DT::dataTableOutput("table"),
verbatimTextOutput("output", placeholder = TRUE),
actionButton("updateTable", "Show data table")
)
server <- function(input, output) {
dt <- reactiveVal()
o <- reactiveVal()
val <- reactive(
tail(
as.character(dt()[input$table_rows_selected, 2]),
n=1)
)
val2 <- reactiveVal()
observeEvent(input$updateTable, {
# the datatable
dt(data.frame("a" = paste("a", 1:10), "b" = paste("b", 1:10)))
output$table <- DT::renderDataTable({
DT::datatable(dt(), selection = list(target = 'row'))
})
if(is.null(val())){ val2("nothing")}
})
observeEvent(val(), {
if(length(input$table_rows_selected) > 0){
val2(val())
o(c(o(), "\n", "You chose :", val2()))
} else{
val2("nothing")
o(c(o(), "\n", "You chose :", val2()))
}
output$output <- renderText({ o() })
})
}
shinyApp(ui = ui, server = server)
solution 1
library(shiny)
ui <- fluidPage(
DT::dataTableOutput("table"),
verbatimTextOutput("output", placeholder = TRUE),
actionButton("showTable", "Show data table")
)
server <- function(input, output) {
val <- reactiveVal()
o <- reactiveVal()
dt <- reactiveVal()
observe({
val(as.character(dt()[input$table_rows_selected, 2]))
})
observeEvent(input$showTable, {
dt(data.frame("a" = paste("a", 1:10), "b" = paste("b", 1:10)))
output$table <- DT::renderDataTable({
DT::datatable(dt(), selection = list(target = 'row'))
})
o(c(o(), "\n", "Display of the table"))
})
output$output <- renderText({
if(input$showTable)
{
if(!identical(val(), character(0))){
o(c( isolate(o()), "\n", "You chose: ", isolate(val())))
} else{
o(c( isolate(o()), "\n", "You chose: ", "nothing"))
}
o()
}
})
}
shinyApp(ui = ui, server = server)
Solution 2
library(shiny)
ui <- fluidPage(
DT::dataTableOutput("table"),
verbatimTextOutput("output", placeholder = TRUE),
actionButton("showTable", "Show data table")
)
server <- function(input, output) {
o <- reactiveVal()
dt <- reactiveVal()
observeEvent(input$showTable, {
dt(data.frame("a" = paste("a", 1:10), "b" = paste("b", 1:10)))
output$table <- DT::renderDataTable({
DT::datatable(dt(), selection = list(target = 'row'))
})
o(c(o(), "\n", "Display of the table"))
})
val <- reactive({
if(!is.null(input$table_rows_selected)){
tail(
as.character(dt()[input$table_rows_selected, 2]),
n = 1
)
} else{ "nothing" }
})
observeEvent(val(), {
if(input$showTable)
{
o(c(o(), "\n", "You chose: ", val()))
}
})
output$output <- renderText({ o() })
}
shinyApp(ui = ui, server = server)
Your approach is too complex. Here's a simplified way -
library(shiny)
ui <- fluidPage(
DT::dataTableOutput("table"),
verbatimTextOutput("output", placeholder = TRUE),
actionButton("updateTable", "Show data table")
)
server <- function(input, output) {
val <- reactiveVal()
dt <- eventReactive(input$updateTable, {
# the datatable
data.frame("a" = paste("a", 1:10), "b" = paste("b", 1:10))
})
output$table <- DT::renderDataTable({
DT::datatable(dt(), selection = list(target = 'row'))
})
observe({
val(c(isolate(val()), as.character(dt()[input$table_rows_selected, 2])))
})
output$output <- renderText({ paste0("\n You chose :", unique(val())) })
}
shinyApp(ui = ui, server = server)
It's due to your reactive values updating when the table is shown. The easiest solution is just remove adding "\n", "You chose :", val2() to your list and just have it as a default option for o().
See below for the code:
library(shiny)
ui <- fluidPage(
DT::dataTableOutput("table"),
verbatimTextOutput("output", placeholder = TRUE),
actionButton("updateTable", "Show data table")
)
server <- function(input, output) {
dt <- reactiveVal()
o <- reactiveVal()
val <- reactive(
tail(
as.character(dt()[input$table_rows_selected, 2]),
n=1)
)
val2 <- reactiveVal()
observeEvent(input$updateTable, {
# the datatable
dt(data.frame("a" = paste("a", 1:10), "b" = paste("b", 1:10)))
output$table <- DT::renderDataTable({
DT::datatable(dt(), selection = list(target = 'row'))
})
if(is.null(val())){ val2("nothing")}
})
observeEvent(val(), {
if(length(input$table_rows_selected) > 0){
val2(val())
o(c(o(), "\n", "You chose :", val2()))
} else{
val2("nothing")
o(c("\n", "You chose :", val2()))
}
output$output <- renderText({ o() })
})
}
shinyApp(ui = ui, server = server)
UPDATED
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
DT::dataTableOutput("table"),
verbatimTextOutput("output", placeholder = TRUE),
actionButton("updateTable", "Show data table")
)
server <- function(input, output) {
#Data table
dt <- data.frame("a" = paste("a", 1:10), "b" = paste("b", 1:10))
output$table <- DT::renderDataTable({
DT::datatable(dt, selection = list(target = 'row'))
})
shinyjs::hide("table")
#Button
observeEvent(input$updateTable, {
shinyjs::show("table")
shinyjs::show("output")
})
#Value Box
o <- reactiveVal()
val <- reactive({
tail(
as.character(dt[input$table_rows_selected, 2]),
n = 1
)
})
observeEvent(val(), {
if(length(input$table_rows_selected) > 0){
o(c(o(), "\n", "You chose :", val()))
} else{
req(o())
o(c(o(), "\n", "You chose : nothing"))
}
})
output$output <- renderText({ o() })
shinyjs::hide("output")
}
shinyApp(ui = ui, server = server)

Shiny failed to connect to ODBC

I am trying to have Shiny connects to Teradata.
Below is the code I have but I always get "ERROR: [on_request_read] connection reset by peer" after I choose the indicator and click the action button. Appreciated any input for this. Thanks.
ui <- shinyUI(fluidPage(
titlePanel("Generic grapher"),
sidebarLayout(
sidebarPanel(
numericInput("wafer", label = h3("Select Indicator:"),
value = NULL),
actionButton("do", "An action button")
),
mainPanel(
verbatimTextOutput("value"),
verbatimTextOutput("que"),
verbatimTextOutput("wq_print"),
dataTableOutput(outputId="pos")
)
)
)
)
library(markdown)
library(RODBC)
library(DBI)
library(sqldf)
ch<-odbcConnect("xxx", uid=" ",pwd=" ")
wq = data.frame()
server <- shinyServer(function(input, output){
values <- reactiveValues()
values$df <- data.frame()
d <- eventReactive(input$do, { input$wafer })
output$value <- renderPrint({ d() })
a <- reactive({ paste("SELECT * FROM dwname.tablename WHERE indicator_x = ", d(), sep="") })
output$que <- renderPrint({ a() })
observe({
if (!is.null(d())) {
wq <- reactive({ sqlQuery( a() ) })
output$wq_print <- renderPrint({ print(str(wq())) })
values$df <- rbind(isolate(values$df), wq())
}
})
output$pos <- renderDataTable({ values$df })
})
shinyApp(ui, server)