I've used the below script but getting the image not aligned properly as it is not in the same line as the header.
How to move the logo from top to the desired location?
tags$img(src="R.png", height = 50, length = 50, align = "left"),
Earlier I used "ShinyUI" and now changed to "dashboardPage" which itself solved the issue and the image got automatically adjusted and aligned.
Below are the arguments I used.
title = tags$a(href = 'https://google.com',
tags$img(src = 'logo.png', height= 50,width= 50, align = "left"),
'Title')
header = dashboardHeader(title = title, titleWidth = 400)
ui = dashboardPage(header, sidebar, body, tags$head(tags$link(rel = "stylesheet", type = "text/css", href = "custom1.css")))
Thanks to Abhinav...
watch this video for more details
Related
I am trying to create a shiny app which displays thumbnail-labels, each thumbnail-label item contains an image, label, button, and content (which are all text inputs).
The problem is when text in content exceeds text size in other thumbnails, this thumbnail enlarges and overlays the place for other thumbnails, distorting the whole page.
Is there a way I can fix each the thumbnail size regardless the content size? for example, by setting the extra text to hidden when exceeding a certain character limit and making it only available on hover? Other approaches are also welcome.
As you can see in the solution below, I've tried adding a limit to the content size in tags$style but it didn't work. Also, I tried adding a vertical layout but it doesn't solve the problem it only limits it to this vertical layout instead of overlaying other thumbnails but still the page looks distorted.
library(shiny)
library(shinyBS)
library(shinyLP)
library(shiny)
library(shinyWidgets)
library(magrittr)
library(googlesheets4)
library(png)
library(DT)
library(bslib)
# Define UI for application that draws a histogram
ui <- fluidPage(
tags$style("content { font-size:80%; font-family:Times New Roman; margin-bottom:
20px; length: 500}"),
div(style="padding: 1px 0px; width: '100%'",
titlePanel(
title="", windowTitle="Data Portal"
)
),
navbarPage(title=div(img(src="Rlogo.png", width = 35), "Data Portal"),
inverse = F,
collapsible = T,
tabPanel("Welcome Page", icon = icon("home"),
jumbotron("Welcome to Our Portal!",
"Welcome to our portal.",
buttonLabel = "Start your tour"),
),
tabPanel("Our Team", icon = icon("users"),
jumbotron("Meet Our Team!", "Meet our team.",
button = FALSE),
hr(),
fluidRow(
verticalLayout(fluid = FALSE,
fluidRow(column(4, thumbnail_label(image = 'user.png', label = 'Name 1',
content = HTML('This is meeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee
eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee
eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee'),
button_link = 'http://getbootstrap.com/', button_label = 'See profile')),
column(4, thumbnail_label(image = 'user.png', label = 'Name 2',
content = HTML('This is me'),
button_link = 'http://getbootstrap.com/', button_label = 'See Profile')),
column(4, thumbnail_label(image = 'user.png', label = 'Name 3',
content = HTML('This is me'),
button_link = 'http://getbootstrap.com/', button_label = 'See Profile'))
)),
verticalLayout(fluid = FALSE,
fluidRow(column(4, thumbnail_label(image = 'user.png', label = 'Name 3',
content = 'background ',
button_link = 'http://getbootstrap.com/', button_label = 'See Profile')),
column(4, thumbnail_label(image = 'user.png', label = 'Name 3',
content = 'background ',
button_link = 'http://getbootstrap.com/', button_label = 'See Profile')),
column(4, thumbnail_label(image = 'user.png', label = 'Name 3',
content = 'background ',
button_link = 'http://getbootstrap.com/', button_label = 'See Profile')),
)),
))
)
) # end of fluid page
# Define server logic required to draw a histogram
server <- function(input, output) {
}
# Run the application
shinyApp(ui = ui, server = server)
Found a way of doing it> I created my own thumbnail function and added attributes to the content part of it using tagAppendAttributes and putting the needed attributes as (style) argument. Also here I used render UI to input the image as I needed to get images as urls from a googlesheet, i.e images not in www directory. Otherwise you can just use the img(src=image) as usual.
my_thumbnail_label <- function(image_url, label, content, button_link, button_label, height = 100, sec_label = NULL ){
tags$style(HTML('
.one-long-line {
width: 300px;
height: 100px;
white-space:nowrap;
overflow:hidden;
text-overflow:ellipsis;
}
.one-long-line:hover {
overflow:visible;
}'))
# take image url and render an image ui
image_ui <- renderUI({
tags$img(src = image_url,
align = "center", style = "width: 100%; height: 100%;")
})
# create the div to be displayed
div(class = "row",
div(class = "col-sm-14 col-md-12",
div(class = "thumbnail",style = "height: '200px';",
image_ui,
div(class = "caption", h3(label)%>%
tagAppendAttributes(style= 'width: "100%" ;height: 30px;overflow: hidden;text-overflow: ellipsis;'), h4(sec_label),
#div(class = "one-long-line", content),
p(content)%>%
tagAppendAttributes(style= paste0('width: "100%" ;overflow: hidden;text-overflow: ellipsis;height:',height, 'px;')),
p(a(href = button_link, class = 'btn btn-primary', role = 'button', button_label))))))
}
I have an application which uses box::dropdownMenu to render a dropdown menu which the user will use to set plot options. I'm able to implement this functionality without any issue, but I would like to do two additional things.
Is it possible to:
(1) Hide the arrow to the right of the cog-icon?
(2) On the dropdown menu, is it possible to keep the text left-alligned, but have the radio buttons be right aligned?
Current State:
Desired End Result:
Code:
library(shiny)
library(shinyWidgets)
library(shinydashboardPlus)
ui <- fluidPage(
box(
title = "Box Title",
dropdownMenu = dropdown(
width = "200px",
icon = icon("gear"),
materialSwitch(inputId = "Id079", label = "Color:"),
materialSwitch(inputId = "Id079", label = "Display Goal:"),
),
textOutput("text")
)
)
server <- function(input, output, session) {
output$text <- renderText("Hello World!")
}
shinyApp(ui, server)
To remove the arrow, one should change style to something other than the default. You can use fill or bordered for example.
shinyWidgets::dropdown(
width = "200px",
style = "fill",
icon = icon("cog"),
materialSwitch(inputId = "Id079", label = "Color:"),
# Change IDs to unique IDs otherwise it won't work
materialSwitch(inputId = "Id080", label = "Display Goal:"),
)
For the alignment, you can play around with the .label-default elements (attrinutes?)
ui <- fluidPage(
# Need to play with the margin-left part
tags$head(tags$style(HTML(".label-default{
margin-left: 50px;}
"))),
shinyWidgets::dropdown(
width = "300px",
style = "fill",
icon = icon("cog"),
materialSwitch(inputId = "Id079", label = "Color:"),
materialSwitch(inputId = "Id080", label = "Display Goal:"),
),
textOutput("text")
)
The problem with this is that it is not easy to uniformly change the margins for non-equal labels.
Problem: I want to add a second picture to the top right corner in the header. Currently, I am able to place one in the top left corner but not in the top right.
Any suggestions how to do that?
## app.R ##
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
header = dashboardHeader( titleWidth = NULL,
title = tags$b("Testapp",
tags$a(href = 'https://www.google.com/',
tags$img(src = 'mick.png', height = 50, width = 50, align = "left"))
),
## QUESTION: how can I add the picture to the top right corner
tags$head(tags$img(src = 'mick.png', height = 50, width = 50, align = "right"))
),
dashboardSidebar(),
dashboardBody()
)
server <- function(input, output) { }
shinyApp(ui, server)
Shinydashboard expects a li element with class dropdown. If we give it that (replace tags$head(...) with the below):
tags$li(tags$img(src = 'mick.png', height = 50, width = 50, align = "right"), class = "dropdown")
it works.
I'm trying to make a render a text output with an automatic scrollbar that is activated when the text becomes too wide or long. For the moment I achieved the scrollbar on the x-axis with container=pre as an argument in the Textoutput in the UI.
What I would want is that the output in the text output limits itself to 4 or 5 rows and then to have a scrollbar in order to see the remaining rows.
I looked at all the posts that I could find for the topic (that's why I implemented the container=pre) but I couldn't find a way to solve the y-axis scrollbar. I understand that it has something to do with overflow y: "auto" in the tags' settings but I can't make it work out, maybe I'm placing it wrong.
Thank you.
Here's an example:
# Shiny example
library(shinydashboard)
library(shiny)
library(stringi)
library(shinyWidgets)
# Data
# Some random letters
names<- stringi::stri_rand_strings(100,20)
# Some random numbers
numbers<- runif(100,0,100000)
# a df
df<- as.data.frame(cbind(names, numbers))
shinyApp(
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
absolutePanel(id="panel", fixed = FALSE,
draggable = F, top = 80, left = "auto", right = 60, bottom = "auto",
width = 290, height = 370,
box( title = "Box example",
status = "warning", width = 230, solidHeader = T,
pickerInput(
inputId = "select_nb_names",
choices = names,
multiple = TRUE,
selected = NULL,
width = 190,inline = FALSE),
# the textoutput that only has an x-axis scrollbar
textOutput("TextThatIWantToHaveAScroll",container = pre ))))),
server <- function(input, output, session) {
output$TextThatIWantToHaveAScroll<- renderText(
paste0( input$select_nb_names," : ",df$numbers[df$names%in%input$select_nb_names],"\n"))
}
# Run the application
)
You can add a scrolls using CSS. In shiny, use the tags$style tag to define the css properties and wrap in a tags$head tag. You can either target element using the ID of the output element (i.e.,#TextThatIWantToHaveAScroll), the shiny class for text outputs (i.e., shiny-text-output), or the tag name (i.e., pre). If you have more than one element that should receive the same treatment, then using .shiny-text-output is a better option.
To create a scroll for the desired element (as in the example; using ID), set the height and width properties first, and then use the overflow: scroll. For example:
#TextThatIWantToHaveAScroll {
width: 100%;
height: 60px;
overflow: scroll;
}
Adjust the height and width as needed. There are other scroll options available. See Mozilla's CSS guide on the overflow property. Here's the full example:
# Shiny example
library(shinydashboard)
library(shiny)
library(stringi)
library(shinyWidgets)
# Data
# Some random letters
names<- stringi::stri_rand_strings(100,20)
# Some random numbers
numbers<- runif(100,0,100000)
# a df
df<- as.data.frame(cbind(names, numbers))
shinyApp(
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
tags$head(
tags$style(
"#TextThatIWantToHaveAScroll {
width: 100%;
height: 60px;
overflow: scroll;
}"
),
),
absolutePanel(id="panel", fixed = FALSE,
draggable = F, top = 80, left = "auto", right = 60, bottom = "auto",
width = 290, height = 370,
box( title = "Box example",
status = "warning", width = 230, solidHeader = T,
pickerInput(
inputId = "select_nb_names",
choices = names,
multiple = TRUE,
selected = NULL,
width = 190,inline = FALSE),
# the textoutput that only has an x-axis scrollbar
textOutput("TextThatIWantToHaveAScroll",container = pre))))),
server <- function(input, output, session) {
output$TextThatIWantToHaveAScroll<- renderText(
paste0( input$select_nb_names," : ",df$numbers[df$names%in%input$select_nb_names],"\n"))
}
# Run the application
)
I am trying to change the base layer in my Shiny App in a programatic way.
Since I don't want to use the LayerControl of 'Leaflet' and rather want to have all the controls in one panel. I decided to use shinyjs and go with the toggleState for a button to switch forth and back between two base layers.
At the moment I am in the phase to figure out the principles of changing the base layer, and since there can be only one base layer visible it seem like I have to remove the tiles of the initially loaded base layer.
Doing so I can change the base layer at display, but at the same time the base layer is changed I am loosing the overlay. How can I avoid that?
When using the button again I can see in the flicker that the overlay is still there, but not on top of the base layer anymore.
Here an example:
library(shiny)
library(leaflet)
library(shinydashboard)
# Definition of Sidebar elements
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Maps", tabName = "maps", icon = icon("globe"),
menuSubItem(
HTML(paste("Diffuse kilder NH", tags$sub("3"), sep = "")),
tabName = "map_dif_nh3", icon = icon("map-o"), selected = TRUE
)
)
)
)
# Definition of body elements
body <- dashboardBody(
tabItems(
tabItem(tabName = "map_dif_nh3",
box(
width = 12,
div(style = "height: calc(100vh - 80px);",
leafletOutput(
"m_dif_nh3", width = "100%", height = "100%"
),
absolutePanel(id = "nh3_panel", class = "panel panel-default",
fixed = TRUE, style = "opacity: 0.87",
top = 80, left = "auto", right = 50, bottom = "auto",
width = 285, height = "auto",
fluidRow(
column(width = 10, offset = 1,
actionButton(inputId = 'btn_bgr_nh3', label = "", icon = icon("globe", class = "fa-lg"))
)
)
)
)
)
)
)
)
ui <- dashboardPage(
dashboardHeader(title = "Mixed layout"),
sidebar,
body
)
server <- function(input, output) {
init_lat <- 56.085935208960585
init_lon <- 10.29481415546154
init_zoom <- 7
output$m_dif_nh3 <- renderLeaflet({
leaflet(height = "100%") %>%
addProviderTiles("Stamen.Toner", layerId = 'mb_osm', group = "base") %>%
setView(init_lon, init_lat, init_zoom) %>%
addWMSTiles(
"http://gis.au.dk/geoserver_test/PRTR/gwc/service/wms",
layers = "PRTR:prtr_nh3_2014",
layerId = "nh3_2014",
group = "overlay",
options = WMSTileOptions(format = "image/png",
transparent = TRUE, opacity = 0.8
)
)
})
observeEvent(
input$btn_bgr_nh3, {
leafletProxy("m_dif_nh3") %>%
addProviderTiles("Esri.WorldImagery", layerId = 'mb_pic', group = 'base')
leafletProxy("m_dif_nh3") %>%
removeTiles(layerId = 'mb_osm')
}
)
}
shinyApp(ui, server)
I think what you can do is reset the value of ID the action button to 0 after clicking the button. Therefore, every time you toggle the ID value will be replaced by 0. It worked for me. Hope it work for you as well.
In Leaflet JS (I don't know about R), if myTileLayer is already part of your base layers, then myTileLayer.addTo(map) does the switching job. It doesn't add on top; and you don't need to remove the current layer. The overlay remains unaffected.
Ref: https://stackoverflow.com/a/33762133/4355695