I'm developing an R Shiny app and am trying to append two output objects side-by-side as part of the same UI element. However, when I use splitLayout() Shiny creates a space between the two objects highlighted below:
Is there a way to get the two objects to appear immediately side-by-side without the space in between? Please see code behind stylized example below:
# define mapping table
col1 <- c("AAAA" , "BBBB" , "CCCC" , "DDDD")
col2 <- c(1:4)
map <- as.data.frame(cbind(col1, col2))
# define and execute app
ui <- fluidPage(
selectInput(inputId = "object_A", label = "Select Object A",
choices = c("AAAA", "BBBB" , "CCCC"), selected = NULL, multiple = FALSE),
actionButton("go","Run Output"),
tags$br(),
fluidRow(
column(width = 4,
uiOutput(outputId = "select_object")
)
)
)
server <- function(input, output) {
observeEvent(input$go, output$select_object <-
renderUI({
splitLayout(
input$object_A,
map[which(map["col1"]==input$object_A),"col2"]
)
})
)
}
shinyApp(ui = ui, server = server)
You can use a flexbox:
observeEvent(input$go, {
output$select_object <-
renderUI({
div(
style = "display:-webkit-flex; display:-ms-flexbox; display:flex;",
div(input$object_A),
div(style = "width: 30px;"), # white space
div(map[which(map["col1"]==input$object_A),"col2"])
)
})
})
To center the flexbox items:
style = "display:-webkit-flex; display:-ms-flexbox; display:flex; justify-content:center;"
More info on flexbox: guide to flexbox.
For text only, you could use paste instead of splitLayout :
observeEvent(input$go, output$select_object <-
renderUI({
paste(
input$object_A,
map[which(map["col1"]==input$object_A),"col2"]
)
})
)
Related
I am making an R Shiny app and would like to left align and right align in the same dropdown menu.
So in the example app:
library(shiny)
# Define UI
ui <- fluidPage(
# App title ----
titlePanel("Dropdown Problems"),
# Sidebar layout with input and output definitions
sidebarLayout(
# Sidebar panel for inputs
sidebarPanel(
# Define Dropdown Menu
selectizeInput("selection_dropdown", "Select Selection of Interest:",
choices=NULL,
options=list(
maxItems=1,
placeholder='Select Selection',
create=TRUE)
)
),
# Main panel for displaying outputs ----
mainPanel(
# Output:
plotOutput(outputId = "sample_plot")
)
)
)
server <- function(session,input, output) {
# Define New Data Frame
new_data_frame <- data.frame(column1=c("aaaaaaaa","bb","cccc"),column2=c(1,2,3),column3=c("plot_a","plot_b","plot_c"))
# Create Dropdown Menu
observe({
dropdown_choices <- paste(new_data_frame$column1," (",new_data_frame$column2,")",sep="")
updateSelectizeInput(
session,
"selection_dropdown",
choices=dropdown_choices,
server=TRUE,
)
})
# Create Output Plot (This doesn't really matter)
output$sample_plot <- renderPlot({
plot_selection <- gsub(" .*","",input$selection_dropdown)
plot_selection <- new_data_frame$column3[new_data_frame$column1==plot_selection]
plot(
x=NA,
y=NA,
xlim=c(0,100),
ylim=c(0,100)
)
text(x=50,y=50,plot_selection)
})
}
shinyApp(ui = ui, server = server)
In the dropdown menu I would like the letters to be left aligned within the dropdown and the numbers and brackets to be right aligned.
I can separate them by a tab but the numbers won't be in line with each other unfortunately.
Thanks in advance for your help.
How about this
We can use the counter trick from CSS so these numbers are automatically assigned based on the order they are displayed in the dropdown. It means you don't need to manually add the index. When it is selected, on the server, it returns the value without the index.
library(shiny)
# Define UI
ui <- fluidPage(
tags$style(
'
:root {counter-reset: mycounter;}
.selectize-dropdown-content .option::after {
counter-increment: mycounter;
content: "(" counter(mycounter) ")";
float: right;
}
'
),
# App title ----
titlePanel("Dropdown Problems"),
# Sidebar layout with input and output definitions
sidebarLayout(
# Sidebar panel for inputs
sidebarPanel(
# Define Dropdown Menu
selectizeInput("selection_dropdown", "Select Selection of Interest:",
choices=NULL,
options=list(
maxItems=1,
placeholder='Select Selection',
create=TRUE)
)
),
# Main panel for displaying outputs ----
mainPanel(
# Output:
plotOutput(outputId = "sample_plot")
)
)
)
server <- function(session,input, output) {
# Define New Data Frame
new_data_frame <- c("aaaaaaaa","bb","cccc")
# Create Dropdown Menu
observe({
updateSelectizeInput(
session,
"selection_dropdown",
choices=new_data_frame,
server=TRUE,
)
})
# Create Output Plot (This doesn't really matter)
output$sample_plot <- renderPlot({
plot_selection <- gsub(" .*","",input$selection_dropdown)
plot(
x=NA,
y=NA,
xlim=c(0,100),
ylim=c(0,100)
)
text(x=50,y=50,plot_selection)
})
}
shinyApp(ui = ui, server = server)
Updates:
If your indices are not ordered numbers, we can still do it.
I just assume your data is still sending options from the server, even though your demo data seems that it can be done purely from the UI. Imagine your indices are some random numbers. We can send these numbers as CSS style to UI and format the dropdown.
library(shiny)
library(glue)
library(magrittr)
# Define UI
ui <- fluidPage(
# App title ----
titlePanel("Dropdown Problems"),
# Sidebar layout with input and output definitions
sidebarLayout(
# Sidebar panel for inputs
sidebarPanel(
# Define Dropdown Menu
uiOutput("style"),
selectizeInput("selection_dropdown", "Select Selection of Interest:",
choices=NULL,
options=list(
maxItems=1,
placeholder='Select Selection',
create=TRUE)
)
),
# Main panel for displaying outputs ----
mainPanel(
# Output:
plotOutput(outputId = "sample_plot")
)
)
)
server <- function(session,input, output) {
# Define New Data Frame
new_data_frame <- c("aaaaaaaa","bb","cccc")
indices <- sample(999, 3)
output$style <- renderUI(
tags$style(glue(.open = '#{', .close = "}#",
'
.selectize-dropdown-content .option:nth-child(#{seq_along(indices)}#)::after {
content: "(#{indices}#)";
float: right;
}
'
) %>% glue_collapse("\n"))
)
# Create Dropdown Menu
observe({
updateSelectizeInput(
session,
"selection_dropdown",
choices=new_data_frame,
server=TRUE,
)
})
# Create Output Plot (This doesn't really matter)
output$sample_plot <- renderPlot({
plot_selection <- gsub(" .*","",input$selection_dropdown)
plot(
x=NA,
y=NA,
xlim=c(0,100),
ylim=c(0,100)
)
text(x=50,y=50,plot_selection)
})
}
shinyApp(ui = ui, server = server)
I've created a new column that combines column 1 and 2, then a little bit of Javascript is used to create HTML for each option.
It left aligns the value from column 1 and right aligns the value from column 2.
It can probably be done without creating the new column by passing the 2 columns to the Javascript function.
library(shiny)
# Define UI
ui <- fluidPage(
# App title ----
titlePanel("Dropdown Problems"),
# Sidebar layout with input and output definitions
sidebarLayout(
# Sidebar panel for inputs
sidebarPanel(
# Define Dropdown Menu
selectizeInput("selection_dropdown", "Select Selection of Interest:",
choices=NULL,
options=list(
maxItems=1,
placeholder='Select Selection',
create=TRUE)
)
),
# Main panel for displaying outputs ----
mainPanel(
# Output:
plotOutput(outputId = "sample_plot")
)
)
)
server <- function(session,input, output) {
# Define New Data Frame
new_data_frame <- data.frame(column1=c("aaaaaaaa","bb","cccc"),column2=c(1,2,3),column3=c("plot_a","plot_b","plot_c"))
new_data_frame$column4 <-paste0(new_data_frame$column1, " (", new_data_frame$column2, ")")
# Create Dropdown Menu
observe({
dropdown_choices <- new_data_frame$column4
updateSelectizeInput(
session,
"selection_dropdown",
choices=dropdown_choices,
options = list(render = I(
'{
option: function(item, escape) {
const x = item.value.split(" ");
return `<p style=\"text-align:left;\">
${x[0]}
<span style=\"float:right;\">
${x[1]}
</span>
</p>`
}
}')),
server=TRUE,
)
})
# Create Output Plot (This doesn't really matter)
output$sample_plot <- renderPlot({
plot_selection <- gsub(" .*","",input$selection_dropdown)
plot_selection <- new_data_frame$column3[new_data_frame$column1==plot_selection]
plot(
x=NA,
y=NA,
xlim=c(0,100),
ylim=c(0,100)
)
text(x=50,y=50,plot_selection)
})
}
shinyApp(ui = ui, server = server)
I am making an app in shiny and I want the main panel to occupy 100% of the screen, how can I achieve this? In this occasion I am showing a table but I would also like to add a graph so that it can be seen large.
Below I show the code I am using
screen shiny
library(shiny)
library(DT)
shinyUI(fluidPage(
# Application title
titlePanel("Company-Feature Chart"),
mainPanel(
uiOutput("seleccione_col1"),
uiOutput("seleccione_col2"),
DT::dataTableOutput(outputId =
"diagram")
)
)
)
shinyServer(function(input, output) {
datachart <- read.csv("examplechart1.csv", row.names=1, sep=";")
output$seleccione_col1<- renderUI({
selectInput(inputId="columnaD", (("Product")),
choices =names(datachart),
selected = names(datachart)[c(1,2)],multiple = TRUE)
})
output$seleccione_col2<- renderUI({
selectInput(inputId="columnaE", (("Features")),
choices =row.names(datachart),
selected = row.names(datachart)[1],multiple = TRUE)
})
output$diagram<- renderDataTable({
req(input$columnaE)
data <-datachart[input$columnaE,input$columnaD]
DT::datatable(data, escape = FALSE,options = list(sDom = '<"top">lrt<"bottom">ip',lengthChange = FALSE))
}, rownames = TRUE)
})
Use the width option:
mainPanel(
uiOutput("seleccione_col1"),
uiOutput("seleccione_col2"),
DT::dataTableOutput(outputId = "diagram"),
width = 12
)
I would like to create a reactiveValues object in Shiny whose contents are defined the values contained in input widgets. I managed to do it, but my implementation seems to be unnecessarily clunky:
Create an empty reactiveValues object
Monitor when the value of input widgets changes with observeEvent
Assign values to the reactiveValues object using the non-reactive values from input widgets (isolate)
Here is an example:
ui <- fluidPage(
fluidRow(
column(2, radioButtons("main", label = "Main dish", choices = list("salad", "pasta"))),
column(2, radioButtons("desert", label = "Desert", choices = list("fruit", "cake"))),
column(8, actionButton("extra", "Louder!", style="background-color: #ffdb99"))
),
verbatimTextOutput("myorder")
)
server <- function(input, output, session) {
# 1. Create reactiveValues object
menuR <- reactiveValues()
# 2. Update values whenever widgets change
observeEvent(c(input$main, input$desert),
menuR[["meal"]] <- paste(c(isolate(input$main), isolate(input$desert)), collapse = " & ")
)
# 3. Perform operations on object values
observeEvent(input$extra,
menuR[["meal"]] <- paste0(toupper(menuR[["meal"]]), "!!!")
)
output$myorder <- renderText(menuR[["meal"]])
}
shinyApp(ui, server)
I would very much like to create the reactiveValues object directly like this (greatly simplifies the code above):
# Set values upon creation
menuR <- reactiveValues(meal = paste(c(input$main, input$desert), collapse = " & "))
which does not work because input$main is reactive...
I would have guessed that defining reactiveValues objects with values obtained from widgets would be a common thing to do.
Am I missing something?
Thanks for your help,
Hugo
You can do this by using reactive() instead of reactiveValues(). menuR is a reactive object that depends on the input values of main and desert. You can use it by calling menu() in your server code once it is defined. Also, this saves you from using isolate() as you can set the value of menu as a reactive object inside observeEvent().
library(shiny)
ui <- fluidPage(
fluidRow(
column(2, radioButtons("main", label = "Main dish", choices = list("salad", "pasta"))),
column(2, radioButtons("desert", label = "Desert", choices = list("fruit", "cake"))),
column(8, actionButton("extra", "Louder!", style="background-color: #ffdb99"))
),
verbatimTextOutput("myorder")
)
server <- function(input, output, session) {
menuR <- reactive({
paste(c(input$main, input$desert), collapse = " & ")
})
observeEvent(
input$extra,
menuR <- reactive({
toupper(paste(c(input$main, input$desert), collapse = " & "))
})
)
output$myorder <- renderText(menuR())
}
shinyApp(ui, server)
Edit
I misunderstood the problem earlier. You can use eventReactive() which monitors a input and changes when the user input changes. I have also added a default value for when the action button is yet to be clicked by the user.
library(shiny)
ui <- fluidPage(
fluidRow(
column(2, radioButtons("main", label = "Main dish", choices = list("salad", "pasta"))),
column(2, radioButtons("desert", label = "Desert", choices = list("fruit", "cake"))),
column(8, actionButton("extra", "Louder!", style="background-color: #ffdb99"))
),
verbatimTextOutput("myorder")
)
server <- function(input, output, session) {
# Set a 'default' value for the output
default.menuR <- reactive({
paste(c(input$main, input$desert), collapse = " & ")
})
menuR <- eventReactive(input$extra, {
toupper(paste(c(input$main, input$desert), collapse = " & "))
})
# Initial state of the button is 0, which displays 'default' value
output$myorder <- renderText({
if (input$extra == 0) {
return(default.menuR())
}
menuR()
})
}
shinyApp(ui, server)
Hope this helps!
I have taken Vishesh's suggestion and made it work. It does not look much different than my original example, and still requires repeating several lines of code.
It works by over-writing the reactive object each time one of the widgets changes.
library(shiny)
ui <- fluidPage(
fluidRow(
column(2, radioButtons("main", label = "Main dish", choices = list("salad", "pasta"))),
column(2, radioButtons("dessert", label = "dessert", choices = list("fruit", "cake"))),
column(8, actionButton("extra", "Louder!", style="background-color: #ffdb99"))
),
verbatimTextOutput("myorder")
)
server <- function(input, output, session) {
menuR <- reactive({
paste(c(input$main, input$dessert), collapse = " & ")
})
# Render text when app loads
output$myorder <- renderText(menuR())
# Update reactive object and re-render text (button 'extra')
observeEvent(
input$extra,{
temp <- toupper(paste(c(input$main, input$dessert), collapse = " & "))
menuR <<- reactive(temp)
output$myorder <- renderText(menuR())
}
)
# Update reactive object and re-render text (button 'main' or 'dessert')
observeEvent(c(input$main, input$dessert),{
menuR <- reactive(paste(c(input$main, input$dessert), collapse = " & "))
output$myorder <- renderText(menuR())
})
}
shinyApp(ui, server)
I'm trying to use awesomeCheckbox from the shinyWidgets package and am running into an issue where I can't check/uncheck the box that a server rendered.
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
awesomeCheckbox(inputId = "checkboxA",
label = "A checkbox",
value = TRUE),
uiOutput("checkboxB"),
uiOutput("FS1")
)
server <- function(input, output) {
output$checkboxB <- renderUI({
awesomeCheckbox(inputId = "checkboxB",
label = "B checkbox",
value = TRUE)
})
output[[paste0("FS", 1)]] <- renderUI({
awesomeCheckbox(inputId = paste0("FS", 1),label = "FS", value = FALSE)
})
}
shinyApp(ui= ui, server=server)
I need this piece of code as part of a larger Shiny App where checkboxes are generated dynamically in the server (hence the weird paste0 naming).
I've checked my version of R and have tried using both Chrome and Safari but can't seem to get the FS checkbox to check/uncheck. I also can't seem to find anything out of the ordinary when I use "Inspect element" in my browser.
You have outputids checkboxB and FS1 respectively already rendered once, yet you create other components with the same names, hence they wont work, change the names as you cant have duplicate divs like so:
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
awesomeCheckbox(inputId = "checkboxA",label = "A checkbox",value = TRUE),
uiOutput("checkboxB"),
uiOutput("FS1")
)
server <- function(input, output) {
output$checkboxB <- renderUI({
awesomeCheckbox(inputId = "checkboxBx",label = "B checkbox", value = TRUE)
})
output[[paste0("FS", 1)]] <- renderUI({
awesomeCheckbox(inputId = paste0("FSx", 1),label = "FS", value = FALSE)
})
}
shinyApp(ui= ui, server=server)
I am working on a simple app that is supposed to ask for 1 (or more) unstructured text files, given by the user with fileInput. These files have all the same structure.
The idea is to make the cleaning/extraction on the background and give back the clean data to the user (ideally into a table).
I am fairly new using Shiny and the examples I have found basically indicate how to proceed when the file input is already in a clean and structured way.
Here is a simplified code that illustrates what I have done so far:
library(shiny)
shinyUI(fluidPage(
titlePanel(title = h2("Title", align = "left")),
sidebarLayout(position = "left",
sidebarPanel(h3("Data management window", align = "center"),
fileInput(inputId = "file_1",
label = "Select file 1")
),
mainPanel(
uiOutput(outputId = "tb")
)
)))
And here the server side:
shinyServer(function(input, output) {
input_file_1 <- reactive({
if(is.null(input$file_1)){
return("!! No data loaded !!")
}
readLines(input$file_1$datapath)
})
output$data_1 <- renderText({
fileText_1 <- paste(input_file_1(), collapse = "\n")
})
output$tb <- renderUI({
tabsetPanel(
tabPanel("Window 1",
br(),
tags$div(
tags$p("Summary infos : "),
tags$ul(
tags$li("Date calculation : ", Sys.Date()),
tags$li("Info 1: "),
tags$li("Info 2 : "),
tags$li("Info 3 : "),
br(),
verbatimTextOutput("data_1"))
))
)
})
})
At this stage I have managed to render the text of the file into the app. What I would like to do is to show in tabPanel some results obtained from the data extracted from the text file, like in the case of Sys.Date() but using values from the input file.
Do you have any ideas on how to proceed? Hope my question makes sense.
Your question is still too general, please more specific. But here is something to get you started. Using your server file and the iris dataset to make it easier, you can use the renderText() expression to extract the summary of one of your variable. And then you just add textOutput() expression in your tags$li("Info 1: ") argument.
Following a comment from OP, you could add a selectInput() that could help you pick one variable you want to summarise or extract information from. The code work as it is. Just replace iris by the file you will be loading.
ui = fluidPage(
titlePanel(title = h2("Title", align = "left")),
sidebarLayout(position = "left",
sidebarPanel(h3("Data management window", align = "center"),
fileInput(inputId = "file_1",
label = "Select file 1"),
uiOutput("Variable")
),
mainPanel(
uiOutput(outputId = "tb")
)
))
server = function(input, output) {
input_file_1 <- reactive({
if(is.null(input$file_1)){
return("!! No data loaded !!")
}
readLines(input$file_1$datapath)
})
output$data_1 <- renderText({
fileText_1 <- paste(input_file_1(), collapse = "\n")
})
output$Variable <- renderUI({
obj2 <- iris #replace by input_file_1()
selectInput("Variable", "Choose a variable", as.list(colnames(obj2)), multiple = FALSE)
})
output$summary1 <- renderPrint({
sub <- iris %>% select(input$Variable) #replace iris
a <- max(sub)
a
})
output$tb <- renderUI({
tabsetPanel(
tabPanel("Window 1",
br(),
tags$div(
tags$p("Summary infos : "),
tags$ul(
tags$li("Date calculation : ", Sys.Date()),
tags$li("Info 1: ", textOutput("summary1")),
tags$li("Info 2 : "),
tags$li("Info 3 : "),
br(),
verbatimTextOutput("data_1"))
))
)
})
}