Please have a look at the reprex at the end of this post.
I have a tibble with mix of numerical and non-numerical columns.
The numerical values are all rounded up to two decimals.
I use formatStyle and I manually select the numerical columns which I want to be right aligned.
Unfortunately, in the real-life shiny app I do not know each time how many numerical columns I will have, so I need a way to select them automatically in order to align them.
It must be a one-liner, but so far I have been unsuccessful.
Anyone can help me here?
Many thanks!
library(shiny)
library(tidyverse)
library(DT)
#>
#> Attaching package: 'DT'
#> The following objects are masked from 'package:shiny':
#>
#> dataTableOutput, renderDataTable
round_all <- function(df, n){
res <- df %>% mutate(across(where(is.numeric), ~round(.x,n) ))
return(res)
}
set.seed(1234)
df <- tibble(x=letters[1:5], y=LETTERS[10:14],
w=rnorm(5), z=rnorm(5)) %>%
round_all(2)
ui <- fluidPage(
mainPanel(DTOutput("table"))
)
server <- function(input, output) {
output$table <- renderDT({datatable(df)} %>%
formatStyle(columns=c("w", "z"),
textAlign = 'right')
)
}
shinyApp(ui = ui, server = server)
#>
#> Listening on http://127.0.0.1:7374
Created on 2021-09-21 by the reprex package (v2.0.1)
You can write e.g. numeric_cols <- df %>% keep(is.numeric) %>% colnames():
library(shiny)
library(tidyverse)
library(DT)
round_all <- function(df, n) {
res <- df %>% mutate(across(where(is.numeric), ~ round(.x, n)))
return(res)
}
set.seed(1234)
df <- tibble(
x = letters[1:5], y = LETTERS[10:14],
w = rnorm(5), z = rnorm(5)
) %>%
mutate_if(is.numeric, ~ .x %>% round(2))
ui <- fluidPage(
mainPanel(DTOutput("table"))
)
server <- function(input, output) {
numeric_cols <- df %>% keep(is.numeric) %>% colnames()
output$table <- renderDT({
datatable(df)
} %>%
formatStyle(
columns = numeric_cols,
textAlign = "right"
))
}
shinyApp(ui = ui, server = server)
Related
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've been at this for awhile and have read a bunch but I still can't wrap my head around how to make this work. Is there a simple solution?
I want to edit a DT table in my shiny app and, upon editing, I'd like there to be a change in a column that aggregates two values.
Here is an example:
library(tidyverse)
library(shiny)
library(DT)
mt <- mtcars %>%
select(mpg, cyl) %>%
head()
ui <- fluidPage(
DTOutput(outputId = "final_tbl")
)
server <- function(input, output){
dat <- reactive({
d <- mt %>%
mutate(total = mpg + cyl)
d
})
output$final_tbl <- renderDT({
dat() %>%
datatable(editable = TRUE)
})
}
shinyApp(ui, server)
This produces a simple editable table with a total column that adds up mpg and cyl. What I'd like to be able to do is edit the cyl value and have the change reflected in the summed total column. Is there an easy solution to this?
You need to use _cell_edit as shown below in a ObserveEvent.
mt <- mtcars %>%
select(mpg, cyl) %>%
head()
ui <- fluidPage(
DTOutput(outputId = "final_tbl")
)
server <- function(input, output){
df1 <- reactiveValues(data=NULL)
dat <- reactive({
d <- mt %>%
mutate(total = mpg + cyl)
d
})
observe({
df1$data <- dat()
})
output$final_tbl <- renderDT({
df1$data %>%
datatable(editable = TRUE)
})
observeEvent(input$final_tbl_cell_edit, {
info = input$final_tbl_cell_edit
str(info)
i = info$row
j = info$col
v = info$value
# Without this line the table does not change but with it it jumps to row 1 after an edit.
df1$data[i, j] <<- (DT::coerceValue(v, df1$data[i, j]))
df1$data[,"total"] <<- df1$data[,"mpg"] + df1$data[,"cyl"] ## update the total column
})
}
shinyApp(ui, server)
I am trying to build a shiny app that gives user the flexibility to choose the variables for group by and summarize. Checkbox will have an option for selecting group by variables. Right now I haven't given measure variables as selections, since I struggling with group by. I want the numbers to be aggregated basis the selection.
library(shiny)
library(ggplot2) # for the diamonds dataset
library(shinydashboard)
library(dplyr)
y1<-diamonds
ui <- fluidPage(
checkboxGroupInput("variable", "Variables to show:",
c("cut","color","clarity"),selected = "cut"),
tableOutput("data"),
textOutput("result")
)
server <- function(input, output, session) {
base <- reactive({
groupby <- enquo(input$variable)
print(groupby)
res <-y1%>% group_by(!!!groupby,x) %>%
tally() %>%
ungroup() %>%
summarise(sum = sum(x)) %>%
pull()
res
})
output$result <- renderText({
input$variable
})
output$data<-renderTable({
base()
}
)
}
shinyApp(ui, server)
Thanks,
Hema
I'm not sure that I understood your question exactly, but maybe something like this:
library(shiny)
library(ggplot2) # for the diamonds dataset
library(shinydashboard)
library(dplyr)
y1<-diamonds
ui <- fluidPage(
checkboxGroupInput("variable", "Variables to show:",
c("cut","color","clarity"),selected = "cut"),
tableOutput("data"),
textOutput("result")
)
server <- function(input, output, session) {
base <- reactive({
res <- y1 %>% group_by(eval(parse(text = input$variable)),x) %>%
tally() %>%
#ungroup() %>%
summarise(sum = sum(x)) %>%
pull()
res
})
output$result <- renderText({
input$variable
})
output$data<-renderTable({
base()
})
}
shinyApp(ui, server)
if it's possible to select multiple from the check boxes such that you'd want something like group_by(x,y) this may help you get what you want:
group_by(across(all_of(input$group)))
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)
I don't really know to hook up mutate with reactive when dealing with names of columns that are numerical.
I've got data that looks something like this:
df <- tibble(a=c("a", "b", "c"), `1990`=c(1,2,3), `2010`=c(3,2,1))
Everything looks fine when I do:
p <- df %>%
mutate(newvar = `1990`)
But I want to use it in my Shiny App such that newvar is assigned to the input from select list.
I created this reactive for that;
selectedyear <- reactive({
input$select
})
But now it doesn't seem to work:
p <- df %>%
mutate(newvar = selectedyear())
I tried different modifications, like:
p <- df %>%
mutate(newvar = `selectedyear()`)
but nothing seems to work for me.
The full code of the app:
library(shiny)
library(tibble)
library(dplyr)
df <- tibble(a=c("a", "b", "c"), `1990`=c(1,2,3), `2010`=c(3,2,1))
ui <- fluidPage(
selectInput("select", "Select:", c(1990, 2010)),
tableOutput("val")
)
server <- function(input, output) {
selectedyear <- reactive({
input$select
})
output$val <- renderTable({
p <- df %>%
mutate(temperature = selectedyear())
p
})
}
shinyApp(ui, server)
The same thing, but with characters as input is easy. Do you know some hack around this?
You can do
output$val <- renderTable({
p <- df %>%
mutate(temperature = !!selectedyear())
p
})
The problem seems to be the non-syntactic name of the columns 1990, 2010. The approach below should work. It uses eval/parse inside the right hand side of the mutate call. Note that you usually do not need to create reactives of (and with only) inputs, because each input is already reactive.
library(shiny)
library(tibble)
library(dplyr)
df <- tibble(a=c("a", "b", "c"), `1990`=c(1,2,3), `2010`=c(3,2,1))
ui <- fluidPage(
selectInput("select", "Select:", c(1990, 2010)),
tableOutput("val")
)
server <- function(input, output) {
output$val <- renderTable({
df %>%
mutate(temperature = eval(parse(text = paste0("`", input$select,"`"))))
})
}
shinyApp(ui, server)
If you are only interested in the temperature column and you do not need to show the rest of the data, then dplyr::select lets you access the input$select variable in a much more straightforward fashion:
output$val <- renderTable({
df %>%
select(temperature = input$select)
})