I can't correctly position the length changing and the filtering input to the top-right and bottom-left respectively on my DT::datatable output in shiny using the dom option. Code:
library(shiny)
library(DT)
set.seed(2282018)
company <- data.frame(Company = letters[1:10], Sales = scales::dollar(runif(10, 200, 1230)), stringsAsFactors = F)
# UI ----
ui <- function(){
fluidPage(
sidebarLayout(
sidebarPanel(numericInput("nums", label = "Num Input", value = 1, min = 1, max = 10)),
mainPanel(dataTableOutput("mytable"))
)
)
}
# server ----
server <- function(input, output, session){
output$mytable <- renderDataTable({
datatable(company,
caption = tags$caption("StackOverflow Example"),
filter = "none",
options = list(
autoWidth = T,
pageLength = 10,
scrollCollapse = T,
dom = '<"right"l>t<"left"f>')
)
})
}
runApp(list(ui = ui, server = server))
As stated before, my goal is to move l to the top right and f to the bottom left.
Thanks!
Process
In the DataTable DOM positioning reference, there are examples of moving elements to top/bottom, but not left/right. I'm not sure if moving elements left/right is possible using just the dom option.
However, per this question about moving the search box, you can move the elements left/right in three steps:
Make CSS classes
css <- HTML(".pull-left{float: left !important;}
.pull-right{float: right !important;}")
Use javascript/jQuery to add the classes to your datatable
js <- HTML("$(function(){
setTimeout(function(){
$('.dataTables_filter').addClass('pull-left');
$('.dataTables_length').addClass('pull-right');
}, 200);
});")
Add the CSS and JS to the HTML header of your shiny app
fluidPage(
tags$head(tags$style(css),
tags$script(js)),
...)
Full example
library(shiny)
library(DT)
set.seed(2282018)
company <- data.frame(Company = letters[1:10], Sales = scales::dollar(runif(10, 200, 1230)), stringsAsFactors = F)
css <- HTML(".pull-left{float: left !important;}
.pull-right{float: right !important;}")
js <- HTML("$(function(){
setTimeout(function(){
$('.dataTables_filter').addClass('pull-left');
$('.dataTables_length').addClass('pull-right');
}, 200);
});")
# UI ----
ui <- function(){
fluidPage(
tags$head(tags$style(css),
tags$script(js)),
sidebarLayout(
sidebarPanel(numericInput("nums", label = "Num Input", value = 1, min = 1, max = 10)),
mainPanel(dataTableOutput("mytable"))
)
)
}
# server ----
server <- function(input, output, session){
output$mytable <- renderDataTable({
datatable(company,
caption = tags$caption("StackOverflow Example"),
filter = "none",
options = list(
autoWidth = T,
pageLength = 10,
scrollCollapse = T,
dom = '<"top"l>t<"bottom"f>')
)
})
}
runApp(list(ui = ui, server = server))
Related
I am just learning R. I have a small project where a timetable is displayed and the user has the possibility to enter a subject.
My problem: I do not know how to enter a subject (for example "math") in the timetable (dataframe). As soon as the user presses the action button, the subject should be entered in the table at the position ["1", "monday"].
I tried it here by:
output$my_table <- renderDataTable(df())
df <- eventReactive(input$button, {
timetable["1", "monday"] <- input$select1
})
which unfortunately does not work. Any tips and advice on how I can enter something into a table would be greatly appreciated!
This is my Code:
library(shiny)
ui <- fluidPage(
theme = bs_theme(version = 4, bootswatch = "minty"),
titlePanel(h1("My timetable", align = "center" )),
sidebarLayout(
position = c("left"),
sidebarPanel(
width = 4,
selectInput("select1", label = h5("Event:"),
choices = c("math" , "sience", "sport") ,
selected = 1,
width = 400),
actionButton("action", label = "Add")),
mainPanel(
width = 8,
tableOutput('my_table')),
),
)
and the server:
server <- function(input, output, session) {
output$my_table = renderTable({timetable<- data.frame(monday <- c("","","","",""),
tuesday <- c("","","","",""),
wednesday <- c("","","","",""),
thursday <- c("","","","",""),
friday <- c("","","","",""))},
bordered = TRUE,
spacing = c('l'),
width = "100%",
striped = TRUE,
align = 'c',
rownames = TRUE)
output$timetable <- renderDataTable(df())
df <- eventReactive(input$action, { timetable["1","monday"] <- input$select1 })
}
shinyApp(ui, server)
Here is a complete working example that may be helpful.
First, I might define a separate reactiveVal to store your data.frame. This will be accessible in both your table output as well as either observeEvent or eventReactive methods.
When you reference your reactiveVal, use timetable() with parentheses at the end. When you want to replace the data.frame stored in timetable, you can do timetable(new_data_frame_here). In the observeEvent, I created a temporary tmp data.frame that can be used to edit further for convenience.
library(shiny)
library(bslib)
ui <- fluidPage(
theme = bs_theme(version = 4, bootswatch = "minty"),
titlePanel(h1("My timetable", align = "center" )),
sidebarLayout(
position = c("left"),
sidebarPanel(
width = 4,
selectInput("select1", label = h5("Event:"),
choices = c("math" , "sience", "sport") ,
selected = 1,
width = 400),
actionButton("action", label = "Add")),
mainPanel(
width = 8,
tableOutput('my_table')
)
)
)
server <- function(input, output, session) {
timetable <- reactiveVal(
data.frame(monday = c("","","","",""),
tuesday = c("","","","",""),
wednesday = c("","","","",""),
thursday = c("","","","",""),
friday = c("","","","",""))
)
output$my_table = renderTable(timetable(),
bordered = TRUE,
spacing = c('l'),
width = "100%",
striped = TRUE,
align = 'c',
rownames = TRUE)
observeEvent(input$action, {
tmp <- timetable()
tmp[1, "monday"] <- input$select1
timetable(tmp)
})
}
shinyApp(ui, server)
I am currently learning R. I have a small project where a timetable is displayed and the user has the option to enter a subject.
After adding the subject to the timetable, it should be possible to click on it to open the modalDialog.
Unfortunately my code does not work. I have tried it here:
observeEvent(input$mytable_cells_selected, {
showModal(modalDialog(
title = "Somewhat important message",
"This is a somewhat important message.",
easyClose = TRUE,
footer = NULL))
})
Can someone help me and tell where my error is?
ui <- fluidPage(
theme = bs_theme(version = 4, bootswatch = "minty"),
titlePanel(h1("My timetable", align = "center" )),
sidebarLayout(
position = c("left"),
sidebarPanel(
width = 4,
selectInput("select1", label = h5("Event:"),
choices = c("math" , "sience", "sport") ,
selected = 1,
width = 400),
actionButton("action", label = "Add")),
mainPanel(
width = 8,
tableOutput('mytable')),
),
)
and server:
server <- function(input, output, session) {
timetable <- reactiveVal(
data.frame(monday = c("","","","",""),
tuesday = c("","","","",""),
wednesday = c("","","","",""),
thursday = c("","","","",""),
friday = c("","","","",""))
)
output$mytable <- renderTable(timetable(),
bordered = TRUE,
spacing = c('l'),
width = "100%",
striped = TRUE,
align = 'c',
rownames = TRUE,
selection = list(target = 'cell'))
observeEvent(input$action, {
tmp <- timetable()
tmp[1, "monday"] <- input$select1
timetable(tmp)
})
observeEvent(input$mytable_cells_selected, {
showModal(modalDialog(
title = "message",
"This is a somewhat important message.",
easyClose = TRUE,
footer = NULL))
})
}
shinyApp(ui, server)
As mentioned in the comment, you can use the DT library. Here is a complete example.
Use dataTableOutput in your ui for your data table.
In server, you can include renderDataTable and customize here. In this case, selection is set for single cells.
You can capture the selection event (or can capture clicked event) with input$my_table_cells_selected. In my version I used an underscore for my_table. This information will include the row and column values of the cell selected.
Note that the DT data table could be editable and allow for other interactivity, depending on your needs.
library(shiny)
library(bslib)
library(DT)
ui <- fluidPage(
theme = bs_theme(version = 4, bootswatch = "minty"),
titlePanel(h1("My timetable", align = "center" )),
sidebarLayout(
position = c("left"),
sidebarPanel(
width = 4,
selectInput("select1", label = h5("Event:"),
choices = c("math" , "sience", "sport") ,
selected = 1,
width = 400),
actionButton("action", label = "Add")),
mainPanel(
width = 8,
dataTableOutput('my_table')
)
)
)
server <- function(input, output, session) {
timetable <- reactiveVal(
data.frame(monday = c("","","","",""),
tuesday = c("","","","",""),
wednesday = c("","","","",""),
thursday = c("","","","",""),
friday = c("","","","",""))
)
output$my_table = renderDataTable(timetable(), selection = list(mode = "single", target = "cell"))
observeEvent(input$action, {
tmp <- timetable()
tmp[1, "monday"] <- input$select1
timetable(tmp)
})
observeEvent(input$my_table_cells_selected, {
req(input$my_table_cells_selected)
showModal(modalDialog(
title = "message",
paste("This is a somewhat important message:",
input$my_table_cells_selected[1],
input$my_table_cells_selected[2]),
easyClose = TRUE,
footer = NULL))
})
}
shinyApp(ui, server)
# Header
## Load packages
library(shiny)
library(tidyverse)
library(DT)
library(bslib)
ui <- navbarPage("Test",
inverse = T,
collapsible = T,
theme = bs_theme(
version = 4,
bootswatch = "lux",
"font-size-base" = "1rem",
"table-cell-padding" = ".4rem"
),
tabPanel(
title = "Data Tables",
id = "data",
icon = icon("flask"),
fluidRow(
dataTableOutput("DT1")
)
)
)
server <- function(input, output, session) {
output$DT1 <- renderDataTable({
datatable(mtcars,
style = "bootstrap4",
options = list(info = F,
searching = T,
paging = T,
autoWidth = T,
scrollX = T),
filter = list(position = 'top', clear = FALSE),
class = 'cell-border stripe compact',
rownames = F)
})
}
##
shinyApp(ui, server)
I am trying to create a table using the bs_theme() function from the bslib package, specifically using the theme lux. The tables are very large and the cells have massive padding. Adding the "table-cell-padding" argument in bs_theme() doesn't change the cell sizes. How do I make the table compact and the cells tight around the numbers/column names?
Just add tags$style('#DT1 td {padding: 0}'), how simple is that.
# Header
## Load packages
library(shiny)
library(tidyverse)
library(DT)
library(bslib)
ui <- navbarPage("Test",
inverse = T,
collapsible = T,
theme = bs_theme(
version = 4,
bootswatch = "lux",
"font-size-base" = "1rem",
"table-cell-padding" = ".4rem"
),
tabPanel(
title = "Data Tables",
id = "data",
icon = icon("flask"),
fluidRow(
tags$style('#DT1 td {padding: 0}'),
# style = "width: 50%",
dataTableOutput("DT1")
)
)
)
server <- function(input, output, session) {
output$DT1 <- renderDataTable({
datatable(mtcars,
style = "bootstrap4",
options = list(info = F,
searching = T,
paging = T,
autoWidth = T,
scrollX = T),
filter = list(position = 'top', clear = FALSE),
class = 'cell-border stripe compact',
rownames = F)
})
}
##
shinyApp(ui, server)
Change the padding: 0 to any valid css unit you want, here I changed to 0, no padding. It will seem that it doesn't work on left and right, that's because you have autoWidth, it will always use the full width of the parent node. So, if you want the width to be smaller, uncomment the style line above, you should see is't only half of the screen.
library(needs)
needs(
shiny,
ggplot2,
tidyverse,
shinydashboard,
DT
)
source("~/functions.R",local = T)
# Define UI for application that draws a histogram
header = dashboardHeader(
# tags$li(class = "dropdown",
# tags$style(".main-header {max-height: 80px}"),
# tags$style(".main-header .logo {height: 80px}")),
#title = tags$img(src='logo.png',height='100',width='200')
)
sidebar = dashboardSidebar(
menuItem("Full data",tabName="Data",icon=icon("table"),startExpanded = F,
fileInput("file","Upload CSV files",multiple=TRUE,accept=("text/comma"))),
menuItem(text = 'Simulate',tabName = 'simulate',icon=icon('chart-line'),
helpText('Simulation Parameters'),
radioButtons('type',"Please choose the type of analysis:",choices = list("Gender" = 1,"US Minority Status" = 2),selected = 1),
sliderInput("numSims","Number of simulations:",min = 1, max = 10000,step = 1000,value = 10000),
sliderInput("numYears","Number of years to simulate:",min = 1,max = 5,value = 3,step = 1),
numericInput('turnover','Total Turnover', value = 10),
sliderInput('promoRate','Set Promo rate', value = 25, min = 1, max = 100, step = 5),
sliderInput('growthRate','Set growth rate',value = 0,min=0,max=100,step = 1),
helpText('0% Growth Rate assumes a flat, constant headcount'),
actionButton('go',label = "Update"),width = 4)
)
body <- dashboardBody(
tabItems(
tabItem(
tabName = 'data',
fluidRow(wellPanel(
fileInput(
inputId = 'file',
label = "File Upload:",
accept = c("csv", ".csv")))),
wellPanel(DT::dataTableOutput('table'))),
tabItem(
tabName = 'simulate',
fluidRow(
wellPanel(
DT:::dataTableOutput('simDataTable')
))
)
))
ui = shinydashboard::dashboardPage(header,sidebar,body,skin='red')
server = server <- function(input, output) {
options(shiny.maxRequestSize = 30 * 1024 ^ 2)
dataset <- reactive({
req(input$file)
read.csv(input$file$datapath)
})
output$table = renderDataTable(dataset(), filter = 'top',options = list(scrollX = TRUE))
simulate = eventReactive(input$go,{
req(input$numSims,input$type)
x = dataset()
temp = dataSim(x,type=input$type,
numSims = input$numSims)
})
simulateAvg = reactive({
x = simulate()
y = x %>% group_by(Role) %>% summarise(mean(freq))
})
output$simDataTable = renderDataTable(simulateAvg())
}
shinyApp(ui,server)
I'm having some trouble with two issues.
1.) The formatting of the shiny dashboard is odd. The text on the side bar seems very compacted and not what other shiny dashboards look like. I'm not sure what the issue is.
2.) After upload, a table is suppose to appear on the dashboard body but it doesn't
3.) Once a table appears and I head to the simulate tab, will the dashboard body change accordingly and display the simulateAvgData set that I populated?
The dataSim function is from the source file on top. I don't receive any errors when I run anything so looking for guidance and inputs to whether or not this shiny dashboard work as intended. I'm newer to the dashboard packages from shiny.
You have a couple of issues here. You do not need a fileInput statement inside dashboardBody. Next, within dashboardSidebar, you can define fileInput at the top level of menuItem (option 1 in the code below), or a sub-level of the first menuItem (option 2 below). In either case, you need to have a menuItem with a tabName where you want to display the file that was read in. Once you read the input file, you need to select the appropriate tab to see the displayed data. Try this code
header <- dashboardHeader()
### option 1: fileInput at the first menuItem level
# sidebar <- dashboardSidebar(width=320,
# menuItem("Full data",tabName="Data",icon=icon("table"),startExpanded = F),
# fileInput("file","Upload CSV files",multiple=FALSE,accept=c("csv", ".csv"))
# )
### option 2 - fileInput as a subitem
sidebar <- dashboardSidebar(width=320,
menuItem("Full data",tabName="noData",icon=icon("table"),startExpanded = F, ## data not displayed for this tabName
menuItem("Full_data",tabName="Data", icon=icon("table")),
fileInput("file","Upload CSV files",multiple=FALSE,accept=c("csv", ".csv")))
)
body <- dashboardBody(
tabItems(
tabItem(
tabName = 'Data',
fluidRow(DTOutput('table')))
))
ui <- shinydashboard::dashboardPage(header,sidebar,body,skin='red')
server <- function(input, output, session) {
data1 <- reactive({
req(input$file)
data <- read.csv(input$file$datapath,sep = ",", header = TRUE)
})
output$table <- renderDT(data1())
}
shinyApp(ui,server)
Objective
Hi, I have two datasets. I want to select one at a time by using radioButtons in shinydashboard.
Problem
In the app.R file, I first load the two data sets (71 Mb and 103 Mb in size). The following code works and only takes few seconds for app to load:
Working Code:
library(shiny)
library(dplyr)
library(shinydashboard)
# Global
df10151 <- read.csv("Data/df1015.csv", header = TRUE)
df8051 <- read.csv("Data/df805.csv", header = TRUE)
# UI
ui <- dashboardPage(
dashboardHeader(title = "Driving States"),
dashboardSidebar(
sliderInput("fid", "Frame ID:",
min = 0, max = 50, value = 3, step = 0.1
)))
# Server
server <- function(input, output, session) {
}
shinyApp(ui, server)
But when I add the radioButtons, it takes forever and doesn't load:
Failing Code:
library(shiny)
library(dplyr)
library(shinydashboard)
# Global
df10151 <- read.csv("Data/df1015.csv", header = TRUE)
df8051 <- read.csv("Data/df805.csv", header = TRUE)
# UI
ui <- dashboardPage(
dashboardHeader(title = "Driving States"),
dashboardSidebar(
radioButtons("radio", label = h3("Select the Dataset (first 5 minutes)"),
choices = list("US-101" = df10151, "I-80" = df8051),
selected = NULL),
sliderInput("fid", "Frame ID:",
min = 0, max = 50, value = 3, step = 0.1
)))
# Server
server <- function(input, output, session) {
}
shinyApp(ui, server)
There is no error message. What am I doing wrong?
I am not sure what exactly you would like to plot, so here is an example:
Radiobutton in ui.R will work like:
radioButtons("radio", label = h3("Select the Dataset (first 5 minutes)"),
choices = c("US-101" = 1, "I-80" = 2),
selected = 1)
For server.R you need something like:
output$plot = renderPlot({
switch(input$radio,
`1` = hist(df10151$Var),
`2` = hist(df8051$Var)
})