Remove Showing 1 to N of N Entries Shiny DT
You can use the dom option to determine which elements of the data table are shown. In the call to data table, you pass a named list of options to the options argument. dom accepts a character string where each element corresponds to one DOM element.
# only display the table, and nothing else
datatable(head(iris), options = list(dom = 't'))
# the filtering box and the table
datatable(head(iris), options = list(dom = 'ft'))
In your case, i is the table information summary: that's the one you want to leave out. You can also use this method to remove other elements like the search box or pagination controls.
See section 4.2 on this page for how to do this in R: https://rstudio.github.io/DT/options.html
This page in the Datatables manual discusses the DOM option: https://datatables.net/reference/option/dom
R Shiny data table hide the Show Entries label on top of the table but not dropdown box
You can use this option:
datatable(iris, options = list(
language = list(lengthMenu = "_MENU_")
))
Remove 'Show Entries' in datatable
You need to add options = list(lengthChange = FALSE) when you call the function.
For example, if you're using it in a shiny application, you would include something like this in the ui.R part (where you want your table to show up):
dataTableOutput("myTable")
and something like this in the server.R part:
output$myTable <- renderDataTable(df,
options = list(pageLength = 15, lengthChange = FALSE),
rownames= FALSE)
where df is the dataframe you are displaying in the table. (Note that I included a few other options for illustration purposes. Confusingly enough, some of these options, like rownames go outside that options list.) All the available options you can include are here.
DataTable: Hide the Show Entries dropdown but keep the Search box
You can find more information directly on this link: http://datatables.net/examples/basic_init/filter_only.html
$(document).ready(function() {
$('#example').dataTable({
"bPaginate": false,
"bLengthChange": false,
"bFilter": true,
"bInfo": false,
"bAutoWidth": false });
});
Hope that helps !
EDIT : If you are lazy, "bLengthChange": false, is the one you need to change :)
Removing Table entries using remove UI in Shiny
I think your problem can be quiet elegantly solved with modules. See comments in the code for details.
library(shiny)
library(dplyr)
DT <- data.frame(Year = c(1980,1985,1985,1990,1990,1995),
Events = c("Storm", "Earthquake", "Flood", "Draught",
"Earthquake", "Earthquake"),
Area_Loss = c(100, 200, 400, 500, 450,300),
Money = c(1000,2000,3000,4000,5000,6000))
##############################Module#############################
## a module consists of all elements which belong together
## i.e. year, area, money and delete button
## take note about the ns() construct which allows for
## namespacing and through this mechanism we can have several
## instances of this module
YAM_ui <- function(id) {
ns <- NS(id)
fluidRow(
id = id,
h3(id),
column(width = 3,
selectInput(ns("year"),
"Year",
DT$Year,
"")),
column(width = 4,
numericInput(ns("area"),
"Area",
0,
0,
10000,
1)),
column(width = 4,
numericInput(ns("money"),
"Money",
0,
0,
10000,
1)),
column(width = 1,
actionButton(ns("delete"), "Delete"))
)
}
## in the server you can access the elements simply by input$element_name
## we have one input reactive (event) which comes from the main app and
## holds the value of the event selectInput
## we return
## - a killSwitch to signal the main app to delete this module
## - a reactive which returns the data from all inputs organized in a data frame
YAM_server <- function(input, output, session, event) {
killMe <- reactiveVal(FALSE)
observe({
req(input$year)
req(event())
updateNumericInput(session,
"area",
min = 0,
max = 50000,
value = DT$Area_Loss[DT$Year == input$year &
DT$Events == event()] ,
step = 0.1)
updateNumericInput(session,
"money",
min = 0,
max = 50000,
value = DT$Money[DT$Year == input$year &
DT$Events == event()] ,
step = 0.1)
})
get_data <- reactive({
req(!is.null(input$year), !is.null(input$area), !is.null(input$money), event())
data.frame(event = event(),
year = input$year,
area = ifelse(input$area == "", NA, input$area),
money = ifelse(input$money == "", NA, input$money))
})
observeEvent(input$delete,
killMe(TRUE))
return(list(delete = killMe,
get_data = get_data))
}
##############################MainApp##############################
ui <- fluidPage(
titlePanel("Modules"),
sidebarLayout(
sidebarPanel(
h4("Updating Inserted UIs"),
selectInput("events",
"Events",
unique(DT$Events)),
actionButton("add",
"Add"),
tableOutput("table")
),
mainPanel(
tags$div(id = "Panels")
)
)
)
## in the main App we have
## - a reactive (handlers) which holds all reactives of all the modules
## - a list (observers) where we create (and delete) observers for the kill
## switch
## When we add a row, we use insertUI to create the html and callModule
## to switch on the modules server logic. We pass the event reactive to
## the module to make it available within the module.
## When we observe a press to the delete button, we remove the handler
## from the lists and remove the corresponding html via removeUI.
## The data table is then updated automatically, because we removed the handler
## and it is not seen in the loop
## To get the table all we have to do is to loop through all handlers and
## call the get_data reactive from the modules to get the data
server <- function(input, output, session) {
handlers <- reactiveVal(list())
observers <- list()
n <- 1
get_event <- reactive({
input$events
})
observeEvent(input$add, {
id <- paste0("row_", n)
n <<- n + 1
insertUI("#Panels",
"beforeEnd",
YAM_ui(id)
)
new_handler <- setNames(list(callModule(YAM_server,
id,
get_event)),
id)
handler_list <- c(handlers(), new_handler)
handlers(handler_list)
})
observe({
hds <- handlers()
req(length(hds) > 0)
new <- setdiff(names(hds),
names(observers))
obs <- setNames(lapply(new, function(n) {
observeEvent(hds[[n]]$delete(), {
removeUI(paste0("#", n))
hds <- handlers()
hds[n] <- NULL
handlers(hds)
observers[n] <<- NULL
}, ignoreInit = TRUE)
}), new)
observers <<- c(observers, obs)
})
output$table <- renderTable({
hds <- req(handlers())
req(length(hds) > 0)
tbl_list <- lapply(hds, function(h) {
h$get_data()
})
do.call(rbind, tbl_list)
})
}
shinyApp(ui, server)
R shiny datable with styleColorBar not aligning the data on the left hand side
How about the angle parameter in styleColorBar function?
Try this:
dft <- dft %>% formatStyle('WGT',
background = styleColorBar(df[,'WGT'], 'yellow', angle = -90),
backgroundSize = '100% 80%',
backgroundRepeat = 'no-repeat',
backgroundPosition = 'center')
Output :
Remove rows in data table - Shiny
I renamed the special character in the header of your csv file to a simple o in English. Please try this and modify it back to your special character.
library(shiny)
library(dplyr)
library(DT)
library(shinyjs)
library(shinythemes)
getRemoveButton <- function(n, idS = "", lab = "Pit") {
if (stringr::str_length(idS) > 0) idS <- paste0(idS, "-")
ret <- shinyInput(actionButton, n,
'button_', label = "Remove",
onclick = sprintf('Shiny.onInputChange(\"%sremove_button_%s\", this.id)' ,idS, lab))
return (ret)
}
shinyInput <- function(FUN, n, id, ses, ...) {
as.character(FUN(paste0(id, n), ...))
}
ui <- fluidPage(
useShinyjs(),
theme = shinytheme("flatly"),
tabsetPanel(
id = "tabs",
tabPanel("Section 1",
sidebarLayout(
sidebarPanel(
titlePanel("Select Variables"),
uiOutput('fondo'),
uiOutput('reg'),
uiOutput('seguro'),
uiOutput('prod_sap'),
hr(),
actionButton("addbutton","Add")
),
mainPanel(
titlePanel("Preview"),
DTOutput('courseTable'),
)
)
)
)
)
server <- function(input, output, session) {
fondo_edo <- reactive ({
read.csv("C:\\My Disk Space\\_My Work\\RStuff\\GWS\\Fondo-Edo-Reg_example.csv", header=TRUE, sep=",")
})
output$fondo <- renderUI({
req(fondo_edo())
times <- input$addbutton
fondos_todos <- as.vector(unique(fondo_edo()$FONDO))
div(id= letters[(times %% length(letters)) + 1],
selectInput("fondo_selec","Fondo:", choices=fondos_todos,selectize = T))
})
fondo_edo1 <- reactive({
req(fondo_edo(),input$fondo_selec)
subset(fondo_edo(), FONDO %in% input$fondo_selec)
})
output$reg <- renderUI({
req(fondo_edo1())
reg_todos <- as.vector( unique(fondo_edo1()$REGION) )
selectInput("reg_selec","Region:", choices=reg_todos, selectize = F)
})
output$seguro <- renderUI({
times <- input$addbutton
div(id=letters[(times %% length(letters))+1],
selectInput("seguro_selec","Seguro agricultura protegida:", choices=c("","Cosecha_Esp", "Inversión", "Planta"), selectize = F))
})
output$prod_sap <- renderUI({
times <- input$addbutton
div(id=letters[(times %% length(letters))+1],
conditionalPanel("input.seguro_selec == 'Inversión'",
selectInput("prod_sap_selec","Nombre producto SAP:", choices= "Tradicional")),
conditionalPanel("input.seguro_selec != 'Inversión'",
selectInput("prod_sap_selec2","Nombre producto SAP:",choices = c("","Establecimiento", "Mantenimiento", "Producción"), selectize = F)))
})
values <- reactiveValues()
observe({
n <- nrow(fondo_edo())
values$df <- tibble(
Row = 1:n,
id = 1:n) %>%
rowwise() %>%
mutate(Remove = getRemoveButton(id, idS = "", lab = "Tab1")) %>% add_column(fondo_edo())
})
proxyTable <- DT::dataTableProxy("df")
output$courseTable <- renderDT({
DT::datatable(values$df,
options = list(pageLength = 25,
dom = "rt"),
rownames = FALSE,
escape = FALSE,
editable = TRUE)
})
buttonCounter <- isolate(nrow(fondo_edo()))
observeEvent(input$addbutton, {
req(input$fondo_selec, input$reg_selec,input$seguro_selec,input$prod_sap_selec2)
buttonCounter <<- buttonCounter + 1L
myTable <- isolate(values$df)
myTable <- bind_rows(
myTable,
tibble(Row = nrow(myTable) + 1) %>%
mutate(id = buttonCounter,
Remove = getRemoveButton(buttonCounter, idS = "", lab = "Tab1")) %>%
add_column(CLAVE.FONDO = 3, CVE_REGION = 66,
Nom_Region = ifelse(input$seguro_selec=="Planta", paste0(input$seguro_selec,"/",input$prod_sap_selec2),input$seguro_selec),
FONDO = input$fondo_selec, REGION = input$reg_selec)
)
replaceData(proxyTable, myTable, resetPaging = FALSE)
values$df <- myTable
})
observeEvent(input$remove_button_Tab1, {
myTable <- values$df
s <- as.numeric(strsplit(input$remove_button_Tab1, "_")[[1]][2])
myTable <- filter(myTable, id != s)
replaceData(proxyTable, myTable, resetPaging = FALSE)
values$df <- myTable
})
}
runApp(shinyApp(ui,server))
R Shiny app - Render Data Table with double header
Adapting the provided example :
# a custom table container
sketch = htmltools::withTags(table(
class = 'display',
thead(
tr(
th(colspan = 1, ''),
th(colspan = 3, 'Vintage')
),
tr(
lapply(colnames(df), th)
)
)
))
DT::datatable(df, container = sketch, ...
Related Topics
How to Read Specific Rows of CSV File with Fread Function
Count the Number of Unique Characters in a String
Reshape Multi Id Repeated Variable Readings from Long to Wide
Error in File(File, "Rt"):Invalid 'Description' Argument in Complete.Cases Program
Any Way to Force Fread() of Data.Table Not to Stop on Empty Lines
Correctly Color Vertices in R Igraph
Showing Equation of Nls Model with Ggpmisc
How to Declare a Thousand Separator in Read.Csv
Remove "Showing 1 to N of N Entries" Shiny Dt
Add Raster to Ggmap Base Map: Set Alpha (Transparency) and Fill Color to Inset_Raster() in Ggplot2
Extract Digit from Numeric in R
Find Matching Strings Between Two Vectors in R
How Does R Handle Unicode/Utf-8
Large-Scale Regression in R with a Sparse Feature Matrix