R datatable row padding size modification - css

I have a small R shiny app
https://kormir.shinyapps.io/dt_test/
library(shiny)
library(DT)
ui <- fluidPage(
column(4,
br(),
br(),
dataTableOutput('dt1')
)
)
server <- function(input, output) {
output$dt1 <- renderDataTable({
datatable(mtcars[1:4,1:4])
})
}
shinyApp(ui = ui, server = server)
In uses the datatable package to create dynamic tables.
I would like to reduce the internal paddings but by css skills aren't good enough to do so.
I need to remove that yellow area or make it very very small.
For instance I figured out the class of the rows and tried to force the size of these paddings to 0.
.odd {
background-color: red!important;
border-collapse: collapse!important;
padding: 0!important;
border : 0px !important;
}
It does not work...

Edit
My initial solution did not account for the interactive changes to the table while in session. The following js injection upon DataTables initialization function(){$('tbody td').css({'padding': '0px'});} applies the padding change to the initial state of the table but any changes such as sorting and pagination would cause the table to revert back to its initial display setting.
How about injecting some javascript upon DataTables initialization with the initComplete argument in Options?
For this, you must have the package htmlwidgets installed so you can use the JS() function. JS() treats strings as javascript code.
DT::datatable() has an options argument that corresponds to the Options in DataTables. options takes a list of named arguments in DataTables Options.
In options, supply a named list with the initComplete argument. In there, inject some js with htmlwidgets::JS() and the js callback will be executed upon your DataTables initialization.
DataTables has some default styling options, including one called compact. Here is what enabling the compact styling option does (quote from here):
Reduce the amount of white-space the default styling for the DataTable uses, increasing the information density on screen
OK, so next step is to add the class compact to your DataTables object in the DOM like so:
The js portion that matters is:
function(){$(this).addClass('compact');}
$(...) is jQuery's syntax to access elements in the DOM. What goes inside $(...) is the selector of the DOM element you want to select. Fortunately, because you are injecting this js code in the DataTables event, you can use the this selector to refer to the table. The next method is addClass(). It does what it says: it adds a class to the selected object in the DOM. You want to add the class compact to your table and then DataTables will take care of the rest.
Ok, here is the code:
library(shiny)
library(DT)
ui <- fluidPage(
column(4,
br(),
br(),
dataTableOutput('dt1')
)
)
server <- function(input, output) {
output$dt1 <- renderDataTable({
datatable(mtcars,
options = list(
initComplete = JS(
"function(){$(this).addClass('compact');}")
)
)
})
}
shinyApp(ui = ui, server = server, options = list(launch.browser=TRUE))
Result:
After changing pagination and sorted by cyl:
compact styling still applies.

Related

R Shiny HTML object is rendered on every tabPanel()

I am trying to create a shiny app where users can upload their own data and get a visualization of the network dynamics in their data. I'm using the render.d3movie() function from the ndtv package to create an HTML object from the network with some user input parameters. I want to display this HTML object in one of my tabPanel()s but weirdly, it shows up on every panel instead. I tried with a different HTML file and this one works just fine. To reproduce this, you'll need to download the test and network animation html files and put them in the same directory as the example shiny app code below.
Example:
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
navbarPage("ShinyExample",
tabPanel("TEST", HTML("FirstPage"), includeHTML("test.html")),
tabPanel("TEST2", HTML("SecondPage"), includeHTML("NetworkAnimation.html"))
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
# Stuff to render and save the network Animation happens here
}
# Run the application
shinyApp(ui = ui, server = server)
Expected Behavior:
test.html and NetworkAnimation.html should only be rendered within their respective tabPanel()
Observed Behavior:
test.html is only rendered in it's respective tabPanel() but NetworkAnimation.html is rendered on both tabPanel() s
The network-widget is appended to the body in the NetworkAnimation.html-Javascript:
target = d3.select('body').append('div').style({width: '100%', height: '100%'}).node();.
If you want it to be on Tab 2 only, you can include a div with id and change the JavaScript line, so that it gets appended to your div.
My App looks like this:
ui <- fluidPage(
## Include shinyjs
useShinyjs(),
## Set ID of navbarPage
navbarPage("ShinyExample", id = "navid",
tabPanel("TEST", includeHTML("test.html")),
tabPanel("TEST2",
## Include new DIV here & Set initial height
div(id="appendhere", style="height: 1090px;"),
includeHTML("NetworkAnimation.html"))
)
)
server <- function(input, output) {
observe({
req(input$navid == "TEST2")
runjs('$("#appendhere").resize()')
})
}
# Run the application
shinyApp(ui = ui, server = server)
and the JS is changed to
target = d3.select('#appendhere').append('div').style({width: '100%', height: '100%'}).node();
I also had to include shinyjs, to run some JavaScript when TAB2 is active. The width/height of the svg is calculated when it is rendered and therefore initially 0 (or actually -60).
If you remove the runjs line, you will see that the network is not visible.
By changing the browser size, the network gets redrawn and width/height are updated. Therefore we call $("#appendhere").resize() when TAB2 is active.
There is still the following error in the browser console, but everything seems to work fine.
Uncaught TypeError: a is undefined

R Shiny: Is there a way to check if a button is disabled using shinyjs package?

Is there a way to check if a download button is disabled using the shinyjs R package? I want to use shinyjs or something similar because they have very easy syntax. This is my package:
server.R:
library(shiny)
library(shinyjs)
library(shinyBS)
shinyServer(function(input, output) {
observe({
shinyjs::disable("download1")
if(shinyjs::is.disabled("download1")){ ## This is what I am trying to do
# Do something
}
})
})
ui.R
shinyUI(fluidPage(
downloadButton("download1")
))
Not directly (well, not easily*).
Buttons can only be disabled when you decide to disable them, so you can have some sort of a reactive variable that holds whether or not the button should be disabled, and whenever you disable the button, you also change the value of that variable. In order to make sure they stay in sync, every time you want to disable the button you can set the variable to mirror that, and then you can use shinyjs::toggleState(condition = variable) so that the disabled state will mirror what the variable says.
Example code to illustrate what I mean:
library(shiny)
ui <- fluidPage(
shinyjs::useShinyjs(),
numericInput("num", "When divisible by 3, disable the button", 1),
actionButton("btn", "button")
)
server <- function(input, output, session) {
values <- reactiveValues(disable = FALSE)
observe({
values$disable <- (input$num %% 3 == 0)
})
observe({
shinyjs::toggleState("btn", condition = !values$disable)
})
}
shinyApp(ui = ui, server = server)
In this app, whenever you want to disable the button, simply set values$disable to FALSE and to enable the button set it to TRUE. To check if the button is currently on or off at any point in time, you can look at the value of values$disable.
*I'm guessing that you wanted a more direct approach to ask the app a question in real time "hey shiny, is button X currently disabled?". You can do that, but it would involve writing custom javascript code to check for the button state, and for custom code to ask javascript that question and to listen for its response. This would work and be guaranteed to be correct, but it's likely overkill for most cases.

Is it possible to have a Shiny ConditionalPanel whose condition is a global variable?

My goal is to have a tabsetPanel wrapped in a conditionalPanel whose condition is a global variable being false.
ui.R
mainPanel(
conditionalPanel("searchPage == \"false\"",
tabsetPanel(
tabPanel("Summary",htmlOutput("summary")),
tabPanel("Description", htmlOutput("description"))
))),
global.R
searchPage <- "true"
then in server.R I assign new values to it a few different times, but all like this:
observeEvent(input$openButton,
output$results <- renderUI({
textOutput("")
searchPage <- "false"
}))
No matter what I do, I always get "Uncaught ReferenceError: searchPage is not defined". I've tried changing the global.R to multiple different combinations of using quotes, not using quotes, using <- or <<-, making it this.searchPage, my.searchPage and numerous other things (of course always making server.R and ui.R match too), but haven't had much luck at all.
As mentioned in a comment on the question's post, this is a perfect usecase for the shinyjs toggle()/show()/hide() functions. Whenever you need to conditionally show something where the condition is not a simple javascript expression of an input, it's easy to use these functions instead of a conditionalPanel().
In order to use these functions, you need to have some way to specify the element you want to hide/show (in this case, the mainPanel()). The easist way to do this is to just wrap the entire panel in a div with an id. So define the panel like mainPanel(div(id = "mainpanel", ...)) and voila, there's an id to your panel, and now you can call shinyjs::show("mainpanel") or hide() whenever you want in the server code.
What you are trying to do is not really possible the way you are trying to do it (the server and client are in different environments and don't share variables). You will need to explicitly pass the value from server to client, and there are different approaches to doing that. One way:
library(shiny)
runApp(list(ui = fluidPage(
conditionalPanel(condition='output.bool',
HTML("Hello world")),
actionButton("btn","Press me to toggle")
),
server = function(input, output, session) {
value=TRUE
output$bool <- eventReactive(input$btn,{
value
})
outputOptions(output,"bool",suspendWhenHidden=FALSE)
observeEvent(input$btn,
value <<- !value
)
}))
There are probably better approaches. Hope this helps

Duplicate an icon in shiny actionButton

I would like to add a Font Awesome 'child' icon twice in my actionButton in Shiny. The following app displays the child once:
library(shiny)
ui <- fluidPage(
actionButton("child","children", icon("child"))
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
I tried the obvious to no avail:
actionButton("child","children", icon(c("child","child")))
I must accept this is quite a niche question.
This has nothing to do with the fact that you want the same icon twice. You just can't pass a vector of names into the icon() function. If you look at the documentation of icon() it says it accepts the name of an icon, not a vector for multiple icons.
To do what you want, you can simply add multiple icons in the label. Something like this
actionButton("child", div(icon("child"), icon("child"), "children"))

R: Make part of cell bold in shiny table output

I am using the R shiny app and creating a table using renderTable and tableOutput. Is it possible to make one part of a cells contents bold whilst keeping the rest of it normal text.
E.g. one entry in a particular cell could be:
5.3% ~ 1% ~ 7
I tried hardcoding ** around the appropriate figure but it just outputted the asterisk.
Thanks
You can use the <strong></strong> HTML tag in your table if you want some bold text, here's an example:
library(shiny)
data<-data.frame(a=c("<strong>a</strong>","b"),val=c(1,2))
runApp(list(
ui = basicPage(
tableOutput('mytable')
),
server = function(input, output) {
output$mytable = renderTable({
data
},sanitize.text.function=function(x){x})
}
))
You need to change the sanitize.text.function to identity in order for the tags to be interpreted.
As an alternative, you can also use Datatables to render your table. You can also use the <strong> tag, but make sure you set the escape option to false in the renderDataTable part.

Resources