Makinet
Makinet

Reputation: 3

Why is my custom css not getting applied?

I want to output a table with renderDT in a R Shiny app with the scrollbar at the top. To this end, I have already found this question, whose solution copied in 1:1 would also work for me. R DT Horizontal scroll bar at top of the table

However, my app is structured differently, namely with shinydashboard and various modules in separate files. Unfortunately, I do not manage to implement it correctly with that structure.

Here is the minimum code that hopefully allows you to just help me. It consists of two files in the same folder. You have to click on the "Test" tab and then on "Tab1" to see the table.

test1.R:

library(shiny)
library(shinydashboard)
library(DT)

source(file.path(".", "test2.R"))

flipped_scroll_css <- HTML(
  "#mtcars_table > .dataTables_wrapper.no-footer > .dataTables_scroll > .dataTables_scrollBody {
      transform:rotateX(180deg);
  }
  #mtcars_table > .dataTables_wrapper.no-footer > .dataTables_scroll > .dataTables_scrollBody table{
      transform:rotateX(180deg);
  }"
)


js_on_window_close <- "shinyjs.closeWindow = function() { window.close(); }"


# Shiny dashboard

header <- dashboardHeader(title = "Test", 
                          tags$li(class = "dropdown", 
                                  style = "padding: 8px;"
                          )
)

sidebar <- dashboardSidebar(div(htmlOutput("welcome_text"), style = "padding: 20px"),
                            sidebarMenu(id = "left_sidebarMenu",
                                        menuItem(HTML("&nbsp;&nbsp; Test"),
                                                 menuSubItem(HTML("&nbsp;&nbsp; Tab1"), tabName = "tab1_menuSubItem",
                                                             icon = icon(name = "gauge-high", class = NULL, lib = "font-awesome")),
                                                 startExpanded = FALSE, icon = icon(name = "squarespace", class = NULL, lib = "font-awesome")
                                                 ),
                                        tags$head(tags$style(flipped_scroll_css))

                            ),
                            collapsed = FALSE
)


body <- dashboardBody(
  
  # Main UI is rendered
  uiOutput("test_rendered_UI")
  
)


#-------------------------------------------------------------------------------


# Shiny ui

ui <- dashboardPage(header, 
                    sidebar, 
                    body, 
                    skin = "blue")

# ------------------------------------------------------------------------------------------------

# Shiny server

server <- function(input, output, session) {
  
  #-----------------------------------------------------------------------------
  
  # Render main UI for modules
  
  
  output$test_rendered_UI <- renderUI({
    
    # Main UI
    tabItems(
      
      # Tab: Daten-Überblick
      tabItem(tabName = "tab1_menuSubItem", 
              
              # UI logic
              fluidRow(
                
                column(8, 
                       tab1_UI(id = "tab1")
                )
              )
      )
      
    )
  })
    
  tab1_Server("tab1",
              var1 = mtcars)
  
}

shinyApp(ui, server)  

test2.R

tab1_UI <- function(id) {
  
  ns <- NS(id)
  
  tagList(
    
    fluidRow(
      
      column(5,
             
             DT::DTOutput(outputId = ns("mtcars_table"))
             
             )
      
    )
    
  )
  
}


tab1_Server <- function(id, var1) {
  
  moduleServer(id,
               function(input, output, session) {
                 
                 output$mtcars_table <- DT::renderDT({
                   
                   # as.data.table(var1)
                   # datatable(mtcars)
                   
                   var1 %>%

                     datatable(options = list(lengthChange = FALSE,
                                              pageLength = 10,
                                              searchHighlight = TRUE,
                                              scrollX = TRUE),
                               rownames = FALSE,
                               escape = FALSE,
                               selection = "none")

                 })
                 
               }                
                 
                 )
    
}

I tried to put tags$head(tags$style(flipped_scroll_css)) in several places. Inside sidebarMenu, inside menuItem, inside menuItem and nothing happened. Means, the scrollbar still remains at the bottom.

What I did manage to do is to implement it without the menuSubItems and where everything is in one file. But the structure is as described before and can due to its size and complexity not simply be altered.

Nevertheless, here is the working minimum code with shinydashboard, that hopefully makes it easier for you to help me.



library(shiny)
library(shinydashboard)
library(DT)

css <- HTML(
  "#mtcars_table > .dataTables_wrapper.no-footer > .dataTables_scroll > .dataTables_scrollBody {
        transform:rotateX(180deg);
    }
    #mtcars_table > .dataTables_wrapper.no-footer > .dataTables_scroll > .dataTables_scrollBody table{
        transform:rotateX(180deg);
    }"
)




header <- dashboardHeader(title = "My Page")
sidebar <- dashboardSidebar(sidebarMenuOutput("sideBar_menu_UI")
                            # , tags$head(tags$style(css))
                            )
body <- dashboardBody(
  uiOutput("test_UI")
)

ui <- dashboardPage(header, 
                    sidebar, 
                    body, 
                    skin = "blue")



server <- function(input, output, session) { 
  output$sideBar_menu_UI <- renderMenu({
    sidebarMenu(id = "sideBar_Menu",
                menuItem("Menu 1", tabName="menu1_tab", icon = icon("database"))
                , tags$head(tags$style(css))
    )
  }) 
  output$test_UI <- renderUI ({
    tabItems(
      tabItem(tabName = "menu1_tab", DTOutput("mtcars_table"))
    )
  })
  
  output$mtcars_table <- renderDT({
    datatable(mtcars, options = list(scrollX = TRUE
                                     ))
  })
  
}

runApp(list(ui= ui, server = server))


Upvotes: 0

Views: 50

Answers (0)

Related Questions