I have a shiny app which calls an external function based on user input. This function updates a data frame based on the input so it can be used to render a plot.
getData function()
getData= function(inpName)
{
// a piece of code based on inpName
}
shinyUI.R
library(shiny)
shinyUI(fluidPage(
titlePanel("title"),
sidebarLayout(
sidebarPanel(
textInput("name","Enter a name")),
mainPanel())
))
shinyServer.R
library(shiny)
shinyServer(function(input,output)
{
getData=reactive({getData(input$name) })
})
No matter what I try I just can't seem to get the shinyServer to call the function and update a df. Could someone advise what am doing wrong? Appreciate any help.
You don't want to be overwriting getData in the server function.
library(shiny)
getData <- function(inpName)
if (inpName %in% names(mtcars)) mtcars[,inpName] else NULL
shinyApp(
shinyUI(fluidPage(
titlePanel("title"),
sidebarLayout(
sidebarPanel(
textInput("name","Enter a name")),
mainPanel(
verbatimTextOutput('tab')
))
)),
shinyServer(function(input, output, session) {
## The first way
## dat <- reactive({ getData(input$name) })
## The other way
vals <- reactiveValues(dat=NULL)
observeEvent(input$name, vals$dat <- getData(input$name))
output$tab <- renderPrint({ summary(vals$dat) })
})
)
Related
I'm trying to make a dynamically generated navbar based on the session user id.
I have a data table that maps the session user to a list of that user's clients. I want the app to produce a navbar where each tabPanel is for each client that user has. I'm not sure how I can easily do that since navbarPage() doesn't take a list argument.
Below is my example
library(shiny)
data <- data.frame(user=c("emily", "emily"), clients=c("client1", "client2"))
CreateCustomNavbarContent <- function(data) {
l <- lapply(data$clients, function(client) {
tabPanel(client,
h2(client))
})
renderUI({
l
})
}
shinyApp(
ui <- fluidPage(
uiOutput("custom_navbar")
),
server <- function(input, output) {
output$custom_navbar <- renderUI({
## commented below doesn't work
# navbarPage(
# CreateCustomNavbarContent(data)
# )
navbarPage("",
tabPanel("client1",
h2("client1")
),
tabPanel("client2",
h2("client2")
)
)
})
}
)
You could achieve what you want with do.call, so we can pass a list of arguments as separate arguments. Below is a working example, I gave emily a companion called John so you can validate that the code does what you want ;)
Hope this helps!
library(shiny)
data <- data.frame(user=c("Emily", "Emily","John","John"), clients=c("client1", "client2","client3","client4"))
ui = fluidPage(
selectInput('select_user','Select user:',unique(data$user)),
uiOutput('mytabsetpanel')
)
server = function(input, output, session){
output$mytabsetpanel = renderUI({
myTabs = lapply(data$clients[data$user==input$select_user], tabPanel)
do.call(tabsetPanel, myTabs)
})
}
shinyApp(ui,server)
I have a shiny code like in the below. I need to define variables as reactiveValues to be updatable (or I could define them I think as global but then I have to press clean objects from Rstudio which is not very user-friendly).I try to run a validate code to check for existence of the data I have defined as reactiveValues. validate(need(exists("GSEmRNA$d"),message="Dataframe not found")) yields "Dataframe not found" thus, does not plot my boxplot. If I define them as global variables and forget to press clean objects, code might mix up as old data can be passed as if it is new. Any help is appreciated.
server.R
shinyServer(function(input, output) {
observeEvent(input$GoButton,{
dataset <- data.frame(first= c(1,5,9),second=c(8,5,13), third=c(10,3,17))
GSEmRNA <- reactiveValues(d=dataset)
})
output$BoxplotDataset <- renderPlot({
if (input$GoButton== 0) {return()}
else{
validate(need(exists("GSEmRNA$d"),message="Dataframe not found"))
boxplot(GSEmRNA$d)}
})
})
ui.R
library(shiny)
shinyUI(pageWithSidebar(
headerPanel("Dataset Selection"),
sidebarPanel(
actionButton("GoButton","GO")
),
mainPanel(
wellPanel(
column(8, plotOutput("BoxplotDataset")
)
)
)))
FOR THE RECORD, I ALSO POSTED THIS QUESTION TO SHINY GOOGLE DISCUSS GROUP https://groups.google.com/forum/#!topic/shiny-discuss/ZV5F6Yy-kFg
Here are the updated code. The points are:
library(shiny)
server <-shinyServer(function(input, output) {
GSEmRNA <- reactiveValues(d=NULL) #define it ouside
observeEvent(input$GoButton,{
dataset <- data.frame(first= c(1,5,9),second=c(8,5,13), third=c(10,3,17))
GSEmRNA$d <- dataset #assign it inside
})
output$BoxplotDataset <- renderPlot({
validate(need(GSEmRNA$d,"Dataframe not found")) # changed as well
boxplot(GSEmRNA$d)
})
})
ui <- pageWithSidebar(
headerPanel("Dataset Selection"),
sidebarPanel(
actionButton("GoButton","GO")
),
mainPanel(
wellPanel(
column(8, plotOutput("BoxplotDataset")
)
)
))
runApp(list(ui=ui,server=server))
Defined the reactiveValues outside of the observeEvent
Changed the reactiveValues inside of the observeEvent
Changed the validate and need.
I want to create a reactive data frame with a reactive column name in shiny. However this is throwing error. I have provided the code below.. The error is being caused by an () followed by =, but I cant find a way around. Any help will be appreciated
ui.R
library(shiny)
shinyUI(fluidPage(
titlePanel("Tool"),
sidebarLayout(
sidebarPanel(
textInput("Item","Enter Item Name"),
div(class='row-fluid',
div(class='span6', numericInput("sales1","Enter Sales",value=0),numericInput("sales2","Enter Sales",value=0)),
div(class='span6', numericInput("prices1","Enter price",value=0),numericInput("prices2","Enter price",value=0))
)),
mainPanel(
dataTableOutput("table")
)
)
))
server.R
library(shiny)
shinyServer(function(input, output) {
prices<-reactive({
c(input$prices1,input$prices2)
})
sales<-reactive({
c(input$sales1,input$sales2)
})
combined<-reactive({
data.frame(prices(),sales())
})
combined_final<-reactive({
mutate(combined(),Rev=prices()*sales())
})
namerev<-reactive({
as.character(paste("Rev",input$Item,sep="_"))
})
combined_final_rename<-reactive({
rename_(combined_final(),namerev() ="Rev")
})
output$table<-renderDataTable({
combined_final_rename()
})
})
If I understood the question correctly, you might need something like that:
combined_final_rename<-reactive({
d <- combined_final()
colnames(d)[colnames(d)=='Rev'] <- namerev()
d
})
Thanks in advance for your help. I understand how to manipulate dynamic inputs based off of other inputs for pre-defined datasets.
i.e. Load a car dataset. User selects Radio button to say they only want to look at blue cars. This changes the options in some Input Selector on the UI.
However, if I want to allow a user to upload a csv file, how do I dynamically update all of the relevant widgets.
i.e. User uploads their data, an Input Selector displays all variables in the dataset for plots and regressions.
The italicized part is my trouble.
ui.r
library(shiny)
# Define UI for application that draws a histogram
shinyUI(fluidPage(
titlePanel("My R Shiny App"),
sidebarPanel(
fileInput('file', 'Choose file to upload.'),
#Select Box: y
selectInput("y_input", label = h5("Select Time Series/Response Variable"),
choices = names(myData),
selected = NULL)
)
)
)
server.r
library(shiny)
#Run once when app is launched
#Load data
shinyServer(function(input, output) {
#Run once each time a user visits the app
#Put code to build a distinct set of reactive objects for user
output$Variable_Selector <- renderUI({
if(is.null(input$file))
return(NULL)
inFile <- input$file
myData <- read.csv(inFile$datapath)
if (is.null(myData))
return(NULL)
})
})
global.r
myData = NULL
Thanks!
Here's one solution using the functions observe and updateSelectInput - with some other minor modifications to your code. To demonstrate I made the following two csv files with different column names:
Df1 <- data.frame(
x=1:5,
y=2*(1:5),
z=3*(1:5))
##
Df2 <- data.frame(
a=6:10,
b=2*(6:10),
c=3*(6:10),
d=letters[1:5],
stringsAsFactors=F)
##
write.csv(Df1,file="~/tempfiles/Df1.csv",row.names=F)
##
write.csv(Df2,file="~/tempfiles/Df2.csv",row.names=F)
ui.R:
library(shiny)
shinyUI(fluidPage(
titlePanel("My R Shiny App"),
sidebarPanel(
fileInput(
'file',
'Choose file to upload.'
),
selectInput(
"y_input",
label = h5("Select Time Series/Response Variable"),
""
)
)
))
server.R:
library(shiny)
shinyServer(function(input, output, session) {
inFile <- reactive({
if (is.null(input$file)) {
return(NULL)
} else {
input$file
}
})
myData <- reactive({
if (is.null(inFile())) {
return(NULL)
} else {
read.csv(inFile()$datapath)
}
})
observe({
updateSelectInput(
session,
"y_input",
choices=names(myData()))
})
})
global.R:
myData <- NULL
And here are a couple of screenshots showing how the UI changes based on the uploaded file:
Shiny seems to only accept the final output of any provided to mainPanel in ui.R. An earlier SO question raised this but reached no satisfactory solution. The documentation for mainPanel suggests this should be possible:
Description: Create a main panel containing output elements
The following code illustrates:
server.R
library(shiny)
shinyServer(
function(input, output) {
plotInput <- reactive({
list(plot = plot(1:10),
txt = "My reactive title")
})
output$myplot <- renderPlot({ plotInput()$plot })
output$txt <- renderText({ plotInput()$txt })
}
)
ui.R
require(shiny)
pageWithSidebar(
headerPanel("Multiple outputs to mainPannel"),
sidebarPanel(),
mainPanel({
# only the last output works
h1(textOutput("txt"))
plotOutput("myplot")
p("see what I mean?")
})
)
Does anyone know if this is a bug, or how to work around it?
Try
mainPanel(
# only the last output works
h1(textOutput("txt")),
plotOutput("myplot"),
p("see what I mean?")
)