Suppose I have two R Shiny apps that share many objects with the same names. Is there any way to quickly combine them into one app.
For example, if I have App 1:
library(shiny)
server <- function(input, output) {
output$x1 = renderPlot({
plot(rnorm(1000))
})
output$x2 = renderPlot({
hist(rnorm(1000))
})
}
ui <- fluidPage(
plotOutput("x1"),
plotOutput("x2")
)
shinyApp(ui = ui, server = server)
and App 2:
library(shiny)
server <- function(input, output) {
output$x1 = renderPlot({
plot(rpois(1000,10))
})
output$x2 = renderPlot({
hist(rpois(1000,10))
})
}
ui <- fluidPage(
plotOutput("x1"),
plotOutput("x2")
)
shinyApp(ui = ui, server = server)
In the real apps, there are too many "x1"s and "x2"s to rename one by one. Is there an alternative (like using namespaces) to do combine apps.
Related
I have a shiny application for which I have reproduced a simple example here.
It is a modular shiny application. This one is deployed on shinyapp.io
My problem is that when I open 2 instances of my deployed application, the actions done on one of the windows are applied to the other window
It seems that the problem is caused by the reactiveValues (r_global <- reactiveValues() ) in the server part.
Here is the reproduction of the code.
library(shiny)
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# MODULE ----
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
counterButton = function(id, label = "Counter") {
ns = NS(id)
tagList(actionButton(ns("button"), label = label),
verbatimTextOutput(ns("out")),
dataTableOutput(ns("table")))
}
counterServer <- function(id, r_global) {
moduleServer(id,
function(input, output, session) {
r_global$count = 0
observeEvent(input$button, {
r_global$count = r_global$count + 1
if (input$button == 3) {
output$table <- renderDataTable({
mtcars
})
} else{
output$table <- renderDataTable({
iris
})
}
})
output$out <- renderText({
r_global$count
})
})
}
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# UI ----
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
ui = fluidPage(h1("test"), counterButton("counter1", "Counter #1"))
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# SERVER ----
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
server <- function(input, output, session) {
r_global <- reactiveValues()
counterServer("counter1", r_global = r_global)
}
shinyApp(ui, server)
In a shiny app I'm showing a table where a column must have links to different websites, referred as "info". But I found that this doesn't work
tagList( as.character(a("info",href="https://plus.google.com/communities/107454103091776894629/stream/c37ddecb-dd31-4a62-bfe0-5d48d9309b8b")))
but this one does, showing correctly a hyperlink
tagList( as.character(a("info",href="https://plus.google.com/communities/107454103091776894629/")))
This is contained in a DT::renderDataTable in a shiny app (with escape=FALSE)
Yes, the second code works, and I noticed that the one difference was that this last one doesn't have dashes. Already tried sprintf.
In a ui
ui <- fluidPage(fluidRow(
column(width = 12,
div(dataTableOutput("web_scraped"), style = "font-size:70%")
))
)
meanwhile a server has
server <- function(input, output, session) {
output$web_scraped <- DT::renderDataTable(
DT::datatable({
data.frame("test"=HTML( as.character(a("info",href="https://plus.google.com/communities/107454103091776894629/"))),stringsAsFactors = FALSE)
},escape = FALSE))
}
shinyApp(ui = ui, server = server)
I need it to be
server <- function(input, output, session) {
output$web_scraped <- DT::renderDataTable(
DT::datatable({
data.frame("test"=HTML( as.character(a("info",href="https://plus.google.com/communities/107454103091776894629/stream/c37ddecb-dd31-4a62-bfe0-5d48d9309b8b"))),stringsAsFactors = FALSE)
},escape = FALSE))
}
shinyApp(ui = ui, server = server)
How can I overwrite/re-define a reactive expression, while keeping all observers to that expression intact?
Below example is intended to make the observer listen to a button click, but only after the button has been clicked once. Before that, the observer should react to a numeric input field. (Please note that I would like the observer untouched if possible. I would like to re-define the reactive expression instead.)
library(shiny)
ui <- fluidPage(
numericInput(inputId="some_numbers",value=8,label = "Enter a number:"),
actionButton(inputId = "button1",label="Update reactive expression")
)
server <- function(input, output, session) {
my_reactive_expr <- reactive({
input$some_numbers
})
observeEvent(my_reactive_expr(),{
print("reactive value change detected!")
})
observeEvent(input$button1,{
my_reactive_expr <<- reactive({
input$button1
})
})
}
shinyApp(ui = ui, server = server)
Like written in the comments i would suggest sthg like:
my_reactive_expr <- reactive({
if(!input$button1) return(input$some_numbers)
input$button1
})
The full app would read:
library(shiny)
ui <- fluidPage(
numericInput(inputId="some_numbers",value=8,label = "Enter a number:"),
actionButton(inputId = "button1",label="Update reactive expression")
)
server <- function(input, output, session) {
my_reactive_expr <- reactive({
if(!input$button1) return(input$some_numbers)
input$button1
})
observeEvent(my_reactive_expr(),{
print("reactive value change detected!")
})
observeEvent(input$button1,{
my_reactive_expr <<- reactive({
input$button1
})
})
}
shinyApp(ui = ui, server = server)
Like that you can avoid overwriting the reactive function.
Sometimes we'd like to put content in a uiOutput/renderUI. But this doesn't always work. For instance, the example below. In my mind, code#1 and code#2 should give me the same GUI. However, code#2 doesn't work as expected. Can anyone tell me the reason? Thanks!
Code#1:
library(shiny)
ui <- navbarPage("test",
navbarMenu("More",
tabPanel("Table"
)
)
)
server <- shinyServer(function(input, output, session) {
})
shinyApp(ui = ui, server = server)
Code#2:
library(shiny)
ui <- navbarPage("test",
uiOutput("ui_data")
)
server <- shinyServer(function(input, output, session) {
output$ui_data <- renderUI({
navbarMenu("More",
tabPanel("Table"
)
)
})
})
shinyApp(ui = ui, server = server)
In the second example, uiOutput wraps the content of navbarMenu inside a div with the class "shiny-html-output". Divs of this class are however not allowed as an argument for navbarPage. AFAIK, there are two ways to resolve this
The first is to create the whole navbarPage on the server-side.
library(shiny)
ui <- uiOutput("page")
server <- shinyServer(function(input, output, session) {
output$page <- renderUI({
navbarPage("test", navbarMenu("More", tabPanel("Table")))
})
})
shinyApp(ui, server)
The other one is to only create the contents of the tabPanel in the server
library(shiny)
ui <- navbarPage(
"test",
navbarMenu("More", tabPanel("Table", uiOutput("tab_content")))
)
server <- shinyServer(function(input, output, session) {
output$tab_content <- renderUI({
"Some content"
})
})
shinyApp(ui = ui, server = server)
Please try to set your working directory first like example below.
setwd("c:/Users/ID/Desktop/folder")
You should get working directory with location of ui.R and server.R.
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!