I want to style a shiny input from dqshiny package in my Shiny app as below -
library(shiny)
library(dqshiny)
opts <- sapply(1:100000, function(i) paste0(sample(letters, 9), collapse=""))
shinyApp(
ui = fluidPage(
autocomplete_input("auto1", "Unnamed:", opts, max_options = 1000)
),
server = function(input, output, session) {
}
)
I want to 2 things to achieve -
Want to change the highlight color in the suggestion field from yellowish to green
Also want to change the distance between the input field and the suggestion container with let say 10px.
I have a few other Widgets in my App, so above modified styling should not impact other widgets.
Is there any way to achieve this?
Any pointer will be highly appreciated.
Easiest way is just adding the CSS directly into the header. There's a really useful article about styling Shiny apps here.
library(shiny)
library(dqshiny)
opts <- sapply(1:100000, function(i) paste0(sample(letters, 9), collapse=""))
shinyApp(
ui = fluidPage(
tags$head(
tags$style(
HTML(
'
.autocomplete-items div:hover {
background-color: green;
}
#auto1autocomplete-list {
margin-top: 10px;
}
'
)
)
),
autocomplete_input("auto1", "Unnamed:", opts, max_options = 1000)
),
server = function(input, output, session) {
}
)
Related
I am interested in removing or hiding the side arrows that appear when you use numericInput() with shiny. I will attach an image of the arrows that I am referring to so everyone can understand which part I would like to remove/hide. After reading the documentation, it does not appear that there is an option to remove these arrows. So I am wondering if there is a way to use CSS to remove these arrows. I did see one other post that asked a similar question. However, I am only interested in using numericInput().
I will attach some sample code. The code essentially does nothing but it will give you a reproducible example.
library(shiny)
server <- function(input, output){
}
ui <- fluidPage(
titlePanel("Test1"),
sidebarLayout(
sidebarPanel(
numericInput("n",
label = h4("Test2"),
min=1,
value = 20),
numericInput("x",
label = h4("Test3"),
min=0,
value = 10),
h4(textOutput("pvalue"))
),
mainPanel(
plotOutput("nullplot")
)
)
)
shinyApp(ui = ui, server = server)
runApp()
WARNING: I have read online that the side arrows do not show up on all web browsers and some versions of RStudio. See here
It does not appear that there is a way to remove the arrows from a numericInput(), however, there is a way to hide them. Just to be clear there is a difference between removing and hiding. Removing the arrows, in theory, should completely remove the code for the arrows. Hiding the arrows will simply mask the code for the side arrows, however, the code will still be present but will not be seen by the user unless they inspect the page.
Below is CSS that can be used to hide the side arrows from numericInput().
tags$head(
tags$style(HTML("
input[type=number] {
-moz-appearance:textfield;
}
input[type=number]::{
-moz-appearance:textfield;
}
input[type=number]::-webkit-outer-spin-button,
input[type=number]::-webkit-inner-spin-button {
-webkit-appearance: none;
margin: 0;
}
"))
)
If you wanted to apply this code to the example given in the question, then you could do something like this
library(shiny)
server <- function(input, output){
}
ui <- fluidPage(
titlePanel("Test1"),
sidebarLayout(
sidebarPanel(
tags$head(
tags$style(HTML("
input[type=number] {
-moz-appearance:textfield;
}
input[type=number]::{
-moz-appearance:textfield;
}
input[type=number]::-webkit-outer-spin-button,
input[type=number]::-webkit-inner-spin-button {
-webkit-appearance: none;
margin: 0;
}
"))
),
numericInput("n",
label = h4("Test2"),
min=1,
value = 20),
numericInput("x",
label = h4("Test3"),
min=0,
value = 10),
h4(textOutput("pvalue"))
),
mainPanel(
plotOutput("nullplot")
)
)
)
shinyApp(ui = ui, server = server)
runApp()
Overall this is just a workaround because there is no option to remove the side arrows.
I am facing some trouble including particles.js output (API provided by shinyparticles in shinydashboard. I am working with R.
Following is an example that works for shiny
library(shiny)
library(shinyparticles)
ui <- fluidPage(
particles(),
headerPanel("This is a sample app")
)
server <- function(input, output, session){}
shinyApp(ui, server)
And here is one for shinydashboard that does not seem to work
library(shinydashboard)
library(shinyparticles)
shinyApp(
ui = dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(tags$body(div(particles()))),
title = "Dashboard example",
skin = "black"
),
server = function(input, output) { }
)
The resulting HTMLs seem identical when I view the page source, but the viz for particles does not appear.
The particles don't appear because they are below the dashboardBody (by default: z-index: -10).
If you set the z-index of the particles to 1 they will be visible, however any element you add to the body will be under the particles.
So set elements z-index to a higher number. (in this example I only use boxes)
Code:
dashboardBody(
tags$head(tags$style("
.particles-full {
z-index: 1;
}
.box {
z-index: 2;
}
")),
particles(),
box(
h2("Header"),
p("Paragraph")
),
box(
plotOutput("plot")
)
)
Output:
I have a shiny app with two datatables side by side. Are there any options to automatically resize the table or column when the width of the window is changed?
Ideally I'd like to see all columns (maybe reduced font size) with no X scroll bar in both tables, and the tables side by side. The code below makes the tables overlap as the window size reduces.
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(
fluidRow(
column(5,
dataTableOutput('table.1')
),
column(2
),
column(5,
dataTableOutput('table.2')
)
)
),
server = function(input, output) {
output$table.1 <- renderDataTable(iris,options = list(autoWidth = TRUE))
output$table.2 <- renderDataTable(iris,options = list(autoWidth = TRUE))
}
)
As mentioned in the comments CSS can handle this for you using viewport based text sizes. I took the liberty of also including the syntax for specifying a maximum text size in case users have exceptionally wide screens:
library("shiny")
library("DT")
shinyApp(
fluidPage(
tags$head(
tags$style(
HTML("
.datatables {
font-size: 1.5vw;
}
#media screen and (min-width: 1024px) {
.datatables {
font-size: 12px;
}
}
")
)
),
dataTableOutput("iris")),
function(input, output) {
output$iris = renderDataTable({
datatable(iris)
})
}
)
This answer has more on viewport percentage lengths and this answer provides the example for the max size.
The whole code/files can be found in this answer
UI.R file
library(shiny)
library(shinydashboard)
shinyUI(
dashboardPage(
dashboardHeader(disable = TRUE), #title=textOutput("title")),
dashboardSidebar(uiOutput("side")),
dashboardBody(
uiOutput("page")
)))
However, I want to disable header in my dashboard, with help from here I managed to disable but then there is some white space added in my dashboard. (see image, the orange highlighed box).
How can I get rid of this? This is not only on login page, the problem persist even after logged in.
I think that it is a missing feature on shiny dashboard to automatically add to the body the height of the header. I fixed it with a trick using JavaScript. The solution is based on add 50px to the CSS min-height attribute of body just after creating the page. Also I added an event listener to add the 50px if the size of the window changes.
library(shiny)
library(shinydashboard)
server <- function(input, output) {
}
ui <- dashboardPage(
dashboardHeader(disable = TRUE),
dashboardSidebar(),
dashboardBody(
tags$script('window.onload = function() {
function fixBodyHeight() {
var el = $(document.getElementsByClassName("content-wrapper")[0]);
var h = el.height();
el.css("min-height", h + 50 + "px");
};
window.addEventListener("resize", fixBodyHeight);
fixBodyHeight();
};')
)
)
shinyApp(ui, server)
You can add class and then remove it from server side
(idea of hide head get here )
library(shiny)
library(shinyjs)
library(shinydashboard)
server=shinyServer(
function(input, output,session) {
observeEvent(input$activate,{
js$hidehead('') # show head
removeClass("body_d","DISABLED") # remove class
})
})
ui=
shinyUI(
dashboardPage(
dashboardHeader(disable = T), #title=textOutput("title")),
dashboardSidebar(uiOutput("side")),
dashboardBody(class="DISABLED",id="body_d",
useShinyjs(),
extendShinyjs(text = "shinyjs.hidehead = function(parm){
$('header').css('display', parm);
}"),
tags$style(".DISABLED { min-height: 100vh !important};
"),
actionButton("activate","activate header")
)))
shinyApp(ui,server)
If you dont want to show header after something -- all you need is add class and add css min-height: 100vh !important as example
I am using R-3.2.0 hosted on Red Hat Linux version 6.5 with shiny package (version 0.12.0). I am trying to utilize shinydashboard functionality to design a few reports. The RStudio version is 0.98.1103
I have successfully setup ui.R and server.R
ui.R - :
ibrary(shinydashboard)
library(htmlwidgets)
library(rpivotTable)
library(leaflet)
dashboardPage(
dashboardHeader(title="Reports",
dropdownMenu(type = "task",
messageItem(
from = "Download",
message = "test",
icon = icon("gear")
),
messageItem(
"Download",
message = "TEST",
icon = icon("life-ring"),
href= "http://www.google.com"
)
)
),
dashboardSidebar(
sidebarMenu(
menuItem("Srts", tabName = "ServiceItems", icon = icon("dashboard"))
)
),
dashboardBody(
tags$head(tags$style(
type = 'text/css',
'#test{ overflow-x: scroll; }')),
rpivotTableOutput('PivotTable')
)
)
server.R -:
library(shiny)
library(ggplot2)
library(wordcloud)
library(devtools)
library(htmlwidgets)
library(rpivotTable)
library(leaflet)
shinyServer(function(input, output) {
PivotTable <- read.csv("Book2.csv",head=TRUE,sep= ',')
output$PivotTable <- rpivotTable::renderRpivotTable({
rpivotTable(PivotTable, rows="Ar", col="DTM", aggregatorName="Count",
vals="Ar", rendererName="Table")})
tableFirst<-as.data.frame(sort(table(PivotTable$Area),decreasing=TRUE))
})
The following code to enable scrolling in the dashboard body was taken from https://github.com/smartinsightsfromdata/rpivotTable/issues/19 :-
tags$head(tags$style(
type = 'text/css',
'#test{ overflow-x: scroll; }')),
rpivotTableOutput('PivotTable')
The issue I face is that the code added to help scrolling does not work. I have stripped my code of all tabs , layouts etc but I am still enable to get scrolling to work.
I have observed that if I remove the dashboardPage command, scrolling does work but the display is very awkward and not really presentable.
However, when I combine the codes as follows (in RStudio) and run the scrolling works just fine.
library(shiny)
library(shinydashboard)
library(rpivotTable)
library(ggplot2)
PivotTable <- read.csv("Book2.csv",head=TRUE,sep= ',')
header <- dashboardHeader(title="Reports",
dropdownMenu(type = "task",
messageItem(
from = "Download",
message = "test",
icon = icon("gear")
),
messageItem(
"Download",
message = "TEST",
icon = icon("life-ring"),
href= "http://www.google.com"
)
)
)
sidebar <- dashboardSidebar()
body <- dashboardBody(
tags$head(tags$style(HTML('
.skin-blue.main-header .logo {
background-color: #3c8dbc;
}
.skin-blue .main-header .logo:hover {
background-color: #3c8dbc;
}
'))
),
tags$head(tags$style(type = 'text/css',
'#test{ overflow-x: scroll; }')),
rpivotTableOutput("test")
)
shinyApp(
ui = dashboardPage(header, sidebar, body),
server = function(input, output) {
output$test <- rpivotTable::renderRpivotTable({
rpivotTable(PivotTable, rows="Ar", col="DTM", aggregatorName="Count",vals="Ar", rendererName="Table")})
})
However, I cannot provide this as a final solution because the business users that need this are not adept at copying and pasting code on RStudio (If there is a possible way that I can use the combined code just like the usual one I can consider that as well).
Can someone please help me understand the issue with my original code that prevents scrolling.
Thanks a lot !
The problem is your CSS selector otherwise everything looks OK. Your setting the scroll-property on a element with ID test but I can't find a element with this ID in your example. Try something like this:
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(
tags$head(
tags$style(
HTML("
#myScrollBox{
overflow-y: scroll;
overflow-x: hidden;
height:120px;
}
")
)
),
# Boxes need to be put in a row (or column)
fluidRow(
div(id="myScrollBox",
plotOutput("plot1", height = 250)),
box(
title = "Controls",
sliderInput("slider", "Number of observations:", 1, 100, 50)
)
)
)
)
server <- function(input, output) {
set.seed(122)
histdata <- rnorm(500)
output$plot1 <- renderPlot({
data <- histdata[seq_len(input$slider)]
hist(data)
})
}
shinyApp(ui, server)
You need to change the CSS selector to the element you want to put the scroll on, in the example this is "myScrollBox".
The only thing which you should be taking in to consideration is to pass the exact same id before CSS code, so in this code replace #test to #PivotTable and bingo... your code should work...
tags$head(tags$style(
type = 'text/css',
'#test{ overflow-x: scroll; }')),
rpivotTableOutput('PivotTable')