I use the library shinydashboard to write my ui.R. In my dashboardBody part, I wrote:
fluidRow(infoBoxOutput("dri"))
And then in my server.R, I wrote:
output$dri = renderInfoBox({
infoBox(
width = 2,
title = tags$b("Score"),
value = tags$b("100"),
color = "aqua",
fill = TRUE,
icon = icon("edit")
)
})*
But the width won't change to 2; it still uses the default one, i.e. 4 (1/3 of the whole webpage width).
Would someone help me with this? Thank you very much!
Maybe you can style it yourself
rm(list = ls())
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(fluidRow(infoBoxOutput("dri")),tags$style("#dri {width:200px;}"))
)
server <- function(input, output) {
output$dri <- renderInfoBox({
infoBox(
title = tags$b("Score"),
value = tags$b("100"),
color = "aqua",
fill = TRUE,
icon = icon("edit")
)
})
}
shinyApp(ui, server)
200 px
1000px
I found this answer on github and it worked for me aswell:
Instead of using renderInfoBox and infoBoxOutput, you can use renderUI
and uiOutput and that worked for me. This makes me think there is an
issue with the renderInfoBox function.
Related
I want the text in this valuebox on top of each other and not side by side. Does anyone know how to fix this? You can see my code and an image below.
valueBox(value = "C: 7.07 A: 7.03 B: 6.82", "Durchschnittliche Bewertungen der Filiale", color = "yellow")
tried some layout codes but didn't worked.
It looks like based on tags you're using shiny and shinydashboard. You won't be able to add unicode \n newline for this; instead, you can wrap your text in HTML and then use <br> tag for line breaks. If you need to dynamically render the text in your valueBox, you can use paste. Below is a complete example.
library(shinydashboard)
library(shiny)
ui <- dashboardPage(
dashboardHeader(title = "Value box example"),
dashboardSidebar(),
dashboardBody(
fluidRow(
valueBoxOutput("myValueBox")
)
)
)
server <- function(input, output) {
output$myValueBox <- renderValueBox({
valueBox(
value = HTML("C: 7.07<br>A: 7.03<br>B: 6.82"), "Durchschnittliche Bewertungen der Filiale", color = "yellow"
)
})
}
shinyApp(ui, server)
Image
I am looking to draw simple shapes in R Shiny. (The goal is to draw a static legend using HTML instead of loading a png.)
I can't get the canvas tag to work. It simply does not draw anything.
library(shiny)
ui <- fluidPage(
tags$script(HTML(
"function draw_legend() {",
"var canvas = document.getElementById('simple_legend');",
"const canvas = document.getElementById('canvas');",
"const ctx = canvas.getContext('2d');",
"ctx.fillStyle = 'green';",
"ctx.fillRect(10, 10, 150, 100);",
"}"
)),
sidebarLayout(
sidebarPanel(
),
mainPanel(
tags$body(onload="draw_legend();"),
tags$canvas(id="simple_legend", height = "30"),
tags$div("Some text")
)
)
)
server <- function(input, output, session) {
}
shinyApp(ui = ui, server = server)
Expanding on my comment, here is an app showing two techniques for drawing a circle in Shiny, one using CSS, the other using a data frame. You can make obvious adjustments to size, colour, position etc to get the effect you want.
library(shiny)
library(tidyverse)
ui <- fluidPage(
tags$head(
tags$style("#circleText {color: red; font-size: 20px; }")
),
uiOutput("circleText"),
plotOutput("circleGraph")
)
server <- function(input, output, session) {
output$circleText <- renderUI({
HTML("⬤")
})
output$circleGraph <- renderPlot({
tibble(theta=seq(0, 2*pi, 0.025), x=sin(theta), y=cos(theta)) %>%
ggplot(aes(x, y)) +
geom_path() +
coord_fixed() +
theme_void()
},
height=75,
width=75)
}
shinyApp(ui = ui, server = server)
Giving
You have to
remove the line const canvas = document.getElementById('canvas');
set a width to the canvas element, not only a height
I have a shiny app for which I'd like to add a dark mode switch. I've managed to do that after some research online but as I was trying to implement this bit of code in my app I encountered issues. I have been trying several things on a simpler app to try to identify what causes the switch to not work and I came to the conclusion that adding a navbarPage to my app is what makes it crash.
Below is a simple example:
library(shiny)
library(DT)
library(shinyWidgets)
library(bslib)
ui <- fluidPage(
theme=bs_theme(),
# navbarPage("TITLE",
sidebarLayout(
sidebarPanel(
numericInput("num", label = h3("Numeric input"), value = 1),
materialSwitch(inputId = "mode", label = icon("moon"), right=TRUE,status = "success")),
mainPanel(verbatimTextOutput("value")) #fin main panel
)
# )
)
server <- function(input, output,session) {
observe({
if(input$mode==TRUE)
session$setCurrentTheme(bs_theme_update(theme, bootswatch = "superhero"))
if(input$mode==FALSE)
session$setCurrentTheme(bs_theme_update(theme, bootswatch = "default"))
})
output$value <- renderPrint({ input$num })
}
shinyApp(ui, server)
As long as the navbar line and corresponding ")" is considered as a comment it works fine but as soon as I uncomment these two lines I get this error:
Warning: Navigation containers expect a collection of `bslib::nav()`/`shiny::tabPanel()`s and/or `bslib::nav_menu()`/`shiny::navbarMenu()`s. Consider using `header` or `footer` if you wish to place content above (or below) every panel's contents.
Listening on http://--.--
Warning: Error in : session$setCurrentTheme() cannot be used to change the Bootstrap version from to 4. Try using `bs_theme(version = 4)` for initial theme.
47: stop
46: session$setCurrentTheme
45: observe [C:/Users/user/Documents/shiny/SHINY-APP/app4.R#23]
44: <observer>
1: runApp
I am very new to shiny despite being familiar with R but I really don't understand this error. I have been trying to find answers in the documentation associated to the different functions I'm using as well as in previously asked questions on SO but I haven't been able to fix this yet.
Any help would be greatly appreciated!
Thank you !
You have to specify the theme both in the fluidPage and the navbarPage (maybe you can get rid of fluidPage, didn't test it)
library(shiny)
library(DT)
library(shinyWidgets)
library(bslib)
ui <- fluidPage(
theme=bs_theme(version = 4, bootswatch = "default"),
navbarPage("TITLE",
theme=bs_theme(version = 4, bootswatch = "default"),
tabPanel("Tab",
sidebarLayout(
sidebarPanel(
numericInput("num", label = h3("Numeric input"), value = 1),
materialSwitch(inputId = "mode", label = icon("moon"),
right=TRUE,status = "success")),
mainPanel(verbatimTextOutput("value")) #fin main panel
)
)
)
)
server <- function(input, output,session) {
observe(session$setCurrentTheme(
if(isTRUE(input$mode)){
bs_theme(bootswatch = "superhero")
} else {
bs_theme(bootswatch = "default")
}
))
output$value <- renderPrint({ input$num })
}
shinyApp(ui, server)
I have the shiny dashboard below and I want to print inside the box "Red1" to "Red21" one below the other using a for() loop like in the screenshot. The box() should be created with renderUI()
library(shiny)
library(shinydashboard)
shinyApp(
ui = dashboardPage(
options = list(sidebarExpandOnHover = TRUE),
header = dashboardHeader(),
sidebar = dashboardSidebar(minified = TRUE, collapsed = TRUE),
body = dashboardBody(
uiOutput("box1")
),
title = "DashboardPage"
),
server = function(input, output) {
output$box1<-renderUI({
box(
for(i in 1:21){
"Red"[i]
br()
},
height = 300,width = 5
)
})
}
)
box() can take a list as first argument, so your code can be rewritten like this:
...
box({
text <- list()
for(i in 1:21){
text <- append(text, list(paste("Red", i), br()))
}
text
})
...
Doing this with an anonymous function (which this is) isn't that good for readability (at least for me) so I would suggest you build that list beforehand.
I have an output from plotOutput and when there is a double click on the map, I want to see an output from leafletoutput. In the code below, when there is a double click on the map, the leaflet map shows below the google map. Before double click the the first image shows but after double clicking, I want to see the leaflet map only. Any suggestions on how to do this?
library(shiny)
library(shinydashboard)
library(leaflet)
library(dismo)
library(ggmap)
library(dplyr)
shinyApp(
ui = dashboardPage(
dashboardHeader(title=""),
dashboardSidebar(width = 200 ),
dashboardBody(
fluidRow(
plotOutput("USA_GoogleMap",dblclick='plot_dblclick'),
leafletOutput("leaflet_map")
)
)),
server=function(input, output, session) {
double_clicked <- reactiveValues(
center = NULL
)
# Handle double clicks on the plot
observeEvent(input$plot_dblclick, {
double_clicked$center <- c(input$plot_dblclick$x,input$plot_dblclick$y)
})
output$USA_GoogleMap<-renderPlot({
statesMap = map_data("state")
xy=cbind(statesMap$long,statesMap$lat)
y=c(36.4,41.5,42.25,27.7,32.77)
x=c(-115.5,-100,-75,-81.5,-97.45)
state=c("Nevada","Nebraska","New York","Florida","Texas")
bases=cbind(x,y)
bases_mercator=data_frame(Mercator_X=Mercator(bases)[,1],Mercator_Y=Mercator(bases)[,2],State=state)
g = gmap(xy, type='satellite',zoom=4)
plot(g, inter=TRUE)
points(Mercator(bases) , pch=20,cex=16, col=adjustcolor("white", alpha=0.2))
points(Mercator(bases) , pch=20,cex=16, col=adjustcolor("yellow", alpha=0.4))
text(bases_mercator$Mercator_X,bases_mercator$Mercator_Y,state)
})
output$leaflet_map <- renderLeaflet({
if(!is.null(double_clicked$center)){
leaflet()%>%setView(lng = -71.0589, lat = 42.3601, zoom = 12)%>%addTiles()
}
})
}
)
shinyApp(ui = ui, server = server)
First Image
Second image
Let me first preface this by saying - there's a better way to do this than I'm showing. I just haven't found one yet. I'm sure a much better programmer than I would know of it, but at least I can say this works. Even though it's hideous. The key to hiding the plot was using conditionalPanel (which I was previously unfamiliar with).
I have a text trigger for identifying whether or not the plot was double-clicked, and use that to trigger whether or not to show the panel. However, I couldn't get the text to initialize without calling it with textOutput... so I have a textOutput call with a font size of zero. Again, there must be a much better way of triggering that than I'm doing it... but again, at least it works. Hopefully it will help.
library('shiny')
library('shinydashboard')
library('leaflet')
library('dismo')
library('ggmap')
library('dplyr')
shinyApp(
ui = dashboardPage(
dashboardHeader(title=""),
dashboardSidebar(width = 200 ),
dashboardBody(
fluidRow(
conditionalPanel(
condition = 'output.condition == 0',
plotOutput("USA_GoogleMap",dblclick='plot_dblclick')
),
leafletOutput("leaflet_map"),
textOutput('condition'),
tags$head(tags$style("#condition{font-size: 0px}"))
)
)),
server=function(input, output, session) {
double_clicked <- reactiveValues(
center = NULL
)
# Handle double clicks on the plot
observeEvent(input$plot_dblclick, {
double_clicked$center <- c(input$plot_dblclick$x,input$plot_dblclick$y)
})
output$USA_GoogleMap<-renderPlot({
if(is.null(double_clicked$center)){
statesMap = map_data("state")
xy=cbind(statesMap$long,statesMap$lat)
y=c(36.4,41.5,42.25,27.7,32.77)
x=c(-115.5,-100,-75,-81.5,-97.45)
state=c("Nevada","Nebraska","New York","Florida","Texas")
bases=cbind(x,y)
bases_mercator=data_frame(Mercator_X=Mercator(bases)[,1],Mercator_Y=Mercator(bases)[,2],State=state)
g = gmap(xy, type='satellite',zoom=4)
plot(g, inter=TRUE)
points(Mercator(bases) , pch=20,cex=16, col=adjustcolor("white", alpha=0.2))
points(Mercator(bases) , pch=20,cex=16, col=adjustcolor("yellow", alpha=0.4))
text(bases_mercator$Mercator_X,bases_mercator$Mercator_Y,state)
}
})
output$leaflet_map <- renderLeaflet({
if(!is.null(double_clicked$center)){
leaflet()%>%setView(lng = -71.0589, lat = 42.3601, zoom = 12)%>%addTiles()
}
})
output$condition <- renderText({
ifelse(!is.null(double_clicked$center), 1, 0)
})
}
)