I created a data table in Shiny with the first column editable. I can enter texts but they will disappear after I switch input values and then come back. For example, I entered "testing 001" for the Category of "Male Premium BladeRazor System" and everything seemed fine (see the picture). However, after I switch my Category to another value and then come back to "Male Premium BladeRazor System", the entered text of "testing 001" would be gone. My code is pretty long, and I cut part of it for your reference. Any help will be highly appreciated. Thanks.
Example of text edits
output$tabofrandom <- DT::renderDataTable(
if (is.null(names(tab7data$dat))) {
datatable(tab7data$dat)
}
else {
datatable(isolate(tab7data$dat),
editable = list(target = 'cell', disable = list(columns = c(1,2, 3, 4,5,6,7,8,9))),
rownames = FALSE,
selection = list(mode = "single", target = "row", selected = previousSelection),
extensions = c('Buttons'),
options = list(searching=FALSE,
scrollX=T,
scrollY=277,
#processing=FALSE,
autoWidth = TRUE,
displayStart = previousPage,
dom = 'Blfrtip',
# pageLength = 5,
lengthChange = FALSE,
lengthMenu = list(c(5,10, -1), c("5","10", "All")),
buttons = list(c('pageLength','excel'),list(extend = 'colvis')),
# buttons = c('excel','colvis'),
columnDefs=list(list(targets=c(2,4,5,8),
render = JS("function(data){return data.replace(/;/g,
'<br>');}")),
...
))
) %>%
formatStyle(1:10, 'text-align' = 'left') %>%
formatStyle(1:10, 'vertical-align'='top')
} )
...
observeEvent(input[["tabofrandom_cell_edit"]], {
info <- input[["tabofrandom_cell_edit"]]
info$col=info$col+1
previousSelection <<- input$tabofrandom_rows_selected
previousPage <<- input$tabofrandom_rows_current[1] - 1
tab7data$dat<-isolate(DT::editData(tab7data$dat,info))
})
...
You have to set the server option of renderDataTable to FALSE or to use a proxy:
proxy <- DT::dataTableProxy("tabofrandom")
observeEvent(input[["tabofrandom_cell_edit"]], {
info <- input[["tabofrandom_cell_edit"]]
......
tab7data$dat <- DT::editData(tab7data$dat, info, proxy)
})
You don't have to do info$col + 1 for editData.
Related
The first column of the datatable consits of names, while the second column uses characters which are a combination of numeric with comma delimiters, and characters for other values, for example, "1,000" , "2,000", "19,000", "Data missing", "Data suppressed". Using type = "num-fmt" I am able to get the datatable to display correctly when I run it as a function by itself, i.e. "1,000", "2,000", "19,000", and when using sort in the Rstudio terminal its ordering is correct, and as such when first displayed in the R shiny app it works. However, when using the sort options in the shiny interface, the ordering no longer works correctly, i.e. "1,000" , "19,000" , "2,000".
My understanding is that I must do the sorting in the server, or use java script, but I don't know how.
ui <- dashboardPage(
box(title = "Industries from selected region",
status = "danger",
solidHeader = TRUE,
DT::dataTableOutput("industry_tbl"),
width = 6)
)
server <- function(input, output, session) {
values <- reactiveValues(direction = "Exports",
year = "2020",
partner_country = "Spain",
industry = "Mining",
home_country = "UK")
output$industry_tbl<- DT::renderDT({
industry_table_server(new_data,
values$year,
values$partner_country,
values$direction,
values$home_country)
})
function:
industry_table_server <- function(dataset,
selected_year,
selected_country,
selected_direction,
selected_region){
this_selection <- dplyr::filter(dataset,
Year == selected_year,
Country == selected_country,
Direction == selected_direction,
`Area name` == selected_region) %>%
select(Industry, value)
DT::datatable(this_selection ,
colnames = c("Industry",
paste0("£millions")),
filter = "none",
rownames = TRUE,
extensions = c('Buttons'),
options = list(
dom = 'Bftip',
buttons = c('copy', 'excel', 'print'),
searchHighlight = TRUE,
searchDelay = 0,
selection = "single",
pageLength = 10, # Shows 10 results
lengthMenu = c(5, 10),
columnDefs = list(list(className = 'dt-right', targets = c(0,2)), list(targets = c(2), type = "num-fmt"))
)
)
} ```
As said in the datatables website, regarding the type option:
Please note that if you are using server-side processing this option has no effect since the ordering and search actions are performed by a server-side script.
So you have to set server = FALSE in renderDT:
output$industry_tbl <- renderDT({
industry_table_server(new_data,
values$year,
values$partner_country,
values$direction,
values$home_country)
}, server = FALSE)
I created a datatable in a flexdashboard with a checkbox, but the checkbox flows off the page. I tried to adjust the padding {data-padding = 10} but nothing changed. Below is the code and a picture of what the dashboard looks like. How do I move everything to the right so that it's aligned with the title of the page?
---
title: "School Dashboard"
author: "Shannon Coulter"
output:
flexdashboard::flex_dashboard:
orientation: rows
social: menu
source_code: embed
theme: spacelab
---
```{r}
library(tidyverse)
library(crosstalk)
library(DT)
library(flexdashboard)
```
Student Lookup
================================================================================
### Chronic Absenteeism Lookup
```{r ca-lookup, echo=FALSE, message=FALSE, warning=FALSE}
ican_tab <- tibble(
year = c("2022", "2022", "2022", "2022", "2022"),
date = c("March", "March","March","March","March"),
school = c("ABC", "CDE","ABC","DEF","GHI"),
grade = c("6th", "7th","8th","4th","5th"),
race_eth = c("White", "Hispanic","White","Filipino","White"),
abs_levels = c("Not At-Risk of Chronic Absenteeism", "At-Risk of Chronic Absenteeism",
"Severe Chronic Absenteeism", "Severe Chronic Absenteeism",
"Moderate Chronic Absenteeism")
)
sd <- SharedData$new(ican_tab)
bscols(list(
filter_checkbox("abs_levels", "Level", sd, ~ abs_levels, inline = TRUE),
datatable(
sd,
extensions = c("Buttons",
"Scroller"),
options = list(
autoWidth = TRUE,
scrollY = F,
columnDefs = list(list(
className = 'dt-center',
targets = c(2, 3, 4, 5)
)),
lengthMenu = c(5, 10, 25, 100),
dom = "Blrtip",
deferRender = TRUE,
scrollY = 300,
scroller = TRUE,
buttons = list('copy',
'csv',
'pdf',
'print')
),
filter = "top",
style = "bootstrap",
class = "compact",
width = "100%",
colnames = c(
"Year",
"Date",
"School",
"Grade",
"Race",
"Level"
)
) %>%
formatStyle('abs_levels',
backgroundColor = styleEqual(
unique(ican_tab$abs_levels),
c(
"#73D055ff",
"#95D840FF",
"#B8DE29FF",
"#DCE319FF"
)
))
))
```
[![enter image description here][1]][1]
The easiest way to address this is probably to add style tags to your dashboard. You can put this anywhere. I usually put it right after the YAML or right after my first R chunk, where I just place my knitr options and libraries. This does not go inside an R chunk.
<style>
body { /*push content away from far right and left edges*/
margin-right: 2%;
margin-left: 2%;
}
</style>
Update based on your updated question and comments
I don't have the content around your table, so I will give you a few options that work. For the most part, any one option won't be enough. You can mix and match the options that work best for you.
This is what I've got for the original table:
Option 1: you can use CSS to push the table away from the edges (as in my original response
Option 2: change the font sizes
Option 3: constrain the size of the datatable htmlwidget
Option 4: manually make the columns narrower
Option 5: alter the filter labels (while keeping the same filters and data)
Aesthetically looks the best? It depends on what else is on the dashboard.
I think you will need the original CSS (option 1, in my original answer) regardless of what other options you choose to use.
Option 1 is above
Option 2
To change the font sizes, you have to modify the filter_checkbox and the datatable after they're made. Instead of presenting all of the programming code, I'm going to show you want to add or modify and how I broke down the objects.
Your original code for filter_checkbox remains the same. However, you'll assign it to an object, instead of including it in bscols.
Most of the code in your datatable will remain the same. there is an addition to the parameter options. I've included the original and change for that parameter.
# filter checkbox object
fc = filter_checkbox(...parameters unchanged...)
fc$attribs$style <- css(font.size = "90%") # <-change the font size
dt = datatable(
...
...
options = list( # this will be modified
autoWidth = TRUE, # <- same
scrollY = F, # <- same
initComplete = JS( # <- I'M NEW! change size of all font
"function(settings, json) {",
"$(this.api().table().container()).css({'font-size': '90%'});",
"}"),
columnDefs = list( # <- same
list(className = 'dt-center', targets = c(2, 3, 4, 5))),
...
... # remainder of datatable and formatStyles() original code
)
# now call them together
bscols(list(fc, dt))
The top version is with 90% font size, whereas the bottom is the original table.
Option 3
To constrain the size of the datatable widget, you'll need to create the object outside of bscols, like I did in option 2. If you were to name your widget dt as in my example, this is how you could constrain the widget size. This example sets the datatable to be 50% of the width and height viewer screen (or 1/4 of the webpage). Keep in mind that the filters are not part of the widget, so in all, the table is still more than 1/4th of the webpage. You will have to adjust the size for your purposes, of course. I recommend using a dynamic sizing mechanism like vw, em, rem, and the like.
dt$sizingPolicy$defaultWidth <- "50vw"
dt$sizingPolicy$defaultHeight <- "40vh"
The top image has options 1, 2, and 3; the bottom is the original table.
Option 4
To modify the width of the columns, you can add this modification to the parameter options in you call to datatable. This could be good, because most of the columns don't require as much width as the last column. However, if you change the font size or scale the table, it will change the font size dynamically, so this option may not be necessary.
Despite using em here, in the course of this going from R code to an html_document, it was changed to pixels. So this is not dynamically sized. (Not a great idea! Sigh!)
columnDefs = list(
list(className = 'dt-center', targets = c(2, 3, 4, 5)),
list(width = '5em', targets = c(1,2,3,4,5))), # <- I'm NEW!
Option 5
For this option, I took the programming behind crosstalk::filter_checkbox() and modified the code a bit. I changed the function to filter_checkbox2(). If you use it, you can render it both ways and just keep the one you like better.
This first bit of code is the three functions that work together to create a filter_checkbox object with my modifications so that you can have a label that isn't exactly the same as the levels.
It's important to note that the filters are alphabetized by datatable. It doesn't matter if they're factors, ordered, etc. If you use this new parameter groupLabels, they need to be in an order that aligns with the levels when they're alphabetized.
I put this code in an include=F chunk by itself:
# this is nearly identical to the original function
filter_checkbox2 = function (id, label, sharedData, group,
groupLabels = NULL, # they're optional
allLevels = FALSE, inline = FALSE, columns = 1) {
options <- makeGroupOptions(sharedData, group,
groupLabels, allLevels) # added groupLabels
labels <- options$items$label
values <- options$items$value
options$items <- NULL
makeCheckbox <- if (inline)
inlineCheckbox
else blockCheckbox
htmltools::browsable(attachDependencies(tags$div(id = id,
class = "form-group crosstalk-input-checkboxgroup crosstalk-input",
tags$label(class = "control-label", `for` = id, label),
tags$div(class = "crosstalk-options-group",
crosstalk:::columnize(columns,
mapply(labels, values, FUN = function(label, value) {
makeCheckbox(id, value, label)
}, SIMPLIFY = FALSE, USE.NAMES = FALSE))),
tags$script(type = "application/json", `data-for` = id,
jsonlite::toJSON(options, dataframe = "columns",
pretty = TRUE))),
c(list(crosstalk:::jqueryLib()),crosstalk:::crosstalkLibs())))
}
inlineCheckbox = function (id, value, label) { # unchanged
tags$label(class = "checkbox-inline",
tags$input(type = "checkbox",
name = id, value = value),
tags$span(label))
}
# added groupLabels (optional)
makeGroupOptions = function (sharedData, group, groupLabels = NULL, allLevels) {
df <- sharedData$data(withSelection = FALSE, withFilter = FALSE,
withKey = TRUE)
if (inherits(group, "formula"))
group <- lazyeval::f_eval(group, df)
if (length(group) < 1) {
stop("Can't form options with zero-length group vector")
}
lvls <- if (is.factor(group)) {
if (allLevels) {levels(group) }
else { levels(droplevels(group)) }
}
else { sort(unique(group)) }
matches <- match(group, lvls)
vals <- lapply(1:length(lvls), function(i) {
df$key_[which(matches == i)]
})
lvls_str <- as.character(lvls)
if(is.null(groupLabels)){groupLabels = lvls_str} # if none provided
if(length(groupLabels) != length(lvls_str)){ # if the # labels != the # groups
message("Warning: The number of group labels does not match the number of groups.\nGroups were used as labels.")
groupLabels = lvls_str
}
options <- list(items = data.frame(value = lvls_str, label = groupLabels, # changed from lvls_str
stringsAsFactors = FALSE), map = setNames(vals, lvls_str),
group = sharedData$groupName())
options
}
When I used this new version of I changed label = "Level" to label = "Chronic Absenteeism Level". Then removed " Chronic Absenteeism" from the filter labels. The data and the datatable does not change, just the filter checkbox labels.
filter_checkbox2("abs_levels", "Chronic Absenteeism Level",
sd, ~ abs_levels, inline = TRUE,
groupLabels = unlist(unique(ican_tab$abs_levels)) %>%
str_replace(" Chronic Absenteeism", "") %>% sort())
The first image is your table with options 1, 2, 3, and 5 (not 4).
The top version in the next image has options 1, 2, 3, and 5 (not 4). The bottom is the original table. After that
If I've left anything unclear or if have any other questions, let me know.
please I have the following code to display a datatable:
fluidRow(column(3,
dataTableOutput(outputId="table01", width = '100px')))
and this is how the rendered table is created:
output$table01 <- DT::renderDataTable({
df <- get_mp_data()
if(is.null(df)){
df <- data.frame()
}else{
upcolor = "lightblue"
downcolor = "lightblue"
col_name = "CHG"
df <- datatable(df
, rownames = FALSE
, caption = paste0("Pre/Post Duration")
, filter = 'none'
, options = list(scrollX = F
#, lengthChange = FALSE # this feature hides the "Show Entries" on top of the table, so we won't be able to customize how many entries we can see all together
, pagingType = "numbers" # this hides the Next and Previous buttons --> https://datatables.net/reference/option/pagingType
, autoWidth = T
,pageLength = 5 # this determines how many rows we want to see per page
, info = FALSE # this will hide the "Showing 1 of 2..." at the bottom of the table --> https://stackoverflow.com/questions/51730816/remove-showing-1-to-n-of-n-entries-shiny-dt
,searching = FALSE # this removes the search box -> https://stackoverflow.com/questions/35624413/remove-search-option-but-leave-search-columns-option
,columnDefs = list(list(width = '4', targets = c(3) )
,list(width = '4', targets = c(2) )
) # careful, column counting STARTS FROM 0 !
)) %>%
formatStyle(col_name,
#background = styleColorBar(range(df[, c(col_name)]), 'lightblue'),
background = color_from_middle(df[, c(col_name)] , downcolor, upcolor),
backgroundSize = '98% 88%',
backgroundRepeat = 'no-repeat',
backgroundPosition = 'center')
}
return(df)
})
The problem with this code is that it shows "Show Entries" on the top left hand side of the table that takes a lot of useless space. I would like to only keep the dropdown and hide the text "Show Entries".
I couldn't find anything here # https://datatables.net/reference/option about this.
Notice how I don't want to use "lengthChange = FALSE" since this will also hide the dropdown box that allows to customize how many rows can be displayed all together.
Thank you
You can use this option:
datatable(iris, options = list(
language = list(lengthMenu = "_MENU_")
))
I am using in Shiny Buttons extension to download figures in a Excel-File.
DTa <- data.table(
dataSum()[,1],
format(round((10^-6)*dataSum()[,-1],2),nsmall = 2,decimal.mark=",",big.mark=".")
)
DTa<- DT::datatable( DTa, extensions=c("Buttons"),options = list(paging = FALSE,
searching = FALSE,
dom = 'Bfrtip',
#buttons = c('copy','excel')
buttons = list(
list(
extend = 'excel',
text = "Save ",
title = 'KRB'
), list(
extend = 'copy', title = 'krb'
)
)
),
caption= paste("Stichtag:",
as.character(sub("([0-9]{2})([0-9]{2})([0-9]{4})KRB.csv", "\\1.\\2.\\3",input$date))))
In the first part above, I transform the figures in the German format, i.e., I set , as a decimal separator and . as a thousands separator. In the second part, I call the extensions Buttons of DT.
In Shiny, the figures look as follows:
Problem: After pressing the Save Button in Shiny, all figures with just , and without . have the wrong format.
For example, after saving 34,21 becomes 3.421! But 67.809,97 is correct!
How can I keep the format of the figures during the export or save process?
I don't know if it helps:
When I change into the debug mode and execute the second part DTa<- DT::datatable( DTa, extensions ... I see the following:
As one can see the figures in data are characters!
Is it possible to write a JavaScript function in my server.R to use the language.decimal option? There is an example here, however I cannot use it exactly.
Try this
DTa<- DT::datatable(DTa, extensions=c("Buttons"), options = list(paging = FALSE,
searching = FALSE,
dom = 'Bfrtip',
#buttons = c('copy','excel')
buttons = list(
list(
extend = 'excel',
text = "Save ",
title = 'KRB'
), list(
extend = 'copy', title = 'KRB'
)
)
),
caption= paste("Stichtag:",
as.character(sub("([0-9]{2})([0-9]{2})([0-9]{4})KRB.csv", "\\1.\\2.\\3",input$date)))
) %>% formatCurrency(-1,' ', digits = 2 , interval = 3, mark = ".", dec.mark = ",")
I am trying to set the width of columns in a DataTable rendered in Shiny and am not able to implement it using the aoColumnDefs options. Has anyone tried this before ? My table has 1 text followed by 3 numeric columns. The numeric columns need to be narrower and the 1st column (text) wider.
output$result <- renderDataTable({
z <- as(dataInput(), "data.frame")
setnames(z, c("Rules", "Support", "Confidence", "StatDep"))
z
}, options = list(aLengthMenu = c(5, 30, 50), iDisplayLength = 5, bSortClasses = TRUE,
aoColumnDefs = list(sWidth = "50px", aTargets = list(1))))
Thanks,
Raj.
** Update ** This seems to be working, but there might be other options to do this as well.
output$result <- renderDataTable({
z <- as(dataInput(), "data.frame")
setnames(z, c("Rules", "Support", "Confidence", "StatDep"))
z
}, options = list(aLengthMenu = c(5, 30, 50), iDisplayLength = 5, bSortClasses = TRUE,
bAutoWidth = FALSE,
aoColumn = list(list(sWidth = "150px", sWidth = "30px",
sWidth = "30px", sWidth = "30px"))
))
Try this
#OUTPUT - dtdata
output$table <- DT::renderDataTable({
data.frame(a=c(1,2,3,4,5),b=c("A","B","C","D","E"))
},
options = list(
autoWidth = TRUE,
columnDefs = list(list(width = '200px', targets = "_all"))
))
Sets the width of all columns to 200px.
To set width of selected columns, change targetsto a number or vector.
targets = c(1,3)
By the way, in case you're like me and never used DataTables before version 1.10 came out -- The examples above confused me at first, because they use the notation that was used in version 1.9 but 1.10 introduces new notation:
http://datatables.net/upgrade/1.10-convert
I've been using the new syntax, i.e.,
columnDefs instead of aoColumnDefs
http://datatables.net/reference/option/columnDefs
width instead of sWidth
http://datatables.net/reference/option/columns.width
etc.