This is my code
library(shiny)
library(tidyverse)
mylist <- c(1,2,3) %>% as.list()
ui <- fluidPage(
plotOutput('chart_1'),
plotOutput('chart_2'),
plotOutput('chart_3')
)
server <- function(input, output, session) {
lapply(1:3, function(x){
output[[paste0("chart_", x)]] <-
renderPlot({ ggplot(gapminder::gapminder %>% filter(country == 'Chile'), aes(x = year, y = pop))+ geom_line()})
})
}
shinyApp(ui, server)
How can I achieve the same result using purrr::map function instead lapply?
I am doing something like this, but I have a error message:
mylist %>% map(~
output[[glue::glue("chart_{.x}")]] <-
renderPlot({ ggplot(gapminder::gapminder %>% filter(country == 'Chile'),
aes(x = year, y = pop))+ geom_line()})
)
Related
This is my code:
library(shiny)
library(gapminder)
ui <- fluidPage(
highchartOutput(outputId = 'chart_1'),
highchartOutput(outputId = 'chart_2'),
highchartOutput(outputId = 'chart_3')
)
server <- function(input, output, session) {
data <- gapminder::gapminder %>% filter(country == 'Chile')
function_chart <- function(x,z) {
output[[paste0('chart_', x)]] <- renderHighchart({
hchart(
data,
'column',
hcaes(x = year,
y = data[[z]]),
colorByPoint = TRUE
)
})
}
map2(1:3,c('pop','lifeExp','gdpPercap'),~ function_chart(x = .x, z = .y))
}
shinyApp(ui, server)
The error is in the function 'function_chart' probably when I call the argument z. The output should give me 3 highchart charts.
Any help?
Because hcaes is lazy evaluated, you need to inject the current value of "z" in there with !!. Try
server <- function(input, output, session) {
data <- gapminder::gapminder %>% filter(country == 'Chile')
function_chart <- function(x,z) {
output[[paste0('chart_', x)]] <- renderHighchart({
hchart(
data,
'column',
hcaes(x = year,
y = !!z),
colorByPoint = TRUE
)
})
}
map2(1:3,c('pop','lifeExp','gdpPercap'),~ function_chart(x = .x, z = .y))
}
This is my app code:
library(shiny)
library(tidyverse)
source('module.R')
ui <- fluidPage(
tabpanel_UI("mod1")
)
server <- function(input, output, session) {
tabpanel_Server("mod1")
}
shinyApp(ui, server)
This is my module file: 'module.R'
tabpanel_function <- function(x,n){
tabPanel(paste0("Panel",x),
plotOutput(paste0("chart_",n))
)
}
tabpanel_UI <- function(id) {
ns <- NS(id)
tagList(
tabsetPanel(id = ns("x"),
tabPanel("Panela"),
tabPanel("Panelb"),
tabPanel("Panelc")
)
)
}
tabpanel_Server <- function(id) {
moduleServer(
id,
function(input, output, session) {
1:4 %>% map(~ tabpanel_function(.x, n = .x) %>% appendTab("x", .))
output$chart_1 <- renderPlot({
ggplot(mtcars, aes(cyl,mpg)) + geom_line(color ='red')
})
output$chart_2 <- renderPlot({
ggplot(mtcars, aes(cyl,mpg)) + geom_line(color ='green')
})
output$chart_3 <- renderPlot({
ggplot(mtcars, aes(cyl,mpg)) + geom_line(color ='blue')
})
output$chart_4 <- renderPlot({
ggplot(mtcars, aes(cyl,mpg)) + geom_line(color ='yellow')
})
}
)
}
What am I missing here?
This is a question: In R/Shiny how to create others panels with purrr::map that I create but not considering Modules. Turns out that I will need to use modules and the charts are not been displayed. Any help?
You have to use the namespace
tabpanel_function <- function(id, x, n){
ns <- NS(id)
tabPanel(paste0("Panel", x),
plotOutput(ns(paste0("chart_", n)))
)
}
and:
1:4 %>% map(~ tabpanel_function(id, .x, n = .x) %>% appendTab("x", .))
You need to namespace your dynamic plotOutputs:
tabpanel_function <- function(x, n, ns){
tabPanel(paste0("Panel",x),
plotOutput(ns(paste0("chart_",n)))
)
}
## [....]
1:4 %>% map(~ tabpanel_function(.x, n = .x, session$ns) %>% appendTab("x", .))
I created a dynamic form using {gt} and {purrr} combined with a function that extracts the HTML of shiny::selectizeInput.
I need to ensure that inputs created dynamically with {purrr} are available for others operations.
How can I use shiny::req() for all inputs created dynamically?
# libraries
library(shiny)
library(magrittr)
# functions
selectizeInput_gt <- function(value, inputid, ...) {
as.character(shiny::selectizeInput(paste0(value, inputid),
...)) %>%
gt::html()
}
# datasets
number_tests <- 5
df <- data.frame("test_number" = 1:number_tests)
# UI
ui <- fluidPage(gt::gt_output(outputId = "table"))
# server
server <- function(input, output, session) {
output$table <- gt::render_gt({
req(df)
df %>%
tibble::rownames_to_column() %>%
dplyr::rowwise() %>%
dplyr::mutate(
rowname = as.numeric(rowname),
selectinput_column = purrr::map(
rowname,
.f = ~ selectizeInput_gt(
.x,
"_selectinput",
label = "",
choices = c("A", "B", "C")
)
)
) %>%
gt::gt()
})
}
# runApp
shinyApp(ui, server)
After a lot of fiddling, I figured out a way to use purrr::walk to pass the inputs to req(). To generate the inputs, I use purrr::map.
As a small example, I use the req() to prevent an error in a simple output that uses the values of the inputs.
# libraries
library(shiny)
library(magrittr)
# functions
selectizeInput_gt <- function(value, inputid, ...) {
as.character(shiny::selectizeInput(paste0(value, inputid),
...)) %>%
gt::html()
}
# datasets
number_tests <- 5
df <- data.frame("test_number" = 1:number_tests)
# UI
ui <- fluidPage(gt::gt_output(outputId = "table"),
textOutput("selections"))
# server
server <- function(input, output, session) {
output$table <- gt::render_gt({
req(df)
df %>%
tibble::rownames_to_column() %>%
dplyr::rowwise() %>%
dplyr::mutate(
rowname = as.numeric(rowname),
selectinput_column = purrr::map(
rowname,
.f = ~ selectizeInput_gt(
.x,
"_selectinput",
label = "",
choices = c("A", "B", "C")
)
)
) %>%
gt::gt()
})
output$selections <- renderText({
purrr::walk(purrr::map(paste0(df$test_number, "_selectinput"), ~input[[.]]), req)
paste(purrr::map_chr(paste0(df$test_number, "_selectinput"), ~input[[.]]))
})
}
# runApp
shinyApp(ui, server)
I have a dynamic condition where I need to create fluidrows dynamically
cname <- c("A","B")
lapply(cname, function(name){paste0("column(6,",paste0("plotlyOutput(","'",name,"'","))"))})
[[1]]
[1] "column(6,plotlyOutput('A'))"
[[2]]
[1] "column(6,plotlyOutput('B'))"
Expected output
I need to incorporate Fluidrows here created as the beginning
fluidRow(column(6,plotlyOutput("A")),
column(6,plotlyOutput("B")))
Perhaps you are looking for purrr::exec paired with !!! operator to splice a list as arguments.
Example app:
library(shiny)
library(plotly)
library(tidyverse)
cname <- c("A", "B")
plotly_outputs <- map(cname, ~ column(width = 6, plotlyOutput(outputId = .)))
library(shiny)
ui <- fluidPage(
exec("fluidPage", !!!plotly_outputs)
)
server <- function(input, output, session) {
walk(cname, ~ {
output[[.]] <<- renderPlotly({
plt <- mtcars %>% ggplot(aes(x = mpg, y = hp)) +
geom_point()
ggplotly(plt)
})
})
}
shinyApp(ui, server)
I am trying to get the suffix of an output$suffix name in R Shiny and incorporate it into the input$suffix_rows_selected function. The drilldown table is coming empty. Would someone have any idea of what am I doing wrong?
Function that I am trying to build:
f.drilldata <- function(base.summary, base.drilldown, suffix.output, group_var){
group = enquo(group_var)
base.summary = base.summary %>% mutate(var = !!group)
base.drilldown = base.drilldown %>% mutate(var = !!group)
#input = expr(!!glue("input${suffix.output}_rows_selected"))
input = paste0(suffix.output,'_rows_selected')
validate(need(length(input[[input]]) > 0, ''))
selected_rows <- base.summary[as.integer(input[[input]]), ]$var
base.drilldown[base.drilldown$var %in% selected_rows, ]
}
Error Example:
library("dplyr")
library("shiny")
library("DT")
tbl.summary <- group_by(iris, Species) %>% summarise(Count = n())
tbl.drilldown <- iris
ui <- fluidPage(
DTOutput("output.summary.name")
, DTOutput("output.drilldown.name"))
server <- function(input, output){
# display the data that is available to be drilled down
output$output.summary.name <- renderDT(tbl.summary)
# subset the records to the row that was clicked through f.drilldata function
drilldata <- reactive({ f.drilldata(tbl.summary, tbl.drilldown, 'output.summary.name', Species) })
# display the subsetted data
output$output.drilldown.name <- renderDT(drilldata())}
shinyApp(ui, server)
Example that works but out of the f.drilldata function
library("dplyr")
library("shiny")
library("DT")
tbl.summary <- group_by(iris, Species) %>% summarise(Count = n())
tbl.drilldown <- iris
ui <- fluidPage(
DTOutput("output.summary.name")
, DTOutput("output.drilldown.name"))
server <- function(input, output){
output$output.summary.name <- renderDT(tbl.summary)
drilldata <- reactive({ validate( need(length(input$output.summary.name_rows_selected) > 0, "Select rows to drill down!"))
selected_species <-
tbl.summary[as.integer(input$output.summary.name_rows_selected), ]$Species
tbl.drilldown[tbl.drilldown$Species %in% selected_species, ] })
output$output.drilldown.name <- renderDT(drilldata())}
shinyApp(ui, server)
I have found a simple solution by just adding the entire input (input$output.summary.name_rows_selected) as an argument of the function as below.
library("dplyr")
library("shiny")
library("DT")
f.drilldata <- function(base.summary, base.drilldown, input, group_var){
group = enquo(group_var)
base.summary = base.summary %>% mutate(var = !!group)
base.drilldown = base.drilldown %>% mutate(var = !!group)
validate(need(length(input) > 0, ''))
selected_rows <- base.summary[as.integer(input), ]$var
base.drilldown[base.drilldown$var %in% selected_rows, ]
}
tbl.summary <- group_by(iris, Species) %>% summarise(Count = n())
tbl.drilldown <- iris
ui <- fluidPage(
DTOutput("output.summary.name")
, DTOutput("output.drilldown.name"))
server <- function(input, output){
output$output.summary.name <- renderDT(tbl.summary)
drilldata <- reactive({ f.drilldata(tbl.summary, tbl.drilldown,
input$output.summary.name_rows_selected, Species) })
output$output.drilldown.name <- renderDT(drilldata())}
shinyApp(ui, server)