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"))
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 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)
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) {})
Strangely enough I am getting a scrollbar on the right side of the page when I run the below shiny app:
shinyUI(
fluidPage(
tabsetPanel(
tabPanel("Plot", htmlOutput("test")),
tabPanel("Summary"),
tabPanel("Table")
)
)
)
library(googleVis)
library(shiny)
shinyServer(function(input, output, session) {
output$test <- renderGvis({
gvisBubbleChart(Fruits, idvar="Fruit",
xvar="Sales", yvar="Expenses",
colorvar="Year", sizevar="Profit",
options=list(
hAxis='{minValue:75, maxValue:125}',
vAxis='{minValue:0, maxValue:250}'
,height=600,width=600)
)
})
})
If I change from tabsetPanel layout to a pageWithSidebar layout the plot appears normally without the scrollbars.
On a seperate note, if I do not specify the width and height in the options list I am getting two scrollbars, one vertical and one horizontal.
Is it possible to use googleVis charts within tabsetPanels without the scrollbars?
You can set the overflow to hidden by adding a style argument to the tabPanel call:
library(googleVis)
library(shiny)
runApp(
list(ui = fluidPage(
tabsetPanel(
tabPanel("Plot", htmlOutput("test"), style = "overflow:hidden;"),
tabPanel("Summary"),
tabPanel("Table")
)
)
, server = function(input, output, session) {
output$test <- renderGvis({
gvisBubbleChart(Fruits, idvar="Fruit",
xvar="Sales", yvar="Expenses",
colorvar="Year", sizevar="Profit",
options=list(
hAxis='{minValue:75, maxValue:125}',
vAxis='{minValue:0, maxValue:250}'
,height=600,width=600)
)
})
})
)