R Shiny: Avoid scrollbars when using googleVis charts in tabPanels - html

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)
)
})
})
)

Related

How can I render HTML content in an R Shiny Popify (ShinyBS) tooltip?

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)

Is it possible to allow users to do custom html/css as inputs buttons to alter text similar to common text editors (like word/excel) in a R Shiny app?

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)

Is it possible to have fixed width verbatimTextOutput and have texts change lines in Shiny?

I have a simple app that uses verbatimTextOutput to display some texts. I am wondering if it is possible to have the width of verbatimTextOutput to be fixed and have the text output change lines?
Please see this example (https://yuchenw.shinyapps.io/verbatimtext_bookmark/). I also attached the code below.
As the attached screenshot shows, when the string is very long, the verbatimTextOutput would not show all the text. Instead, the verbatimTextOutput would show a scroll bar at the bottom.
However, I hope there will be no scroll bar at the bottom of the verbatimTextOutput. I also need that when the texts are long, change lines to fit in the verbatimTextOutput. Taking the following as an example, which is by clicking the bookmark button. We can see that this lengthy URL change lines, and there is no scroll bar at the bottom of the output. If the bookmark button can do that, I hope I can also make the verbatimTextOutput show similar characteristics and appearance of the bookmark.
Please let me know if you have any questions.
Code
library(shiny)
ui <- function(request){
fluidPage(
column(
width = 6,
textInput(inputId = "txt", label = "Type in some texts",
value = paste0(rep(letters, 10), collapse = "")),
strong("Show the texts"),
verbatimTextOutput("txt_out"),
br(),
bookmarkButton()
)
)
}
server <- function(input, output, session){
output$txt_out <- renderText({
input$txt
})
}
enableBookmarking("url")
shinyApp(ui, server)
Please try the following css:
library(shiny)
ui <- function(request){
fluidPage(
tags$style(type='text/css', '#txt_out {white-space: pre-wrap;}'),
column(
width = 6,
textInput(inputId = "txt", label = "Type in some texts",
value = paste0(rep(letters, 10), collapse = "")),
strong("Show the texts"),
verbatimTextOutput("txt_out"),
br(),
bookmarkButton()
)
)
}
server <- function(input, output, session){
output$txt_out <- renderText({
input$txt
})
}
enableBookmarking("url")
shinyApp(ui, server)

visNetwork not displaying in panel div

I have started to use shinyLP to make html elements and also make network diagrams using visNetwork. I noticed that visNetwork displays fine when placed in either a well panel or no panel at all. However, it does not display when placed in a panel div, either with shinyLP or through raw HTML. Just to be brief, I am only showing the code differences between not being in a panel and being in a panel div. Does anyone know of a way to make visNetwork appear in this specific container type? I want to use this container type because I want to keep my CSS the way it is and not change things just for this one container. Anyone know the cause of this issue?
This works when visNetworkOutput is not in a panel
library(shinyLP)
library(visNetwork)
ui <- fluidPage(
visNetworkOutput("network")
)
server <- function(input, output) {
output$network <- renderVisNetwork({
# minimal example
nodes <- data.frame(id = 1:3)
edges <- data.frame(from = c(1,2), to = c(1,3))
visNetwork(nodes, edges)
})
}
shinyApp(ui, server)
This fails to display when visNetworkOutput is in a panel
ui <- fluidPage(
panel_div("default", "", visNetworkOutput("network"))
)
server <- function(input, output) {
output$network <- renderVisNetwork({
# minimal example
nodes <- data.frame(id = 1:3)
edges <- data.frame(from = c(1,2), to = c(1,3))
visNetwork(nodes, edges)
})
}
shinyApp(ui, server)
It is a bug in shinyJS version 1.1.0. I found a (awkward) workaround and posted it as a bug in htmlwidgets and Joe Cheng saw it and give me a fix it in like 10 minutes. Awesome...
Here is the code with a better workaround (a new definition of pandel_div):
library(shiny)
library(shinyLP)
library(visNetwork)
# override the currently broken definition in shinyLP version 1.1.0
panel_div <- function(class_type, panel_title, content) {
div(class = sprintf("panel panel-%s", class_type),
div(class = "panel-heading",
h3(class = "panel-title", panel_title)
),
div(class = "panel-body", content)
)
}
ui <- fluidPage(
panel_div("default", "panel1",visNetworkOutput("network") )
)
server <- function(input, output) {
output$network <- renderVisNetwork({
# minimal network
nodes <- data.frame(id = 1:3)
edges <- data.frame(from = c(1,2), to = c(1,3))
visNetwork(nodes,edges)
})
}
shinyApp(ui, server)
And this is what that looks like:
update: Tried with another htmlwidget package (sigma) and got the same behavior. So filing this as an htmlwidget bug: panel_div htmlwidget issue
update: JC identified it as a shinyJS bug. Changed my solution above to reflect his suggestion.

Making an Image Hyperlink in R Shiny header

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"))