Please can you help me to add company logo on the left top of shiny dashboard besides project name.
I have tried to use the code in the other answers here on stackoverflow but still can't solve my problem. I am a total ignorant in HTML and css.
Here is my code:
library(shiny)
library(shinydashboard)
shinyApp(
ui = dashboardPage(skin = "green",
dashboardHeader(title = "Project name",
# this could show the logo but not where I wanted !
tags$li(a(href = 'http://www.company.com',
img(src = 'logo.jpg',
title = "Company Home", height = 30px"),
style = "padding-top:10px; padding-bottom:10px;"),
class = "dropdown"))),
dashboardSidebar(),
dashboardBody()
),
server = function(input, output) {}
)
The picture that shows how I want to add the logo
Thank you
It is possible to set an image and text side by side as following.
library(shiny)
library(shinydashboard)
header <- dashboardHeader()
anchor <- tags$a(href='http://www.example.com',
tags$img(src='logo.png', height='60', width='50'),
'project name')
header$children[[2]]$children <- tags$div(
tags$head(tags$style(HTML(".name { background-color: black }"))),
anchor,
class = 'name')
ui <- dashboardPage(header, dashboardSidebar(), dashboardBody())
shinyApp(ui, server = function(input, output, session) {})
Related
I'm building out a datatable in R Shiny and part of it will include tooltips unique to each cell. I've accomplished that, however, I seem to be unable to insert HTML content into the tooltip itself. In the example below, I'm inserting HTML content into a cell in the datatable, and then aim to insert that same content into a tooltip, but the HTML only renders in the datatable, and not in the tooltip.
I've played around with a few ideas but can't find any that work. I can get the HTML to appear (as text) in the tooltip by removing the HTML function, but then, obviously, it's escaped and is just text. I am able to bold text within the tooltip using tags$b(), however, I am hoping for a solution more similar to my example below as I have more complex HTML content I would like add to the tooltip beyond just text.
Any ideas? Thanks very much!
library(shiny)
library(shinyBS)
library(DT)
ui <- fluidPage(
bsTooltip('tbutton',''),
mainPanel(dataTableOutput('df'))
)
server <- function(input, output) {
df <- data.frame(A = c(1:5), B = c(LETTERS[1:5]))
output$df <- renderDataTable({
cell <- paste0('<svg width="30" height="30">',
'<text x="1%" y="75%" font-weight="bold" font-size="16" >B</text>',
'</svg>')
df[2,2] <- as.character(popify(tags$div(HTML(cell)),
title = 'Tooltip:',
placement = 'left',
content = paste0(tags$div(HTML(cell))),
trigger = c('hover', 'click')))
datatable(df, escape=FALSE)
})
}
shinyApp(ui = ui, server = server)
To attach a popover to a cell, you can use bsPopover if this cell has an id. To set an id to the cells, you can use the datatables option createdCell.
Then the HTML code works in the popover content, but not the SVG (or at least I didn't manage to make it work).
library(shiny)
library(shinyBS)
library(DT)
df <- data.frame(A = 1:5, B = LETTERS[1:5])
css <- "
.red {color: red;}
"
ui <- fluidPage(
tags$head(tags$style(HTML(css))),
mainPanel(
DTOutput('df'),
bsPopover(
id = "id2",
title = "test",
content = '<p class="red">TEST</p>'
)
)
)
server <- function(input, output) {
output$df <- renderDT({
datatable(
df,
options = list(
columnDefs = list(
list(
targets = 2,
createdCell = JS(
"function (td, cellData, rowData, row, col) {",
" $(td).attr('id', 'id' + (row+1));",
"}"
)
)
)
)
)
})
}
shinyApp(ui = ui, server = server)
So I have a simple shiny app that takes text as an input and outputs it.
But my goal is to make it easier for my users to be able to customize the font and formatting of this text in an easy to use way.
Here is a screenshot of the app (below). I can enter HTML code to change the formatting but my users do not know HTML or CSS.
Is there an easy way for my users to be able to have a little UI with basic formatting that can be passed through the input? Kind of like this?
Here is my app code:
library(shiny)
ui <- fluidPage(
sidebarLayout(
textAreaInput("text", label = HTML(paste0("Enter Text Here")), value = HTML(paste0("HTML ELEMENTS CAN BE USED"))),
mainPanel(
uiOutput("value"))
)
)
server <- function(input, output) {
output$value <- reactive({
shiny::HTML(paste0(input$text))
})
}
shinyApp(ui, server)
You can use the JavaScript library SunEditor
library(shiny)
js <- '
$(document).ready(function(){
const editor = SUNEDITOR.create(document.getElementById("editor"), {});
});
'
ui <- fluidPage(
tags$head(
tags$link(rel="stylesheet", href = "https://cdn.jsdelivr.net/npm/suneditor#latest/dist/css/suneditor.min.css"),
tags$script(src = "https://cdn.jsdelivr.net/npm/suneditor#latest/dist/suneditor.min.js"),
tags$script(HTML(js))
),
br(),
tags$textarea(id = "editor", class = "sun-editor-editable", cols = 80)
)
server <- function(input, output, session){
}
shinyApp(ui, server)
I am trying to fix my width on my R Shiny map. Also, I am not succeeding in making the panel faded. The width and faded panel I want to replicate is here at this link:
https://shiny.rstudio.com/gallery/superzip-example.html
I am using their style css file, this link: https://github.com/rstudio/shiny-examples/blob/master/063-superzip-example/styles.css
I have written my code:
library(shiny)
library(tidyverse)
library(leaflet.extras)
library(leaflet)
library(RColorBrewer)
library(scales)
library(lattice)
library(dplyr)
fake_data <- read.csv("https://raw.githubusercontent.com/gabrielburcea/stackoverflow_fake_data/master/gather_divided.csv")
# Define UI for application that draws a histogram
ui <- fluidPage(
navbarPage("Covid-19 Symptom Tracker", id = "nav",
tabPanel("Interactive map",
div(class = "outer",
tags$head(
tags$link(rel = "stylesheet", type = "text/css", href = "style.css")
),
leafletOutput("map", width = "100%", height = "96vh"), #height = "99vh"
#Floating panel
absolutePanel(id = "controls", class = "panel panel-default", fixed = TRUE,
draggable = TRUE, top = 60, left = "auto", right = 20, bottom = "auto",
width = 330, height = "auto",
h4("SARS-Covid-19 symptoms"),
selectInput("symptom", "Select symptom", c("Chills",
"Cough", "Diarrhoea",
"Fatigue",
"Headache",
"Loss of smell and taste",
"Muscle ache",
"Nasal congestion",
"Nausea and vomiting",
"Shortness of breath",
"Sore throat",
"Sputum",
"Temperature")
),
tags$div(id="cite",
'Data provided by Your.md'
)
)))
)
)
server <- function(input, output) {
filtered_data <- reactive({
fake_data %>%
dplyr::filter(Symptom %in% input$symptom)
})
output$map <- renderLeaflet({
leaflet() %>%
addTiles(urlTemplate = "//{s}.tiles.mapbox.com/v3/jcheng.map-5ebohr46/{z}/{x}/{y}.png",
attribution = 'Maps by Mapbox') %>%
addMarkers(data = filtered_data(), clusterOptions = markerClusterOptions())
})
}
# Run the application
shinyApp(ui = ui, server = server)
And the css style I am using (just the same as theirs) is here:
https://github.com/gabrielburcea/stackoverflow_fake_data/blob/master/style.css
The panel I have is this which is obviously different than the one in the link I provided:
I get the following output:
when I run your code. I like the floating dialog box which fades. There is some white space along the title, and some more when I zoom out completely. It looks fine to me. Also, I saved the CSS file via Notepad. I don't think that should make any difference if you saved it via RStudio.
I would like to figure out how to use renderImage in Shiny with online located images (URL), and make the image clickable, so that I can hang an observeEvent() to it. I can do both these things, but not together. My approach to render an URL doesn't work with clicking, and the local image version that allows clicking doesn't render URL images.
Here are the two half working versions:
I took some inspiration from here for the
Clickable
library(shiny)
ui <- fluidPage(
imageOutput("image1", click = "MyImage")
)
server <- function(input, output, session) {
setwd(Set the directory of the image in here) #### modify to test
output$image1 <- renderImage({
list(
src = "YOUR_IMAGE.png", #### modify to test
contentType = "image/png",
width = 90,
height = 78,
alt = "This is alternate text"
)}, deleteFile = FALSE)
observeEvent(input$MyImage, { print("Hey there")})
}
shinyApp(ui, server)
if I put an URL in (and remove the deleteFile = FALSE) it shows an empty square. still clickable though.
URLable by using renderUI()
library(shiny)
ui <- fluidPage(
uiOutput("image1", click = "MyImage")
)
server <- function(input, output, session) {
setwd(AppDir)
output$image1<- renderUI({
imgurl2 <- "https://www.rstudio.com/wp-content/uploads/2014/07/RStudio-Logo-Blue-Gradient.png"
tags$img(src=imgurl2, width = 200, height = 100)
})
observeEvent(input$MyImage, { print("Hey there")})
}
shinyApp(ui, server)
shows the image, but the image isn't clickable anymore.
If I change renderUI() and uiOuput() into renderImage() and imageOutput() in example 2, it throws a 'invalid file argument' error.
htmlOuput with renderText
I also tried this version that was in the other SO post, but again, not clickable. This approach is based on the answer on this link
library(shiny)
ui <- fluidPage(
htmlOutput("image1", click = "MyImage")
)
server <- function(input, output, session) {
setwd(AppDir)
imgurl2 <- "https://www.rstudio.com/wp-content/uploads/2014/07/RStudio-Logo-Blue-Gradient.png"
output$image1<- renderText({c('<img src="',imgurl2,'">')})
observeEvent(input$MyImage, { print("Hey there")})
}
shinyApp(ui, server)
I want to move away from local images because that seems to make more sense once we publish the Shiny App. So therefore really in need of a solution that allows rendering of URL images and have them being clickable. Bonus points if somebody can explain why the click = only works local files with imageOutput.
One alternative is to use the onclick function from shinyjs library. It allows you to include click events to specific html elements (targeted by id).
Here's the documentation
In your case the code would look like this:
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
uiOutput("image1", click = "MyImage")
)
server <- function(input, output, session) {
output$image1<- renderUI({
imgurl2 <- "https://www.rstudio.com/wp-content/uploads/2014/07/RStudio-Logo-Blue-Gradient.png"
div(id = "myImage",
tags$img(src = imgurl2, width = 200, height = 100)
)
})
onclick(
myImage,
{
# Do whatever you want!
print("Hey there")
}
)
}
shinyApp(ui, server)
What about transforming image from url into a ggplot as:
library(magick)
library(cowplot)
library(gtools)
library(shiny)
ui <- fluidPage(
uiOutput("myplotoutput"),
uiOutput("text")
)
server <- function(input, output, session) {
output$myplotoutput = renderUI( {
plotOutput("urlimage", click=clickOpts(id="myclick") )
} )
output$text=renderUI({
validate(
need(try(!invalid(input$myclick)), "Text will appear here")
)
textOutput("reactext")
})
output$reactext<-renderText(mytext$texto)
output$urlimage<- renderPlot({
g<- ggdraw() + draw_image("https://jeroen.github.io/images/frink.png")
g
})
mytext<-reactiveValues()
observeEvent(input$myclick, {
mytext$texto<-"Hey there"
})
}
shinyApp(ui, server)
I have been trying to make the image output hyperlink to a website but I am having trouble having perused the other questions on stack overflow
svg with clickable links in shiny - not clickable
http://www.invisiblecompany.com/shiny%20parts/archives/2004/11/clickable-logo.php
http://www.leahkalamakis.com/add-an-image-to-your-sidebar-make-it-clickable/
the tags are not working
server.r
library(shiny)
library(png)
server <- shinyServer(function(input, output) {
output$image1 <- renderImage({
width<- "100%"
height<- "100%"
list(src = "www/logo.png",
contentType = "image/png",
width = width,
height = height,
)
}, deleteFile = FALSE)
output$text1 <- renderText({ "please help make the image hyperlinked" })
})
ui.r
library(shiny)
ui <- shinyUI(pageWithSidebar(
titlePanel(imageOutput("image1")),
sidebarPanel(
helpText( a("Click Here for the Source Code on Github!", href="https://github.com/Bohdan-Khomtchouk/Microscope",target="_blank"))
),
mainPanel(
tabsetPanel(
tabPanel("Instructions",textOutput("text1"))
))
))
you can replace the logo.png with whatever you want I think the hyperlink goes in the list in server.
Just wrap imageOutput with tags$a so in the UI:
titlePanel(tags$a(imageOutput("image1"),href="https://www.google.com"))
If you want to define the webpage from the server side then you need something like this:
#server
output$example <- renderUI({
tags$a(imageOutput("image1"),href="https://www.google.com")
})
#UI
titlePanel(uiOutput("example"))