I want save the data by user input.
And I'll use a sprintf with it.
below is my code.
ui.r
selectInput(
"ModelCB", 'Model', choices=NULL, selected = NULL, multiple = FALSE
)
server.r
shinyServer(function(input, output, session)
{
output$SelectModel <- renderText({
paste("You have selected", input$ModelCB)
GetModel <- input$ModelCB
})
TargetModelQuery <- sprintf("SELECT tb_result.mid
FROM tb_result
WHERE name='%s' and result='F'", GetModel)
})
I can not use a GetModel.
TargetModelQuery has error.
How can I use a GetModel?
You need to make the TargetModelQuery reactive, something like,
TargetModelQuery <- reactive({
sprintf("SELECT tb_result.mid
FROM tb_result
WHERE name='%s' and result='F'", input$ModelCB)
})
and access the string by calling TargetModelQuery().
Full example
library(shiny)
shinyApp(
shinyUI(
fluidPage(
selectInput(
"ModelCB", 'Model', choices=c("a","b","c"), selected = NULL, multiple = FALSE
),
textOutput("printStr")
)
),
shinyServer(function(input, output, session) {
TargetModelQuery <- reactive({
sprintf("SELECT tb_result.mid
FROM tb_result
WHERE name='%s' and result='F'", input$ModelCB)
})
output$printStr <- renderText({
TargetModelQuery()
})
})
)
Related
I have an app where the user needs to assign randomly generated elements (in this case, letters) to groups, but gets to decide how many groups to use. Because the selectInput where memberships are defined is generated dynamically in response to a number specified by the user, naming the menu is done automatically (e.g., usergroup1, usergroup2, etc.). I am having trouble accessing the input values and returning them from the module to use later because I won't know in advance how many inputs there will be, and hence how many usergroups to call. Here is an example app:
UI module:
library(shiny)
library(stringr)
mod1UI <- function(id) {
ns <- NS(id)
tagList(
numericInput(ns("n"), "N",value = NULL),
actionButton(ns("draw"),"Generate Letters"),
hr(),
numericInput(ns("groups"), "Enter number of groups (1-3)", value=NULL),
uiOutput(ns("groupings"))
)
}
What I tried to do here is make a list of usergroup names and return those, but the values aren't attached, and nothing comes through.
Server module:
mod1 <- function(input, output, session, data) {
ns <- session$ns
x <- reactiveValues(data=NULL)
observeEvent(input$draw, {
req(input$n)
x$data <- sample(letters,input$n)
})
output$groupings <- renderUI({
req(input$groups)
ltrs <- data()
lapply(1:input$groups, function(i) {
selectizeInput(paste0(session$ns("usergroup"),i),
paste0("Select letters for Group ", i),
choices=ltrs,
options = list(placeholder = "Select letters for this group",
onInitialize = I('function() { this.setValue(""); }')), multiple=T)
})
})
gps <- reactiveValues(gps=NULL)
reactive({
gps$gps <- lapply(1:input$groups, function(i) { paste0(session$ns("usergroup"),i) })
})
return(list(dat = reactive({x$data}),
groups = reactive({gps$gps})
))
}
UI:
ui <- navbarPage("Fancy Title",id = "tabs",
tabPanel("Panel1",
sidebarPanel(
mod1UI("input1")
),
mainPanel(verbatimTextOutput("lettersy")
)
)
)
Server:
server <- function(input, output, session) {
y <- callModule(mod1, "input1", data=y$dat)
output$lettersy <- renderText({
as.character(c(y$dat(), y$groups(), "end"))
})
}
shinyApp(ui, server)
Any help is greatly appreciated!
This solution mimics a couple others found on SO, namely this one.
The key is to create a reactiveValues object and then assign the values using [[i]]. In my case it helped to use a submit button to trigger that.
Complete, working code is as follows:
UI module:
library(shiny)
mod1UI <- function(id) {
ns <- NS(id)
tagList(
numericInput(ns("n"), "N",value = NULL),
actionButton(ns("draw"),"Generate Letters"),
hr(),
numericInput(ns("groups"), "Enter number of groups (1-3)", value=NULL),
uiOutput(ns("groupings")),
actionButton(ns("submit"), "Submit Groupings")
)
}
Server Module:
mod1 <- function(input, output, session, data) {
ns <- session$ns
x <- reactiveValues(data=NULL)
observeEvent(input$draw, {
req(input$n)
x$data <- sample(letters,input$n)
})
output$groupings <- renderUI({
req(input$groups)
ltrs <- data()
lapply(1:input$groups, function(i) {
selectizeInput(paste0(session$ns("usergroup"),i),
paste0("Select letters for Group ", i),
choices = ltrs,
options = list(placeholder = "Select letters for this group",
onInitialize = I('function() { this.setValue(""); }')), multiple=T)
})
})
gps <- reactiveValues(x=NULL)
observeEvent(input$submit, {
lapply(1:input$groups, function(i) {
gps$x[[i]] <- input[[paste0("usergroup", i)]]
})
})
test <- session$ns("test")
return(list(dat = reactive({x$data}),
groups = reactive({gps$x})
))
}
UI:
ui <- navbarPage("Fancy Title",id = "tabs",
tabPanel("Panel1",
sidebarPanel(
mod1UI("input1")
),
mainPanel(verbatimTextOutput("lettersy")
)
)
)
Server:
server <- function(input, output, session) {
y <- callModule(mod1, "input1", data=y$dat)
output$lettersy <- renderText({
as.character(c(y$groups()))
})
}
shinyApp(ui, server)
I have a function Identify_IP() that returns a list of 1- dataframe
2-ggplot. I need to renderTable and renderPlot in ShinyApp. This shinyApp code renders only the dataframe. But I can't render the plot. Any help?
library(shiny)
source('InflectionP2.R', local = TRUE)
runApp(
list(
ui = fluidPage(
titlePanel("Upload your file"),
sidebarLayout(
sidebarPanel(
fileInput('file1', 'Choose xls file',
accept = c(".XLS")),
actionButton("btn", "Update Table"),
actionButton("btn1", "Display Plot"),
downloadButton('downloadData', 'Download')
),
mainPanel(
tableOutput('what'),
plotOutput('pl'))
)
)
,
server = function(input, output, session){
dataOP <- reactive({
inFile <- input$file1
if (is.null(input$file1))
return(NULL)
Identify_IP(read.table(inFile$datapath))
list(tble = df1, txt = inflection_points, plt = p )
})
observeEvent(input$btn, output$what <- renderTable({dataOP()$tble}))
observeEvent(input$btn1, output$pl <- renderPlot({
plot(dataOP()$plt)
}))
}
))
Using the following server worked for me:
server = function(input, output, session){
dataOP <- reactive({
inFile <- input$file1
if(is.null(input$file1)){
return(NULL)
}
#Identify_IP(read.table(inFile$datapath))
list(tble = c(1:20), txt = c(1:10), plt = rnorm(100))
})
observeEvent(input$btn,{
output$what <- renderTable({
dataOP()$tble
})
})
observeEvent(input$btn1,{
output$pl <- renderPlot({
plot(dataOP()$plt)
})
})
}
Note that I commented out your function Identify_IP and replaced the results with arbitrary values.
If this still doesn't work your problem probably is probably related to this function or with the values returned by the function, respectively.
This is a follow up from this question:
Acessing SQL database using shiny with reactive query
I am trying to build a data frame from data fetched from an SQL database using a shiny app. Currently i am able to query the database and return one set of data. Now I would like to save that data to a data frame and then add more data from subsequent queries. Here is my code:
UI
library(markdown)
shinyUI(fluidPage(
titlePanel("Generic grapher"),
sidebarLayout(
sidebarPanel(
numericInput("wafer", label = h3("Select wafer ID:"), value = NULL),
actionButton("do", "An action button")
),
mainPanel(
verbatimTextOutput("value"), verbatimTextOutput("que"), dataTableOutput(outputId="pos")
)
)
)
)
Server:
library(RMySQL)
library(DBI)
library(sqldf)
con = dbConnect(RMySQL::MySQL(), dbname="xx", username="pete", password="xx", host="xx", port=3306)
query <- function(...) dbGetQuery(con, ...)
wq = data.frame()
shinyServer(function(input, output){
d <- eventReactive(input$do, { input$wafer })
output$value <- renderPrint({ d() })
a <- reactive({ paste("Select id from wafer where wafer_id=",d(), sep="") })
output$que <- renderPrint({ a() })
wq <- reactive({ query( a() ) })
output$pos <- renderDataTable({ wq() })
})
Now I am trying to use the information from these two answers to store the data from each search I do in a data frame:
Add values to a reactive table in shiny
What's the difference between Reactive Value and Reactive Expression?
New Server:
library(RMySQL)
library(DBI)
library(sqldf)
con = dbConnect(RMySQL::MySQL(), dbname="xx", username="pete", password="xx", host="xx", port=3306)
query <- function(...) dbGetQuery(con, ...)
wq = data.frame()
shinyServer(function(input, output){
values <- reactiveValues()
values$df <- data.frame()
d <- eventReactive(input$do, { input$wafer })
output$value <- renderPrint({ d() })
a <- reactive({ paste("Select id from wafer where wafer_id=",d(), sep="") })
output$que <- renderPrint({ a() })
wq <- reactive({ query( a() ) })
values$df <- reactive({ rbind(values$df, wq() ) })
output$pos <- renderDataTable({ values$df })
})
However, when I do this the data table never renders within my app. I dont have an error message. Any ideas where Im going wrong? Any help appreciated!
I think changing
values$df <- reactive({ rbind(values$df, wq() ) })
in your new server.R to
observe({
values$df <- rbind(isolate(values$df), wq())
})
might fix your problem.
EDIT: Here's a working example using a local connection:
library(markdown)
library(RMySQL)
library(DBI)
library(sqldf)
con <- dbConnect(RSQLite::SQLite(), ":memory:")
dbWriteTable(con, "mtcars", mtcars)
query <- function(...) dbGetQuery(con, ...)
wq = data.frame()
ui <- shinyUI(fluidPage(
titlePanel("Generic grapher"),
sidebarLayout(
sidebarPanel(
numericInput("wafer", label = h3("Select number of cylinders:"),
value = NULL),
actionButton("do", "An action button")
),
mainPanel(
verbatimTextOutput("value"),
verbatimTextOutput("que"),
verbatimTextOutput("wq_print"),
dataTableOutput(outputId="pos")
)
)
)
)
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 mtcars WHERE cyl = ", d(), sep="") })
output$que <- renderPrint({ a() })
observe({
if (!is.null(d())) {
wq <- reactive({ query( a() ) })
output$wq_print <- renderPrint({ print(str(wq())) })
values$df <- rbind(isolate(values$df), wq())
}
})
output$pos <- renderDataTable({ values$df })
})
shinyApp(ui, server)
The relevant changes to your original code are the !is.null(d()) condition for handling the initial NULL value of d(), and using values$df <- rbind(isolate(values$df), wq()) inside an observer. Hope this helps with fixing your code!
I need to change the mydb(string) value based on input selected from sidebar.
ui.R
library(shiny)
shinyUI(fluidPage(
titlePanel("Shiny App"),
sidebarLayout(
sidebarPanel( selectInput("site",
label = "Choose a site for Analysis",
choices = c("abc", "def",
"ghi", "jkl"),
selected = "abc")
),
mainPanel(
textOutput("text"),
)
))
server.R
library(shiny)
library(ggplot2)
library(RMySQL)
shinyServer(function(input, output) {
if(input$site=="abc"){
mydb<-"testdb_abc"}
else if(input$site=="def"){
mydb<-"testdb_def"}
con <- dbConnect(MySQL(),dbname=mydb, user="root", host="127.0.0.1", password="root")
query <- function(...) dbGetQuery(con, ...)
output$text <- renderText({
paste("You have selected:",input$site)
})
})
In above server.R, I need to assign string value to mydb based on selected input. I get this error:
Error in .getReactiveEnvironment()$currentContext() :
Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)
How can I do that with reactive in shiny?
as previously mentioned you would have to have your if statements in the reactive expression or observe Below is the working example of the sample App. Here I used a reactive expression to check which database you have selected. you can then use the mydb() and put it into your query, like so (I think this should work):
con <- dbConnect(MySQL(),dbname=mydb(), user="root", host="127.0.0.1", password="root")
query <- function(...) dbGetQuery(con, ...)
A sample example is below
library(shiny)
library(ggplot2)
library(RMySQL)
ui =fluidPage(
titlePanel("Shiny App"),
sidebarPanel(selectInput("site",
label = "Choose a site for Analysis",
choices = c("abc", "def","ghi", "jkl"),selected = "abc")),
mainPanel(textOutput("text"),textOutput("db_select"))
)
server = (function(input, output) {
mydb <- reactive({
if(input$site == "abc")
{
test <- c("testdb_abc")
}
else if(input$site == "def")
{
test <- c("testdb_def")
}
})
output$text <- renderText({
paste("You have selected:",input$site)
})
query_output <- reactive({
con <- (dbConnect(MySQL(),dbname=mydb(), user="root", host="127.0.0.1", password="root"))
query <- function(...) dbGetQuery(con, ...)
})
output$db_select <- renderText({
paste("My Database is:",mydb())
})
})
runApp(list(ui = ui, server = server))
I user renderTable to show some data. However, sometimes the data table is empty, in which case I'd like to print "No data to show" or something similar. the default by renderTable is to show nothing for empty data. can this be changed? how?
You can use a condition into a renderUi to render either a message or a "tableOutput" (you can't render directly the table)
datas <- data.frame()
shiny::runApp(list(
ui = pageWithSidebar(
headerPanel("Example"),
sidebarPanel(
selectInput("dataset", "Dataset", choices = c("iris", "datas"))
),
mainPanel(
uiOutput("ui")
)
),
server = function(input, output, session) {
datasetInput <- reactive({
switch(input$dataset,
"iris" = iris,
"datas" = datas)
})
output$ui <- renderUI({
if(nrow(datasetInput()) == 0)
return("No data to show")
tableOutput("table")
})
output$table <- renderTable({
head(datasetInput())
})
}
))
I think you are looking for something like validate function.
Using example code provided by Julien:
datas <- data.frame()
shiny::runApp(list(
ui = pageWithSidebar(
headerPanel("Example"),
sidebarPanel(
selectInput("dataset", "Dataset", choices = c("iris", "datas"))
),
mainPanel(
tableOutput('table')
)
),
server = function(input, output, session) {
datasetInput <- reactive({
switch(input$dataset,
"iris" = iris,
"datas" = datas)
})
output$table <- renderTable({
y <- head(datasetInput())
validate(
need(nrow(y) > 0, "No Data to show")
)
y
})
}
))
If you still want to show a "table" within the UI, do this:
output$table_output <- renderTable {
data <- data.frame(a = c(1,2),
b = c(8,9)) #example data.frame
if (nrow(data) > 0) {
data
} else {
datatable(data.frame(Nachricht = "Die ausgewählte Schnittstelle enthält hierfür keine Daten."))
}
}