Hyperlink not working with dashes in a datatable in Shiny - r

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)

Related

R Shiny observeEvent continues to trigger

I'm struggling to get an observeEvent process to run only once after it's triggering event - a button click. This illustrates:
require(shiny)
ui = fluidPage(
textInput("input_value", '1. input a value. 2. click button. 3. input another value', ''),
actionButton("execute", 'execute'),
textOutput('report')
)
server = function(input, output, session) {
observeEvent(input$execute, {
output$report = renderText(input$input_value)
})
}
shinyApp(ui = ui, server = server, options = list(launch.browser = T))
You'll see that after the button has been clicked once, the textOutput becomes responsive to textInput changes rather than button clicks.
I've tried this approach:
server = function(input, output, session) {
o = observeEvent(input$execute, {
output$report = renderText(input$input_value)
o$destroy
})
}
No effect. I've also tried employing the isolate function with no luck. Grateful for suggestions.
You probably had your isolate() call wrapped around renderText() instead of input$input_value. This should do it for you:
require(shiny)
ui = fluidPage(
textInput("input_value", '1. input a value. 2. click button. 3. input another value', ''),
actionButton("execute", 'execute'),
textOutput('report')
)
server = function(input, output, session) {
observeEvent(input$execute, {
output$report = renderText(isolate(input$input_value))
})
}
shinyApp(ui = ui, server = server, options = list(launch.browser = T))
Alliteratively you can bring the reactive values into an isolated scope of observeEvent() as below:
library(shiny)
ui = fluidPage(
textInput("input_value", '1. input a value. 2. click button. 3. input another value', ''),
actionButton("execute", 'execute'),
textOutput('report')
)
server = function(input, output, session) {
observeEvent(input$execute, {
# bringing reactive values into an isolated scope
inp_val <- input$input_value
output$report <- renderText(inp_val)
})
}
shinyApp(ui = ui, server = server, options = list(launch.browser = T))

renderUI in R shiny doesn't display

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.

Shiny Server renderTable rownames issue

I have a project I'm working on that we push onto our server and for some reason the renderTable is putting rownames (and thus my align is short a column) on the server version but not the local version. Below is a sample Shiny app and the corresponding outputs (local is the first picture, server is the second). I've tried explicitly setting rownames = FALSE and setting the xtable option to false as well.
Any help is appreciated.
library(shiny)
ui <- fluidPage(
titlePanel("Test"),
fluidPage(
tableOutput("table")
)
)
server <- function(input, output) {
output$table <- renderTable({
data.frame("Letter" = c("a", "b", "c"),
"Number" = c(1:3))
}, align = "cr")
}
shinyApp(ui = ui, server = server)

R Shiny: selectInput inside splitLayout

When the selectInput widget is inside splitLayout with multiple mode on, there is something wrong. The dropdown selection area disappears when the width is small.
library(shiny)
ui <- fluidPage(
splitLayout(selectInput("x","x",choices = LETTERS,selected = LETTERS,multiple = TRUE),
br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br())
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
Any advice. Thanks.

R Shiny: Combining two Apps

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.

Resources