I'd like to ask the user for a number in the Input and use it in several outputs, as well as in independent chunks on a HTML-Markdown. This would mean that I'd like use for example:
ui <- fluidPage(
# "Number of Simulations"
numericInput(inputId = "n",label = "Number of Simulations",
value = 100000,min = 1,max = 200000)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
}
# Run the application
shinyApp(ui = ui, server = server)
And then use input$n outside the ShinyApp. Is there any way? Maybe a way I was trying to figure is this one:
ui <- fluidPage(
# "Number of Simulations"
numericInput(inputId = "n",label = "Number of Simulations",
value = 100000,min = 1,max = 200000)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
reactive({
setwd("C:/Users/alarc/OneDrive/Escritorio/Experimento")
save(input$n,file = "brl.RData")
})
}
# Run the application
shinyApp(ui = ui, server = server)
But it doesn't work. It's like the shiny app couldn't read the save function.
Related
I would like to print all levels of a factor in a shiny dashboard. I know I could easily do that by:
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Testing shiny App"),
# Show a plot of the generated distribution
mainPanel(
htmlOutput("my_levels_list")
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$my_levels_list <- renderUI({
HTML(levels(iris$Species))
})
}
# Run the application
shinyApp(ui = ui, server = server)
But all the results are outputed within the same row:
<div id="my_levels_list" class="shiny-html-output shiny-bound-output">setosa versicolor virginica</div>
What I would like to have is something like this instead:
<div id="my_levels_list" class="shiny-html-output shiny-bound-output">
<ul><li>setosa</li> <li>versicolor</li> <li>virginica</li></ul></div>
I tried with more extravagant code like:
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Testing shiny App"),
# Show a plot of the generated distribution
mainPanel(
htmlOutput("my_levels_list")
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$my_levels_list <- renderUI({
for (i in iris$Species) {
HTML(i)
}
})
}
# Run the application
shinyApp(ui = ui, server = server)
But nothing is outputted.
Basically I'm trying to display a dataframe in R by querying it to MySQL.
I have two filters based on which the values of the dataframe/table will differ. The table is reactive based on the filters chosen by the user.
UI
ui <- fluidPage(fluidRow(
column(4,radioButtons("Stocks", "Stock Number",
choices = c(1: 2),selected='1')),
column(4,radioButtons("Funds", "Fund Name",
choices = list("W" = 1, "L" = 2),selected='1')),
column(4,checkboxGroupInput("Position", "Market Position",
choices = c(1:5))),
tableOutput("values")
)
SERVER
server <- function(input, output)
{
tableValues<-reactive({
df<-dbSendQuery(mydb,paste0("SELECT STOCKS,FUNDS,POSITION,INVESTMENTS FROM
SUMMARY WHERE USERNAME='1223' and STOCKS=",input$Stocks," AND
FUNDS='",input$Funds,"'
AND POSITION=",input$position,";"))
return(df)
})
output$values <- renderTable({
tableValues()})
}
This is what I have now but this doesn't seem to work. Any suggestions on how to display the dataframe/table and make it reactive based on the filters chosen?
Thanks!
Error: error- "cannot coerce class 'structure("MySQLResult", package = "RMySQL")' to a data.frame". That's because you've not fetched the data.
server <- function(input, output)
{
tableValues<-reactive({
query<-dbSendQuery(mydb,paste0("SELECT STOCKS,FUNDS,POSITION,INVESTMENTS FROM
SUMMARY WHERE USERNAME='1223' and STOCKS=",input$Stocks," AND
FUNDS='",input$Funds,"'
AND POSITION=",input$position,";"))
df = fetch(query, n = -1)
return(df)
})
output$values <- renderTable({
tableValues()})
}
https://www.rdocumentation.org/packages/DBI/versions/0.2-1/topics/dbSendQuery
I'm trying to create a checkbox for which the choices are plots created through ggplot. In the result, the UI looks like the HTML code itself instead of evaluating the HTML code to show the chart. Any ideas how I can get the checkboxGroupInput to show ggplots?
Sample code below -
runApp(shinyApp(
ui = fluidPage(
headerPanel("Plot check box"),
mainPanel(
uiOutput("plotscheckboxes")
)
),
server = function(input, output, session) {
output$plot1 = renderPlot({
ggplot(mtcars)+geom_point(aes(x=mpg,y=mpg))
})
output$plot2 = renderPlot({
ggplot(mtcars)+geom_point(aes(x=mpg,y=mpg))
})
output$plotscheckboxes = renderUI({
plotlist = list(
plotOutput('plot1'),
plotOutput('plot2')
)
plotlist2 = do.call(tagList, plotlist)
# this just produces a list with 1,2, some sort of underlying value for the checkboxGroup
finaloptionlist = lapply(
seq(length(plotlist2)),
function(x) x
)
# the names of the list are what get used in the options so setting the names accordingly as the HTML code of the ggplot rendering
names(finaloptionlist) = sapply(plotlist2, function(x) paste(x, collapse = "\n"))
checkboxGroupInput("checkGroup", label = h3("Checkbox group"),
choices = finaloptionlist,
selected = 1)
})
}
))
[EDIT]: solution by agstudy worked for me.
I have a shiny app that allows users to toggle between three tables in a MySQL database. Users can select a table which is used by renderTable to generate the object.
I have put if statements in renderTable to respond to the users' selected table.
When I run the app, any table fails to print and cannot be viewed.
server.R
library(shiny)
library(RMySQL)
con <- dbConnect(RMySQL::MySQL(),user="x",password="x",host="dbhost",dbname="db")
shinyServer(function(input, output) {
data <- reactive({
selectInput("input$data", "Choose your Input:", choices = c('data1'='1','data2'='2', 'data3'='3'))
})
output$table <- renderTable({
if(input$data == data1){
query1 <- reactive({ "SELECT *
FROM data1
ORDER BY var1, var2"})
reactive({dbGetQuery(con,query1())})
head(data())
} else if(input$data == data2){
query1 <- reactive({ "SELECT *
FROM data2
ORDER BY var1, var2"})
reactive({dbGetQuery(con,query1())})
head(data())
} else if(input$data == data3){
query1 <- reactive({ "SELECT *
FROM data3
ORDER BY var1, var2"})
reactive({dbGetQuery(con,query1())})
head(data())
} else print("Select a dataset")
})
})
ui.R
library(shiny)
library('RMySQL')
shinyUI(navbarPage("Test",
tabPanel("Test",
sidebarLayout(
sidebarPanel(
selectInput("data", label = "Data set",
choices = c("", "data1", "data2", "data3"))
),
mainPanel(
tableOutput("table")
)
))
))
Your problem here is not in any case related to MySQLserver but there is a no UI logic. Programming in Shiny is not easy if you don't isolate your code parts:
inputs: defined in your ui interface
reactive functions : should change each time you change your input
outputs: be refreshed once the input data is changed by the reactive function.
You miss-understand the reactive.The basic idea is that your don't need to refresh your UI manually, it should be done automatically once the input parameter is changed.
Here I am rewriting completely your code using the Shiny logic:
library(RMySQL)
library(shiny)
## this a public function that will be used
## in the server side to connect to the data base
## and retrieve data
get_data <-
function(query){
on.exit(dbDisconnect(conn)) ## important to close connection
conn <- dbConnect("MySQL",user="xuser",
password="xpws",
host="xhost",
dbname="xdbname")
dbGetQuery(con,query)
}
server <- shinyServer(
function(input, output) {
## the reactive engine that will refresh query
## each time input changed
query <- reactive( sprintf("SELECT *
FROM %s
ORDER BY var1, var2",input$data)
)
## simply displaying reactive inputs
output$table <- renderTable(
if(input$data!="") get_data(query())
)
})
## define ui elements by step
## for easy indenting
ui_panel <-
tabPanel("Test",
sidebarLayout(
sidebarPanel(
selectInput("data", label = "Data set",
choices = c("","data1", "data2", "data3"))
),
mainPanel(
tableOutput("table")
)
)
)
ui <- shinyUI(navbarPage("Test",ui_panel))
runApp(list(ui=ui,server=server))
I want to select from a list read in from a Mysql query. I am getting an error in the code. I must be doing something just completely wrong, but not sure what.
I would like to select from a list of skus read in from a sql query. I get an error in the ui portion.
I am not even sure if this is possible, but to list out all skus would be extremely timely.
I am getting the following errors:
Error in tag("div", list(...)) :
argument "sidebarPanel" is missing, with no default
shinyApp(ui = ui, server = server)
Error in force(ui) : object 'ui' not found
library('RMySQL')
library('plyr')
library('shiny')
library('scales')
library(shinyapps)
library(ggplot2)
con <- dbConnect(MySQL(), user="user", password="password",dbname="DB", host="host");
rank<-dbGetQuery(con,"select sku from DB")
#build a shiny app to select which sku to pick
server <- function(input, output) {
output$distPlot <- renderPlot({
hist(rnorm(input$obs), col = 'darkgray', border = 'white')
})
}
ui <- pageWithSidebar(
## Application title
sidebarPanel(
sliderInput("obs", "Number of observations:", min = 10, max = 500, value = 100),
selectInput(
'e0', '0. An ordinary select input', choices = unique(rank$sku),
selectize = FALSE
),
mainPanel(plotOutput("distPlot"))
)
)
shinyApp(ui = ui, server = server)
You have both a missing bracket near your selectize = FALSE and (as #DavidRobinson has suggested) you need a headerPanel.
CODE FIX
library(shiny)
library(ggplot2)
# con <- dbConnect(MySQL(), user="user", password="password",dbname="DB", host="host");
# rank<-dbGetQuery(con,"select sku from DB")
# for test hard coding the rank as I dont have your data
# test rank
rank$sku <- c(1,2,3)
#build a shiny app to select which sku to pick
server <- function(input, output) {
output$distPlot <- renderPlot({
hist(rnorm(input$obs), col = 'darkgray', border = 'white')
})
}
ui <- pageWithSidebar(
## Application title
# missing headerPanel
headerPanel(title = "Hello"),
# missing bracket after selectize
sidebarPanel(
sliderInput("obs", "Number of observations:", min = 10, max = 500, value = 100),
selectInput(
'e0', '0. An ordinary select input', choices = unique(rank$sku),
selectize = FALSE)
),
mainPanel(plotOutput("distPlot"))
)
shinyApp(ui = ui, server = server)
RESULT
ANOTHER SHINY PAGE UI OPTION
You can can also use a tabbed page structure, replacing ui above with this code (note it does not require headerPanel like above):
# navbar tabbed page example - without headerPanel
ui2 <- navbarPage(title = "Hello Another Style",
tabPanel("Chart Panel",
sidebarLayout(
sidebarPanel(
sliderInput("obs", "Number of observations:",
min = 10, max = 500, value = 100),
selectInput(
'e0', '0. An ordinary select input',
choices = unique(rank$sku),
selectize = FALSE)
),
mainPanel(
plotOutput("distPlot")
)
)
),
tabPanel("Instructions",
mainPanel(
p("Notes here for example...")
)
)
)
SECOND RESULT
And then on second panel...
DEBUGGING ADVICE
These Shiny pages can have lots of brackets, so pace over your code selecting brackets in turn carefully in your editor like RStudio to make sure your brackets match okay.
All the best!