Is there some way to have a dynamic titlePanel title that pulls directly from UI kind of like below? If it's not possible, is it possible to have a second row that's similar to titlepanel right below titlepanel?
# Define UI ----
ui <- fluidPage(
##Whatever UI code here
titlepanel_text = paste0("Some string", variable_with_text)
)
# Define server logic ----
server <- function(input, output) {
titlePanel("title panel"),
#Rest of server code here
}
Render the text in the server and grab the text output in the UI:
library(shiny)
# Define UI ----
ui <- fluidPage(
##Whatever UI code here
titlePanel(textOutput("title_panel")),
sidebarLayout(
sidebarPanel(),
mainPanel(h1("text"))
)
)
# Define server logic ----
server <- function(input, output) {
output$title_panel <- renderText({
paste0("This is the date/time: ", Sys.time() )
})
}
shiny::shinyApp(ui, server)
you can insert this kind of code to structure your title panel
# Application title
titlePanel(
fixedRow(
column(9,
"My Template",
fixedRow(
column(9,
paste0("Author : ", author)
),
column(3,
paste0("date : ", today(tzone = ""))
)
)
)
) ),
Related
Assuming I have 2 action buttons as a starting page 'Client' & 'Employee' as shown below, and for each option, there is a different web application.
when the user clicks the 'Client' button I need the following code to be run:
library(shiny)
ui <-
navbarPage(
"The Client Web",
tabPanel("Section1 "),
tabPanel(" Section1 2")
)
server <- function(input, output,session){
}
shinyApp(ui = ui, server = server)
and when the user clicks the 'Employee' button I need the following code to be run:
library(shiny)
ui <-
navbarPage(
"The Employee Web",
tabPanel("Component 1"),
tabPanel("Component 2"),
tabPanel("Component 3")
)
server <- function(input, output,session){
}
shinyApp(ui = ui, server = server)
I need both of the web applications in one app depending on the type of the user either 'Client' or 'Employee'. Thank you in advance!
Using JavaScript
I would do it using Javascript code to hide/show either of the pages.
You have to create your app with de buttons and both navbarpages.
library(shiny)
ui <- fluidPage(
# Buttons
actionButton('clientsBtn', 'Clients'),
actionButton('employeeBtn', 'Employee'),
# Employee pag
div(
class = 'employees-page',
navbarPage(
"The Employee Web",
tabPanel("Component 1"),
tabPanel("Component 2"),
tabPanel("Component 3")
)
),
# Clients page
div(
class = 'clients-page',
navbarPage(
"The Client Web",
tabPanel("Section1 "),
tabPanel(" Section1 2")
)
),
# Javascript to control de page logic
includeScript('script.js')
)
server <- function(input, output,session){
}
shinyApp(ui = ui, server = server)
The script.js file is just a text file with that extension.
// hide by default the clients page
$('.clients-page').hide();
$('#clientsBtn').on('click', () => {
$('.employees-page').hide();
$('.clients-page').show();
})
$('#employeeBtn').on('click', ()=>{
$('.employees-page').show();
$('.clients-page').hide();
})
Individual pages using shiny.router
As I promised, here is the approach using {shiny.router} to accomplish what you want.
library(shiny)
library(shiny.router)
# The root page is separated from clients and employee pages
# and contains two buttons/links that takes you the destination
# you wish
root_page <- tagList(
tags$a(
div(class='btn btn-default', id='clientsBtn', 'Clients'),
href=route_link('clients')
),
tags$a(
div(class='btn btn-default', id='employeeBtn', 'Employee'),
href=route_link('employees')
)
)
# The employee and clients page should include a button/link
# to take you back to the root page. I place the button in the
# first tabpanel of each page, but for better ux is good idea
# if you place it in all of them. Consider change its style and
# position using css configuration.
employee_page <- tagList(
navbarPage(
"The Employee Web",
tabPanel(
"Component 1",
tags$a(
div(class='btn btn-default', id='home1', 'Home'),
href=route_link('/')
)
),
tabPanel("Component 2"),
tabPanel("Component 3")
)
)
clients_page <- tagList(
navbarPage(
"The Client Web",
tabPanel(
"Section1 ",
tags$a(
div(class='btn btn-default', id='home1', 'Home'),
href=route_link('/')
)
),
tabPanel(" Section1 2")
)
)
router <- make_router(
route("/", root_page),
route("employees", employee_page),
route("clients", clients_page)
)
ui <- fluidPage(
router$ui
)
server <- function(input, output, session) {
router$server(input, output, session)
}
shinyApp(ui, server)
I got theses result:
when I have tried the following code:
library(shiny)
library(shiny.router)
Cleints_page <- div(
titlePanel("Cleints"),
p("This is the Cleints web app")
)
Employees_page <- div(
titlePanel("Employees"),
p("This is the Employees web app")
)
router <- make_router(
route("/", Cleints_page),
route("employees", Employees_page)
)
ui <- fluidPage(
tags$ul(
tags$li(a(href = route_link("/"), "Cleints
Web")),
tags$li(a(href = route_link("employees"),
"Employees Web"))
),
router$ui
)
server <- function(input, output, session) {
router$server(input, output, session)
}
shinyApp(ui, server)
but still, I need each one of them to be a separate page. How I can achieve that?
I am looking for a way to link from an HTML text (nested in the server part) to a specific Shiny tabPanel (nested in UI). Let's say we have the following app:
library(shiny)
shinyUI(fluidPage(
sidebarLayout(
mainPanel(
tabsetPanel(
type="tabs",
tabPanel("Contents", htmlOutput("contents")),
tabPanel("Plot", plotOutput("plot")) # <- A link to here
)
)
)
))
shinyServer(function(input, output) {
output$contents <- renderText({
HTML("A link to <a href='#Plot'>Plot</a>") # <- from there
})
output$plot({
some ggplot
})
})
How could I create a link within the text that then redirects to a certain tab. I tried anchor tags but they don't seem to work as the id keeps changing upon each start of the app.
Thanks in advance.
I don't know whether this is possible with a link. But you can use a button and updateTabsetPanel.
library(shiny)
library(ggplot2)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(),
mainPanel(
tabsetPanel(
type="tabs",
id = "tabset",
tabPanel("Contents", actionButton("go", "Go to plot")),
tabPanel("Plot", plotOutput("plot"))
)
)
)
)
server <- function(input, output, session) {
observeEvent(input$go, {
updateTabsetPanel(session, "tabset", "Plot")
})
output$plot <- renderPlot({
ggplot(mtcars, aes(x=cyl, y=disp)) + geom_point()
})
}
shinyApp(ui, server)
Thanks to Stéphane Laurent, who pointed me in the right direction, I managed to create the solution I wanted. In order to keep all the HTML text in the server function I used a combination of renderUI and actionLink. The solution now looks as follows:
library(shiny)
shinyUI(fluidPage(
sidebarLayout(
mainPanel(
tabsetPanel(
type="tabs",
id = "tabset", # <- Key element 1
tabPanel("Contents", htmlOutput("contents")),
tabPanel("Plot", plotOutput("plot"))
)
)
)
))
shinyServer(function(input, output, session) {
output$contents <- renderUI({ # <- Key element 2
list(
HTML(<p>Some text..</p>),
actionLink("link", "Link to Plot") # <- Key element 3
)
})
observeEvent(input$link, {updateTabsetPanel(session, "tabset", "Plot")}) # <- Key element 4
output$plot({
some ggplot
})
})
I have two questions:
1) I want to serve several text Input fields that look like a table. My solution is ok, but there is too much space between the lines due to the title for each field required. How can I shorten the distance between the text Input fields?
2) The Output shall be a data.frame which includes data from the Input. How can I create a data.frame out of Input data in "Output$contents"?
Thank you.
Shortened extract of the code:
ui <- fluidPage(
# App title ----
titlePanel("Stochastische Cashflows"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
h4("Psychologisch motivierte Abflüsse aus Einlagen"),
tags$hr(),
fluidRow(
column(6,
textInput("file1", "Passive Bilanzpostionen eingeben"),
textInput("file2", "")
),
column(6,
textInput("file3", "Passive Bilanzpostionen eingeben"),
textInput("file4", "")
)
),
),
# Main panel for displaying outputs ----
mainPanel(
# Output: Data file ----
tableOutput("contents"),
)
)
)
################################################################################################################
################################################################################################################
server <- function(input, output) {
output$contents <- renderTable({
print(9)
})
################################################################################################################
################################################################################################################
# Create Shiny app ----
shinyApp(ui, server)
###########################################################################################################
You can use a css to reduce the top margin:
tags$style(type="text/css", "#file2 { margin-top: -20px }")
You can put it just after you create the text input.
To get the contents as a dataframe, a reactive conductor is nice:
df <- reactive({
data.frame(A=c(input$file1, input$file2), B=c(input$file3, input$file4))
})
output$contents <- renderTable({
df()
})
Complete code:
library(shiny)
ui <- fluidPage(
# App title ----
titlePanel("Stochastische Cashflows"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
h4("Psychologisch motivierte Abflüsse aus Einlagen"),
tags$hr(),
fluidRow(
column(6,
textInput("file1", "Passive Bilanzpostionen eingeben"),
textInput("file2", ""),
tags$style(type="text/css", "#file2 { margin-top: -20px }")
),
column(6,
textInput("file3", "Passive Bilanzpostionen eingeben"),
textInput("file4", ""),
tags$style(type="text/css", "#file4 { margin-top: -20px }")
)
)
),
# Main panel for displaying outputs ----
mainPanel(
# Output: Data file ----
tableOutput("contents")
)
)
)
# server ----
server <- function(input, output) {
df <- reactive({
data.frame(A=c(input$file1, input$file2), B=c(input$file3, input$file4))
})
output$contents <- renderTable({
df()
})
}
# Create Shiny app ----
shinyApp(ui, server)
I'm using conditionalPanel to create a UI that first presents a panel with options to the user and then displays a tabbed dashboard using tabsetPanel. The simple act of adding another tabPabel as shown below somehow prevents the server.R file from running. I've tested using print statements. It seems like the Shiny app is breaking, but I can't find a syntax error or any reason for it to be.
conditionalPanel(
condition = "output.panel == 'view.data'",
tabsetPanel(id = "type",
tabPanel("Script", value = "script",
fluidPage(
br(),
fluidRow(
column(3, uiOutput("script.name")),
column(3, uiOutput("script.message"))
),
hr(),
plotlyOutput("plotly")
)
),
tabPanel("Location", value = "location",
fluidPage(
br(),
fluidRow(
# column(3, uiOutput("id.range"))
),
hr(),
plotlyOutput("plot")
)
)
# when this tabPanel is uncommented it doesn't work
# ,tabPanel("Accelerometer", value = "accelerometer",
# fluidPage(
# br(),
# hr(),
# plotlyOutput("plot")
# )
# ),
)
)
It's not failing because of the additional tabPanel, it's failing because it contains a duplicate reference to output$plot. Each output of the server function can only be displayed once. For example, this runs, but will fail if the duplicated line is uncommented:
library(shiny)
ui <- shinyUI(fluidPage(
# textOutput('some_text'),
textOutput('some_text')
))
server <- shinyServer(function(input, output){
output$some_text <- renderText('hello world!')
})
runApp(shinyApp(ui, server))
A simple solution is to save the results of the render* function to a local variable, which you can then save to two outputs:
library(shiny)
ui <- shinyUI(fluidPage(
textOutput('some_text'),
textOutput('some_text2')
))
server <- shinyServer(function(input, output){
the_text <- renderText('hello world!')
output$some_text <- the_text
output$some_text2 <- the_text
})
runApp(shinyApp(ui, server))
In my R shiny application, I would like to have one button to submit one set of inputs (which affect one portion of the output) and another one to submit the remaining inputs (which affect a different portion of the output). The code in the widgets example of the Shiny tutorial uses a submitButton but it seems like all the inputs are delivered when that single button is pressed? Thanks in advance for your help.
Here is an example showing actionButtons controlling reactive components:
library(shiny)
runApp(list(
ui = fluidPage(
titlePanel("Hello Shiny!"),
sidebarLayout(
sidebarPanel(
tags$form(
numericInput('n', 'Number of obs', 100)
, br()
, actionButton("button1", "Action 1")
)
, tags$form(
textInput("text", "enter some text", value= "some text")
, br()
, actionButton("button2", "Action 2")
)
),
mainPanel(
plotOutput('plot')
, textOutput("stext")
)
)
),
server = function(input, output) {
output$plot <- renderPlot({
input$button1
hist(runif(isolate(input$n)))
})
output$stext <- renderText({
input$button2
isolate(input$text )
})
}
)
)