Passing argument to a function in shiny R - r

I'm trying to pass the node value of a simple network as an argument to a function in Shiny R. However, I'm getting this error:
Error in rsqlite_send_query: no such column: input$id
Can anyone help with this issue? Thanks.
library(shiny)
library(networkD3)
ui <- shinyUI(fluidPage(
fluidRow(
column(4, simpleNetworkOutput("simple")),
column(4, DT::dataTableOutput("table"))
)
))
server <- shinyServer(function(input, output, session) {
session$onSessionEnded(stopApp)
output$simple <- renderSimpleNetwork({
sn<-simpleNetwork(df)
sn$x$options$clickAction = 'Shiny.onInputChange("id",d.name)'
sn
})
output$table <- DT::renderDataTable(DT::datatable(get(funct(input$id))))
})
shinyApp(ui = ui, server = server)

take out the deparse and substitute from your sprintf command, and add single quotes around the value you want to match in the SQL statement you're generating
get rid of the get function because you're not trying to "get" an object
for example....
library(shiny)
library(networkD3)
library(DT)
library(sqldf)
df <- read.csv(header = T, text = '
source,name,age,hair
dad,Jon X,18,brown
dad,Jon Y,22,blonde
')
funct <-
function (n) {
isp <- sprintf("Select df.age From df Where df.name='%s';", n)
isd <- sqldf::sqldf(isp)
return(isd)
}
ui <- shinyUI(fluidPage(
fluidRow(
column(4, simpleNetworkOutput("simple")),
column(4, DT::dataTableOutput("table"))
)
))
server <- shinyServer(function(input, output, session) {
session$onSessionEnded(stopApp)
output$simple <- renderSimpleNetwork({
sn<-simpleNetwork(df)
sn$x$options$clickAction = 'Shiny.onInputChange("id",d.name)'
sn
})
output$table <- DT::renderDataTable(DT::datatable(funct(input$id)))
})
shinyApp(ui = ui, server = server)
however, if all you want is to display a value associated with a given selection, I highly suggest drastically reducing the complexity to something like this
library(shiny)
library(networkD3)
df <- read.csv(header = T, text = '
source,name,age,hair
dad,Jon X,18,brown
dad,Jon Y,22,blonde
')
ui <- shinyUI(fluidPage(
fluidRow(
column(4, simpleNetworkOutput("simple")),
column(4, textOutput("text"))
)
))
server <- shinyServer(function(input, output, session) {
session$onSessionEnded(stopApp)
output$simple <- renderSimpleNetwork({
sn <- simpleNetwork(df)
sn$x$options$clickAction <- 'Shiny.onInputChange("id", d.name)'
sn
})
output$text <- renderPrint({ df$age[df$name == input$id] })
})
shinyApp(ui = ui, server = server)

Related

updating table in Shiny

I've got a table that will initialize, but will not update. I use a few inputs, which then get called by a function to calculate the outputs. They will initialize with the correct values, but when I click the actionButton, nothing happens.
output$view<-renderTable({
tabSvol<-isolate(
data.frame(
S=c(
func1(input$in1),
func2(input$in2),
func3(input$in1,input$2)
)
)
)
tabSvol
})
Here's a MRE that allows you to add rows to a reactive table.
library(shiny)
library(tidyverse)
ui <- fluidPage(
numericInput("a", "A: ", value=NA),
selectInput("b", "B:", choices=c("X", "Y", "Z")),
actionButton("add", "Add row"),
tableOutput("table")
)
server <- function(input, output) {
rv <- reactiveValues(table=tibble(A=numeric(0), B=character(0)))
output$table <- renderTable({
rv$table
})
observeEvent(input$add, {
rv$table <- rv$table %>% add_row(A=input$a, B=input$b)
})
}
shinyApp(ui = ui, server = server)

Get R object in Shiny

Is it possible to get some R object used in Shiny?
For example, in the following code, I want to get text string inputted by users.
However, the .Last.value dose not the desired text string.
ref
How to store the returned value from a Shiny module in reactiveValues?
Ex code
returnUI = function(id) {
ns <- NS(id)
tagList(
textInput(ns("txt"), "Write something")
)
}
returnServer = function(input, output, session) {
myreturn <- reactiveValues()
observe({ myreturn$txt <- input$txt })
return(myreturn)
}
library(shiny)
source("modules/module_1.R")
ui <- fluidPage(
returnUI("returntxt"),
textOutput("mytxt")
)
server <- function(input, output, session) {
myvals <- reactiveValues(
txt = NULL
)
mytxt <- callModule(returnServer, "returntxt")
observe({
myvals$txt <- mytxt$txt
print(myvals$txt)
})
output$mytxt <- renderText({ myvals$txt })
}
shinyApp(ui, server)
.Last.value
Yes, you can push variables to the global environment (your usual workspace) from a Shiny app running in your console:
library(shiny)
ui <- fluidPage(
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
mainPanel(NULL)
)
)
server <- function(input, output) {
observe({
my_global_env <- globalenv()
my_global_env$x <- input$bins
})
}
shinyApp(ui = ui, server = server)

shinymeta: how to use expandChain in modules?

I'm making an app with modules in which the user can create as many UI as he wants. Each UI contain one table and I would like to give the possibility to the user to see the code for each of this table separately, not in a unique chunk. Therefore, I included the part of the code with expandChain in my module (module_server).
However, expandChain won't detect the reactive stuff I'm calling because the name of this stuff changes since it is created in a module. Take a look at the app below:
library(dplyr)
library(shiny)
library(shinymeta)
library(WDI)
module_ui <- function(id){
ns <- NS(id)
tagList(
fluidRow(
actionButton(ns("show_table"), "Show table"),
actionButton(ns("show_code"), "Show code"),
tableOutput(ns("table"))
)
)
}
module_server <- function(input, output, session){
data <- metaReactive2({
req(input$show_table)
isolate(metaExpr({
mtcars
}))
})
output$table <- renderTable({
data()
})
observeEvent(input$show_code, {
showModal(modalDialog(
renderPrint({
expandChain(data())
})
))
})
}
ui <- fluidPage(
actionButton("launch", "Launch")
)
server <- function(input, output, session) {
count <- reactiveValues(value = 0)
observeEvent(input$launch, {
count$value <- count$value + 1
insertUI(selector = "#launch",
where = "afterEnd",
ui = module_ui(count$value))
callModule(module_server, count$value)
})
}
shinyApp(ui, server)
When I try to show the code for the table generated, I have the error:
Warning: Error in : <text>:2:2: unexpected input
1: `1_data` <- mtcars
2: 1_
^
133: <Anonymous>
Since the module renames data() by adding a number, data() is not recognized by expandChain. I tried with:
expandChain(paste0(id, "_data()"))
without success (since expandChain does not support character).
Does anybody know how to do it?
Also asked on RStudio Community
Here's the solution given on RStudio Community (see the link for some additional details):
library(dplyr)
library(shiny)
library(shinymeta)
library(WDI)
module_ui <- function(id){
ns <- NS(id)
tagList(
fluidRow(
actionButton(ns("show_table"), "Show table"),
actionButton(ns("show_code"), "Show code"),
tableOutput(ns("table"))
)
)
}
module_server <- function(input, output, session){
data <- metaReactive2({
req(input$show_table)
isolate(metaExpr({
mtcars
}))
})
output$table <- renderTable({
data()
})
observeEvent(input$show_code, {
showModal(modalDialog(
renderPrint({
expandChain(data())
})
))
})
}
ui <- fluidPage(
actionButton("launch", "Launch")
)
server <- function(input, output, session) {
count <- reactiveValues(value = 0)
observeEvent(input$launch, {
count$value <- count$value + 1
insertUI(selector = "#launch",
where = "afterEnd",
ui = module_ui(paste0("x", count$value)))
callModule(module_server, paste0("x", count$value))
})
}
shinyApp(ui, server)

Get selected row value instead of number in shiny using DT

Small question here: I know I can access selected rows by input$dfname_rows_selected it gives back the numbers of rows selected, but how do I read the rows names, not numbers? In my case they are generated not in the order I use them later, therefore I need to get the values inside to make it work.
edit: added example
ui <- shinyUI(fluidPage(
DT::dataTableOutput("table"),
actionButton("btn", "press me")
))
server <- function(input, output) {
observeEvent(input$btn, {
print(input$table_rows_selected)
})
output$table <- DT::renderDataTable({
mtcars %>%
datatable(selection = "multiple")
})
}
shinyApp(ui = ui, server = server)
Something like this:
library(shiny)
library(DT)
ui <- basicPage(
mainPanel(DT::dataTableOutput('mytable')),
textOutput("selected")
)
server <- function(input, output,session) {
mydata <- reactive({mtcars})
output$mytable = DT::renderDataTable(
datatable(mydata())
)
selectedRow <- eventReactive(input$mytable_rows_selected,{
row.names(mtcars)[c(input$mytable_rows_selected)]
})
output$selected <- renderText({
selectedRow()
})
}
runApp(list(ui = ui, server = server))
I don't think you can. What you could do is write a reactive, where all modifications to your dataframe take place, before creating the datatable. An example:
library(shiny)
library(DT)
ui <- shinyUI(fluidPage(
DT::dataTableOutput("table"),
textOutput("selectedcar")
)
)
server <- function(input, output,session) {
# the reactive where we filter/sort/modify the data
reactive_df <- reactive({
mtcars[order(mtcars$cyl),]
})
# This datatable uses the reactive directly, so no more modifications
output$table <- DT::renderDataTable({
DT::datatable(reactive_df())
})
# now we can get the row/rowname as follows:
output$selectedcar <- renderText({
paste0(rownames(reactive_df())[input$table_rows_selected], collapse = ", ")
})
}
shinyApp(ui, server)
Hope this helps!

Shiny R: how to evaluate data set name to print the dataset

I want to print data set values in R shiny web app. But below code is printing the name of dataset in UI output. How can I print values of dataset?
library(MASS)
library(shinythemes)
library(shiny)
library(ggplot2)
mass.tmp <- data(package = "MASS")[3]
mass.datasets <- as.vector(mass.tmp$results[,3])
ui <- fluidPage(
theme = shinytheme("superhero"),
titlePanel("Linear Regression Modelling"),
sidebarLayout(
sidebarPanel(
selectInput("dsname", "Dataset:",choices = c(mass.datasets))
,
uiOutput("x_axis")
,
tableOutput("tab")
),
mainPanel(
tags$br(),
tags$br()
)
)
)
server <- function(input, output) {
num_ds <- function(ds)
{
nums <- sapply(ds,is.numeric)
num_ds <- ds[,nums]
return(num_ds)
}
ds_ext <- reactive({ num_ds(input$dsname) })
output$tab <- renderTable({ eval(input$dsname) })
# output$x_axis <- renderUI({
# col_opts <- get(ds_ext())
# selectInput("x_axis2", "Independent Variable:", choices = names(col_opts))
# })
}
shinyApp(ui = ui, server = server)
This is full code. I am trying to display data set from MASS package as you see in the code above.

Resources