Shiny Server renderTable rownames issue - r

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)

Related

Refreshing of shiny app in aws server when refresh button is pressed in browser

I Have my shiny app in aws server shown here
library("shiny")
library("shinydashboard")
library("pool")
library(DBI)
pool <- dbPool(drv = RMySQL::MySQL(),dbname = "demo",host = "db.cr7lk1jwjdht.us-east-2.rds.amazonaws.com",username = "kartik",password = "12345678", port = 3306)
mychoices = dbGetQuery(pool,"select available_scenario from scenario_name;")
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("create_scenario", "Create Scenario"),
actionButton("load_scenario","load scenario"),
selectInput('n', "available scenarios", choices = mychoices, multiple = TRUE),
verbatimTextOutput("selected")
),
mainPanel(
uiOutput('tabs'),
uiOutput("input"),
uiOutput("inputs"),
uiOutput("inputss")
)
)
)
server <- function(input, output,session) {
observeEvent(input$create_scenario,{
output$input <- renderUI({
mainPanel(
textInput("txtInput","Enter scenario name"),
textOutput("sname"),
actionButton("save","save_scenario")
)
})
output$sname <- renderText({
input$txtInput
})
observeEvent(input$save,{
# conn <- poolCheckout(pool)
# dbSendQuery(conn,"insert into scenario (name) values (", output$sname <- renderText({
# input$txtInput
#}),");")
dd <- data.frame(x = input$txtInput,row.names = FALSE)
print(dd)
dbWriteTable(pool,"available_scenario",dd,append = TRUE)
# values$dd <- rbind(values$dd,data.frame(Enter = input$txtInput))
})
})
output$tabs = renderUI({
if(!is.null(input$n)){
Tabs <- lapply(paste("tab name:", input$n, sep=" "), tabPanel)
do.call(tabsetPanel, Tabs)}
})
observeEvent(input$load_scenario,{
output$inputs <- renderUI({
dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(
# Boxes need to be put in a row (or column)
fluidRow(
box(plotOutput("plot1", height = 250)),
box(
title = "Controls",
sliderInput("slider", "Number of observations:", 1, 100, 50)
))))
} )
histdata <- rnorm(500)
output$plot1 <- renderPlot({
data <- histdata[seq_len(input$slider)]
hist(data)
})
})
}
shinyApp(ui, server)
I have a database table where i am storing the data for scenario name.
When i create a scenario named as Scenario-2 in server, it is saving in my database table but when i refresh the browser of shiny app it is not reflecting in the available scenario .
For it to reflect in available scenario i have to reboot the the server.
Any suggestions please.
Any code that is outside of the ui and the server will only run once when the R session first initializes. If you refresh the page or have someone else go to the app, the R session already exists, so that code won't run again. If you want this code to run every time the shiny app URL is visited, you need to place this code inside the server function. In your code, pool and mychoices are being defined outside the ui and server, so you need to move them (or at least mychoices) inside the server function so that it'll be called every time a new shiny session starts.

Hyperlink not working with dashes in a datatable in Shiny

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)

Updating selecInput with more than 1,000 items in Shiny

I want to update a selectInput item on a Shiny app with more than 1,000 items but it obviously don't accept more than 1,000.
Is there a method to add more values or load it from server, as user start typing? server parameter also doesn't work.
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
tags$head(tags$script(src = "message-handler.js")),
# Application title
titlePanel("Large selectInput"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
selectInput("Names",
"List of Names",
choices = c("A")
)
),
mainPanel("Empty")
)
)
# Define server logic required to draw a histogram
server <- function(input, output, session) {
names <- 1:5000
observe({
updateSelectInput(session, "Names", label = "Updated", choices = names, server = TRUE)
})
}
# Run the application
shinyApp(ui = ui, server = server)
selectizeInput() can handle more than 1,000 records.

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