I want to remove the check all/none checkbox from a Reactable table.
In this image, I do not want the orange circled checkbox to appear.
Using Chrome Inspector, I examine the css of this checkbox and set display: none;
This removes the entire column of checkboxes. How do I remove just this one?
R Script
library(reactable)
reactable(iris,
onClick = "select",
selection = "multiple")
U can append some javascript code and make it run when the reactable is rendered:
ie
// Hide the select all check box
document.querySelector('.rt-select-input[aria-label="Select all rows"]').parentElement.parentElement.style.display = "none";
The final R-code
library(reactable)
library(htmlwidgets)
e<-reactable(iris,
onClick = "select",
selection = "multiple")
javascript <- JS('
document.querySelector(\'.rt-select-input[aria-label="Select all rows"]\').parentElement.parentElement.style.display="none";
')
(p <- prependContent(e,onStaticRenderComplete(javascript)))
Improvements
In order to streamline the process and specifically target the wanted checkbox (as the aforementioned method would be unsuccessful when handling 2 tables in the same page) I wrote a function that'll dynamically target the wanted checkbox:
hide.select.all <- function(x){
javascript <- JS(paste0('
let id = null;
for (const script of document.querySelectorAll("script[data-for]")) {
if(script.text.includes("', x$x$tag$attribs$dataKey ,'")) {
id="#" + script.dataset.for;
break;
}
}
if(id) document.querySelector(id + \' .rt-select-input[aria-label="Select all rows"]\').parentElement.parentElement.style.display="none";
'))
prependContent(x,onStaticRenderComplete(javascript))
}
hide.select.all(e)
Related
I am trying to change the colour of my data points with bokeh. When I use a Hover tool this works fine. However, if I use the same callback function with a select or button tool it does not work. I guess this is beacause the change.emit() does not work in combination with a button or select?
How can I make my customJS work with a select or button tool?
callback3=CustomJS(args=dict(source2=source2,p2=p2),code=''' var source2=source2 var data3 = source2.data;
var color = data3['color'];
var i, n = color.length;
for (i = 0; i < n; ++i) {
color[i] = 'blue';
source2.change.emit();
}
''' )
For my the hoover tool I use:
plot.add_tools(HoverTool(tooltips=None, callback=callback3, renderers=[d],mode='vline'))
For the button:
button = Button(label="Foo", button_type="success")
button.js_on_click(callback3)
When I use an alert in my callback this works also for the button and the select.
I solved the problem. It was not related to the change.emit(). The problem was that I used show separately for the plot and the button.
I am trying to understand how will the below code behave
library(shiny)
ui<-fluidPage(
sliderInput("inpslider","Slider",1,10,5),
uiOutput("radio"),
)
server <- function(input, output) {
output$radio<-renderUI({
x<-input$inpslider
radioGroupButtons(inputId = 'myRadioButton', choices = c("A","B"),status = 'warning',
direction = 'vertical', justified = T)
})
}
The first time the code runs it will add an input slider and grouped radio button.
Question:- Since output$radio block contains the reactive value input$slider it will be executed whenever the slider value is changed, So will shiny add a new set of radio button(on top of previous one) every time output$radio is executed? or will the old set of radio buttons will be flushed out every time and new one is added?
You're creating the element with renderUI each time the slider is invalidated it doesnt matter if you press it or reload it...
I haven't found any information in documentation of shinyBS and on the google/SO about how to use trigger = 'manual' on, for example, addPopover of shinyBS. I thought this would be the way to add a tooltip to a disabled button. (I dont want to do it with div'ving the button and giving title to div.
Also would be nice if someone has a way to add tooltips reactively to shiny apps
If you want to use trigger = manual on the popover, then you need to define a script to toggle the popover, e.g. with jQuery:
library(shiny)
library(shinyjs)
library(shinyBS)
ui <-shinyUI(fluidPage(useShinyjs(),
# press this button to trigger the popover
actionButton("addPopover", "Add Popover"),
# a disabled button
disabled(actionButton("disabledButton", "This button is disabled")),
# the popover to appear over the disabled button
bsPopover("disabledButton", "Popover", "Some text", trigger="manual"),
# the script to trigger the popover
uiOutput("trigger")))
server <- shinyServer(function(input,output, session){
# on checkbox selection, disable button and trigger the popover
output$trigger <- renderUI({
input$addPopover
tags$script("$('#disabledButton').popover('toggle');")
})
})
shinyApp(ui,server)
Since shosaco's solution didnt work for me, I got it to work this way:
if (input$disable) {
addCssClass("buttonId", "disabled")
bsTooltip("buttonId", "This button is currently disabled.")
} else {
bsTooltip("buttonId", "")
removeCssClass("buttonId", "disabled")
}
observeEvent(input$buttonId, {
if (!input$disable) {
output$text <- renderText("Bla")
} else {
output$text <- renderText(NULL)
}
From the shiny dashboard github, I've gathered that it's possible to create drop down menus at the top right of the header, but there are only 3 "types" (messages, notifications, and tasks).
https://rstudio.github.io/shinydashboard/structure.html#structure-overview
Is there a method for creating a custom dropdown? I'd like to make a settings dropdown, where I give the user some checkboxes that they can use to adjust the dashboard in ways (displaying/hiding things, filtering data, etc.)
I customized one of the three types of menu to allow this. You could then add actionItem(s) for items. tabSelect property when true simulate the selection of a sidebarMenuItem.
dropdownActionMenu <- function (..., title=NULL, icon = NULL, .list = NULL, header=NULL) {
items <- c(list(...), .list)
lapply(items, shinydashboard:::tagAssert, type = "li")
type <- "notifications" # TODO créer action + CSS
dropdownClass <- paste0("dropdown ", type, "-menu")
tags$li(class = dropdownClass, a(href = "#", class = "dropdown-toggle",
`data-toggle` = "dropdown", icon, title), tags$ul(class = "dropdown-menu",
if(!is.null(header)) tags$li(class="header",header),
tags$li(tags$ul(class = "menu", items))))
}
actionItem = function (inputId, text, icon = NULL, tabSelect=FALSE) {
if(!is.null(icon)) {
shinydashboard:::tagAssert(icon, type = "i")
icon <- tagAppendAttributes(icon, class = paste0("text-", "success"))
}
if(tabSelect) {
tags$li(a(onclick=paste0("shinyjs.tabSelect('",inputId,"')"),icon,text))
} else {
tags$li(actionLink(inputId,text,icon))
}
}
javascript function to select tab (to be inserted after useShinyjs() in body)
extendShinyjs(text="shinyjs.tabSelect=function(tabName){$('a[data-value='+tabName+']').click();}")
Sample code
dashboardHeader(
dropdownActionMenu(title="test",
actionItem("mnuFirst","First"),
actionItem("mnuSecond","Second")
)
)
Shiny Dashboard is based on admin LTE. So the existing type of drop downs are designed for admin LTE use case, which is quite different from many Shiny app usage.
If something is not even available in admin LTE, it's less likely to be supported in Shiny dashboard.
For your specific question, you can put some controls in the side bar. Another possibility is to use the wrench icon in box, which is not implemented in Shiny yet.
I am trying to create simple webapp where I want to take in multiline input from user using HTML textarea control. Is there any out of the box way of creating such an input control in Shiny?
Help page of textInput doesn't show much options
textInput {shiny} R Documentation
Create a text input control
Description
Create an input control for entry of unstructured text values
Usage
textInput(inputId, label, value = "")
Arguments
inputId
Input variable to assign the control's value to
label
Display label for the control
value
Initial value
Value
A text input control that can be added to a UI definition.
Examples
textInput("caption", "Caption:", "Data Summary")
You can add a textarea using tags and it should be picked up by Shiny automatically:
tags$textarea(id="foo", rows=3, cols=40, "Default value")
Or if you're more comfortable with straight HTML you can also do
HTML('<textarea id="foo" rows="3" cols="40">Default value</textarea>')
In either case, input$foo should reflect the textarea's value.
For benefit of others, I will post how I solved the problem using custom UI control following Shiny tutorial
Firstly, I crearted textarea.js file as follows
$(document).on("click", "textarea.inputTextarea", function(evt) {
// evt.target is the button that was clicked
var el = $(evt.target);
// Raise an event to signal that the value changed
el.trigger("change");
});
var inputTextareaBinding = new Shiny.InputBinding();
$.extend(inputTextareaBinding, {
find: function(scope) {
return $(scope).find(".inputTextarea");
},
getValue: function(el) {
return $(el).text();
},
setValue: function(el, value) {
$(el).text(value);
},
subscribe: function(el, callback) {
$(el).on("change.inputTextareaBinding", function(e) {
callback();
});
},
unsubscribe: function(el) {
$(el).off(".inputTextareaBinding");
}
});
Shiny.inputBindings.register(inputTextareaBinding);
Then I added following function in ui.R of shiny webapp before shinyUI() is called
inputTextarea <- function(inputId, value="", nrows, ncols) {
tagList(
singleton(tags$head(tags$script(src = "textarea.js"))),
tags$textarea(id = inputId,
class = "inputtextarea",
rows = nrows,
cols = ncols,
as.character(value))
)
}
Then I used above defined function to create the desired textarea control element in ui.R
shinyUI(pageWithSidebar(
# Application title
headerPanel("Test Header Panel"),
sidebarPanel(),
mainPanel(
inputTextarea('exampleTextarea', '',20,35 )
)
))
May or may not be relevant here, but I made the shinyAce package to wrap up and expose the Ace text editor in Shiny. Ace is primarily used for code editing (complete with syntax highlighting for a variety of languages), but provides a text-area-like interface for writing composing multi-line text/code.
You can check out the example to see if that might be what you're looking for. (Try different "modes" for syntax highlighting and themes for color combinations.)
From version 0.14 shiny has an implementation of textAreaInput.
Building off of Joe's answer (https://stackoverflow.com/a/14452837/5776618), you can also nest tags into your own function to achieve the same output as the standard Shiny built-in input functions.
textareaInput <- function(id, label, value, rows=20, cols=35, class="form-control"){
tags$div(
class="form-group shiny-input-container",
tags$label('for'=id,label),
tags$textarea(id=id,class=class,rows=rows,cols=cols,value))
}
This is a way to avoid writing the JS code (if you want to) while still...
having a function that calls the same way the built-in Shiny inputs are called, and
includes the div, label, and Bootstrap's form-control CSS style (so that it looks like the built-in Shiny input controls)
Using the function is same as if you are using the built-in or if you built a custom UI.
textareaInput("textareaID","Text Area Label", "Insert text here...", rows = 20, cols = 35)
Here's a quick solution that preserves the shiny input feel, but allows custom number of columns:
textareaInput <- function(inputID, label, value="", rows=10, columns=80) {
HTML(paste0('<div class="form-group shiny-input-container">
<label for="', inputID, '">', label,'</label>
<textarea id="', inputID, '" rows="', rows,'" cols="',
columns,'">', value, '</textarea></div>'))
}
In your ui.R script, you can add:
textareaInput("shazam", "My text box")
Note: To get a Bootstrap feel to the textarea, you can use:
textareaInput <- function(inputID, label, value="", rows=10) {
HTML(paste0('<div class="form-group shiny-input-container">
<label for="', inputID, '">', label,'</label>
<textarea class="form-control" id="', inputID,
'" rows="', rows, '">', value, '</textarea></div>'))
}