I would like to use a user defined function in Shiny to perform a simple calculation with output two variables. The function I wrote works when it is not part of a shiny app. However when part of a Shiny, the returned object (dfr) is ‘not in scope’. What am I missing?
library(shiny)
# Function ----------------------------------------------------------------
convert <- function(coef_1, coef_2, vec) {
part_1 <- coef_1/(2*sin((vec/2)*pi/180))
part_2 <- 2*(180/pi)*(asin(coef_2/(2*part_1)))
dfr <- data.frame(part_1, part_2)
return(dfr)
}
# End Function ------------------------------------------------------------
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
textInput("num", h3("Enter number to convert:"), value = NULL)
),
mainPanel(
verbatimTextOutput("text1", placeholder = TRUE),
verbatimTextOutput("text2", placeholder = TRUE)
)
)
)
server <- function(input, output) {
nums_str <- as.character(input$num)
nums_vector <- as.numeric(unlist(strsplit(nums_str, split = ",")))
convert(1.5, 1.1, nums_vector)
output$text1 <- renderText({
req(input$num)
dfr$part_1
})
output$text2 <- renderText({
req(input$num)
dfr$part_2
})
}
shinyApp(ui = ui, server = server)
When you use inputs, you need to do it in reactive environment, such as reactive(), renderDataTable(), etc.
Here, you need to run your function in a reactive() and then call it with dfr() in the outputs.
server <- function(input, output) {
dfr <- reactive({
convert(1.5, 1.1, as.numeric(input$num))
})
output$text1 <- renderText({
req(input$num)
dfr()$part_1
})
output$text2 <- renderText({
req(input$num)
dfr()$part_2
})
}
Since this is quite basic stuff with R Shiny, checking some tutorials might be very useful.
Related
I'm learning Shiny modules. And I'm stuck in a very silly thing: I don't know how to call an input inside moduleServer. In this reprex, the table does not show, I think its because the getInput argument is not properly used in the server. Here's a reprex:
library(shiny)
library(DT)
tablaResumen <- function(id, getInput, tabla1, tabla2) {
moduleServer(id, function(input, output, session) {
output$table <- renderDT({
if(getInput == FALSE){
tabla <- tabla1
}else{
tabla <- tabla2
}
DT::datatable(tabla, escape = FALSE, rownames = FALSE)
})
})
}
ui <- fluidPage(
checkboxInput("input1", label = "Change table"),
DTOutput("table1")
)
server <- function(input, output, session) {
tablaResumen("table1", input$input1, mtcars, iris)
}
shinyApp(ui, server)
library(shiny)
library(DT)
tablaResumen <- function(id, parent_in, get, tabla1, tabla2) {
moduleServer(id, function(input, output, session) {
output$mytable <- renderDT({
if(parent_in[[get]] == FALSE){
tabla <- tabla1
}else{
tabla <- tabla2
}
DT::datatable(tabla, escape = FALSE, rownames = FALSE)
})
})
}
tablaResumenUI <- function(id) {
ns <- NS(id)
DTOutput(ns("mytable"))
}
ui <- fluidPage(
checkboxInput("input1", label = "Change table"),
tablaResumenUI("table")
)
server <- function(input, output, session) {
tablaResumen("table", parent_in = input, "input1", mtcars, iris)
}
shinyApp(ui, server)
Things are a little tricky here.
To render the table, you must put the DTOutput under the same namespace as your mod server. The way we usually do it is by creating a mod UI function and use NS to wrap the id to create the namespace.
You module is depend on a reactive input value input$input1, but the server function itself is not reactive. This means if you provide it as an argument for the mod function, it will be run only one time, so getInput will never be changed after the app is initialized. It becomes a fixed value. To get the reactive value of input1, you need to provide the parent input as an argument as access from there.
I am trying to create a dashboard in rShiny which follow the following steps
Select a parameter
Filter data from a source table for this parameter
Create a list of this filtered data for one of the column
Iterate over this list to display graphs etc...
I have tried various options for making this work but the communication between ui and server is not happening as expected
I have created a setup as below fot testing
library(shiny)
df_mtcars <- mtcars
df_mtcars <- cbind(CarName = rownames(df_mtcars), df_mtcars)
df_mtcars$CarName <- sub(" ", "_", df_mtcars$CarName)
select the number of gears
Find the cars with that number of gears
Create a list of these cars
Display the data for each of the car by using loop. Loop is needed as other output types like graphs can be latter added
simpUI <- function(id) {
tagList(tableOutput(NS(id, "dat_output"))
numericInput(NS(id, "GearNumber"), "Gear Numbers", 3),
lapply(seq(1, length(v_lst_CarName), by = 1), function(i) {
v_CarName = v_lst_CarName[i]
v_obj_CarName = paste0('sp_cars_', v_CarName)
tableOutput(NS(id, v_obj_CarName))
}))
}
simpServer <- function(id) {
moduleServer(id, function(input, output, session) {
output$dat_output <- renderTable(df_mtcars)
v_lst_CarName <-
reactive(df_mtcars[GearNumber == input$GearNumber]$CarName)
for (v_CarName in v_lst_CarName)
v_obj_CarName = paste0('sp_cars_', v_CarName)
output$v_obj_CarName <- renderTable(v_obj_CarName)
})
}
ui <- fluidPage(fluidRow(simpUI("cars")))
server <- function(input, output, session) {
simpServer("cars")
}
shinyApp(ui = ui, server = server)
It is better to do server side processing. Try this
library(shiny)
library(ggplot2)
df_mtcars <- mtcars
df_mtcars <- cbind(CarName = rownames(df_mtcars), df_mtcars)
df_mtcars$CarName <- sub(" ", "_", df_mtcars$CarName)
simpUI <- function(id) {
ns <- NS(id)
tagList(tableOutput(ns("dat_output")),
numericInput(ns("GearNumber"), "Gear Numbers", 3),
uiOutput(ns("plotxy")),
tableOutput(ns("v_obj_CarName")),
verbatimTextOutput(ns("mylist")),
plotOutput(ns("myplot"))
)
}
simpServer <- function(id) {
moduleServer(id, function(input, output, session) {
ns <- session$ns
output$dat_output <- renderTable(head(df_mtcars))
mydf <- reactive(df_mtcars[df_mtcars$gear == input$GearNumber,])
v_lst_CarName <- eventReactive(mydf(), {paste0("sp_cars_",mydf()$CarName)})
output$plotxy <- renderUI({
req(mydf())
tagList(
selectInput(ns("xvar"), label = "X-axis variable", choices = names(mydf()), selected=names(mydf())[2] ),
selectInput(ns("yvar"), label = "Y-axis variable", choices = names(mydf()), selected=names(mydf())[5] )
)
})
output$v_obj_CarName <- renderTable({mydf()})
output$mylist <- renderPrint(list(v_lst_CarName() ))
output$myplot <- renderPlot({
req(input$xvar,input$yvar)
ggplot(mydf(),aes(x=.data[[input$xvar]], y=.data[[input$yvar]])) + geom_point()
})
})
}
ui <- fluidPage(fluidRow(simpUI("cars")))
server <- function(input, output, session) {
simpServer("cars")
}
shinyApp(ui = ui, server = server)
I want to use a reactive expression that can be updated in either of two ways. Below is a very simple example with either numeric input or a reset button to set the expression back to its original state (in practice the expression is more complex, so can't use reactive values). It seems that only the second definition of num is recognised, so in the example the numeric input is ignored).
What am I missing?
Many thanks!
ui <- fluidPage(
numericInput("number", "Input", 1),
actionButton("button", "Reset"),
textOutput("check")
)
server <- function(input, output){
num <- reactive({
input$number
})
num <- eventReactive(input$button, {
1
})
output$check <- renderText({
num()
})
}
shinyApp(ui, server)
Edit:
We can use observeEvent() with each input to update num().
library(shiny)
ui <- fluidPage(
numericInput("number", "Input", 1),
actionButton("button", "Reset"),
textOutput("check")
)
server <- function(input, output) {
num <- reactiveVal()
observeEvent(input$number, {
num(input$number)
})
observeEvent(input$button, {
num(1)
})
observeEvent(c(input$button, input$number), {
output$check <- renderText({
num()
})
})
}
shinyApp(ui, server)
I am trying now since days to get my Shiny App working so that when I move my mouse to certain points in the plot they are displayed in a table but unfortunately it is not working.
I am not sure what I am doing wrong, can you help me?
border <- table$A < 0.03
ui <- fluidPage(
mainPanel(
plotOutput("Plot",click="plot_click"),
tableOutput("HitSpots")
)
)
server <- function(input, output){
output$Plot <- renderPlot({
ggplot(table,aes(x=table$A, y=table$B), colour=border)) +
geom_point()
})
hit <- reactive({
nearPoints(table, input$plot_click)
})
output$HitSpots <- renderTable({
hit()
}
}
shinyApp(ui = ui, server = server)
There are some problems with your parentheses. But the main problem is that you do ggplot(table, aes(x=table$A, y=table$B)), and then nearpoints is looking for columns named table$A and table$B. Do ggplot(table, aes(x=A, y=B)) instead.
library(shiny)
library(ggplot2)
table <- data.frame(
A = c(1,2,3),
B = c(3,2,1)
)
ui <- fluidPage(
mainPanel(
plotOutput("Plot", click="plot_click"),
tableOutput("HitSpots")
)
)
server <- function(input, output){
output$Plot <- renderPlot({
ggplot(table, aes(x=A, y=B)) + geom_point()
})
hit <- reactive({ nearPoints(table, input$plot_click) })
output$HitSpots <- renderTable({
hit()
})
}
shinyApp(ui = ui, server = server)
I would like to add a checkbox (input$autorefresh) in my shiny application to control where my data input is auto updated (=reactive()) at every change, or whether it is only updated when a button (=input$refresh) is pushed. The idea is described in the following code, which I however didn't expect to work. I could use reactive() together with a conditional isolate(), but since I have many inputs, that is not very elegant. Any ideas?
if (input$autorefresh==TRUE){
dataInput <- reactive({
dosomething
})
} else {
dataInput <- eventReactive(input$refresh,{
dosomething
})
}
Are you looking for something like this?
library(shiny)
ui <- fluidPage(
checkboxInput("autorefresh","autorefresh", F),
actionButton("refresh","refresh"),
mainPanel(plotOutput("plot"))
)
autoInvalidate <- reactiveTimer(1000)
server <- function(input, output, session) {
data <- reactive({
input$refresh
data <- plot(rnorm(100),type="l",col="red")
if(input$autorefresh){
autoInvalidate()
return(data)
}
return(data)
})
output$plot <- renderPlot({
data()
})
}
runApp(shinyApp(ui = ui, server = server))