I have two boxes in the first are two inputs and second box contains table. I use package DT for table. This setting is ok for resolution 1920x1080 but problem is in smaller resolution for example 1024x768
tabItem(tabName="Table",titlePanel("My Data"),
box(width=2,uiOutput("first_input"),textInput("numbers_input",label="choose your option",width ="200px")),
box(width=9,dataTableOutput("tabData"))
),
1024x768
Try adding scrollX = T
library(shiny)
library(shinydashboard)
library(DT)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
tabItem(tabName="Table",titlePanel("My Data"),
box(width=2,uiOutput("first_input"),textInput("numbers_input",label="choose your option",width ="200px")),
box(width=9,dataTableOutput("tabData"))
)
)
)
server <- function(input, output, session) {
output$tabData <- renderDataTable({cbind(mtcars,mtcars)},options = list(scrollX = T))
}
shinyApp(ui, server)
Related
I'm trying to have a box inside my shiny app while using the shinythems library :
library(shiny)
library(DT)
library(shinythemes)
library(shinydashboard)
ui <- fluidPage(
theme = shinytheme("lumen"),
navbarPage("test theme",
tabPanel("tab1",
mainPanel(width = 12,
fluidRow(
box(width=6,title = "title",status = "navy", solidHeader = TRUE,
dataTableOutput(outputId = "tab"))))
))
)
)
Server <- function(input, output,session){
output$tab = renderDataTable(mtcars)
}
shinyApp(ui, server)
But it does not work as I expected !
I was hoping to get something like :
I tried the titlePanel as well but it did not work !
I don't believe you can mix-n-match Shiny fluidPage, shinythemes & elements from shinydashboard just like that. For box to properly work it needs shinydashboard CSS and to include this you'd normally use
dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody()
)
layout instead of fluidPage() / fixedPage() Shiny layouts.
Though.. there's shinyWidgets::useShinydashboard() :
library(DT)
library(shiny)
library(shinythemes)
library(shinydashboard)
library(shinyWidgets)
ui <- fluidPage(
theme = shinytheme("lumen"),
shinyWidgets::useShinydashboard(),
navbarPage("test theme",
tabPanel("tab1",
mainPanel(width = 12,
fluidRow(
box(width = 12,
title = "title", status = "warning", solidHeader = TRUE,
dataTableOutput(outputId = "tab")
)
)
)
)
)
)
server <- function(input, output, session) {
output$tab <- renderDataTable(mtcars)
}
shinyApp(ui, server)
DT might not be the best example here as it requires some setup for responsiveness (it doesn't respect box boundaries and box(width = 6, ...) just draws over half of the table).
Building a Shiny Dashboard where I need to render a matrix.
For that I plan to use a DT::renderDataTable.
Everything is inside a FluidRow with a column size of 3 (out of 12).
The DataTable spread out of the defined column.
How can I force the table to fit the column and don't go over it ?
Perhaps you can use splitLayout to obtain your desired output. Try this
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Test App"
),
dashboardSidebar(),
dashboardBody(
splitLayout(cellWidths = c("25%", "25%", "50%"),
DTOutput("t1"), DTOutput("t2"), DTOutput("t3")
)
)
)
server <- function(input, output) {
output$t1 <- renderDT({mtcars})
output$t2 <- renderDT({mtcars[9:15,]})
output$t3 <- renderDT({mtcars[21:32,]})
}
shinyApp(ui, server)
Trying to delete the headers from DT::datatable results in 'No matching records found' when used inside renderDT(). Why does this happen? How can I fix it?
library(shiny)
library(shinydashboard)
library(DT)
ui <- dashboardPage(
dashboardHeader(title = "Dynamic sidebar"),
dashboardSidebar(
),
dashboardBody(
DT::dataTableOutput("t")
)
)
server <- function(input, output) {
output$t<-renderDT(datatable(head(iris),colnames = ""))
}
shinyApp(ui, server)
The easy solution for this problem is to set the server argument in renderDT() to FALSE. However, the description of this argument says:
if FALSE, then the entire data frame is sent to the browser at once. Highly recommended for medium to large data frames, which can cause browsers to slow down or crash.
If this is not of a problem for you, try this:
library(DT)
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Dynamic sidebar"),
dashboardSidebar(
),
dashboardBody(
DT::dataTableOutput("t")
)
)
debugonce(renderDT)
server <- function(input, output) {
output$t <- renderDT(datatable(head(iris),colnames = ""), server = FALSE)
}
shinyApp(ui, server)
In my current application I am using a navlistPanel similar to the one below and I was wondering whether it would be possible to add a selectInput UI element to the navlist?
I have tried this in my ui.R but it doesn't work:
fluidPage(
titlePanel("Application Title"),
navlistPanel(
"Header",
tabPanel("First"),
tabPanel("Second"),
tabPanel("Third")
# selectInput(inputId, label, choices, selected = NULL) <- I've tried this but it doesn't work
)
)
Any solutions/workarounds are welcome.
I was wondering whether using sidebarLayout + sidebarPanel would work where the sidebarPanel imitates the behaviour of a navlistPanel but wasn't able to implement it.
A clean solution will be difficult, but how about something like this:
library(shiny)
shinyApp(
ui <- fluidPage(
titlePanel("Application Title"),
navlistPanel("Header", id = "navOut",
tabPanel("First", "First"),
tabPanel(selectInput("navSel", "Selection:", c("b", "c")), textOutput("txt"))
)
),
server <- shinyServer(function(input, output){
output$txt <- renderText(input$navSel)
})
)
If you are okay with using shinydashboard, it is fairly simple.
library(shiny)
library(shinydashboard)
rm(list=ls)
######/ UI Side/######
header <- dashboardHeader(title = "Test")
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("First Tab",tabName = "FTab", icon = icon("globe")),
menuItem("Second Tab",tabName = "STab", icon = icon("star"))
),
selectInput("navSel", "Selection:", c("b","c"))
)
body <- dashboardBody()
ui <- dashboardPage(header, sidebar, body)
######/ SERVER Side/######
server <- function(input, output, session) {
}
shinyApp(ui, server)
i need to give flexibility to app user so that they can edit/modify a table . I am using the below codes
UI code:
tabItem(tabName = "manual_override",
fluidRow(
editableDTUI("table1")
Server Codes:
callModule(editableDT,"table1",data=reactive(bigtable),inputwidth=reactive(100))
but the problem is that bigtable has more than 15 columns to display and the horizontal scroll is not appearing
I have tried the same with library(DT) with 20 col.
If that solves your problem.
ui.r
library(shiny)
library(DT)
shinyUI(
fluidPage(
navbarPage("Big file upload + Horizental Scrolling",
tabPanel("Data Import",
fluidRow(
fileInput("file","Upload Your CSV",multiple = FALSE),
column(6,
div(style = 'overflow-x: scroll', DT::dataTableOutput('csv_data')))
)
)
)
)
)
server.r
library(shiny)
shinyServer(function(input, output) {
csv_data_fun<-eventReactive(input$file,{
df<-read.csv(input$file$datapath,
header =TRUE)
return(df)
})
output$csv_data<-DT::renderDataTable({
DT::datatable(csv_data_fun(),rownames = FALSE)%>%formatStyle(columns=colnames(csv_data_fun()),background = 'white',color='black')
})
})
output Screen
Please check whether you want this
I have done with editDT, But this time with default mtcars dataset.
Added the code in UI part
div(style = 'overflow-x: scroll',editableDTUI("table1"))
New Code
library(shiny)
library(editData)
if (interactive()) {
ui <- fluidPage(
textInput("mydata","Enter data name",value="mtcars"),
column(6,
div(style = 'overflow-x: scroll',editableDTUI("table1")
)
)
)
server <- function(input, output) {
df=callModule(editableDT,"table1",dataname=reactive(input$mydata),inputwidth=reactive(170))
output$test=renderPrint({
str(df())
})
}
shinyApp(ui, server)
}
Please check this time if this solves your problem. You can tweak the things to change according to your requirements.
Please accept the answer if solves your issue.