script in div container - r

Edit: Based on the comment added "". The code works now.
I am trying to embed a 3D mol viewer in my shiny app as described here:
http://3dmol.csb.pitt.edu/doc/tutorial-embeddable.html
I tried the following code:
library(shiny)
ui <- fluidPage(
mainPanel(
fluidRow(
tags$head(HTML('<script src="http://3Dmol.csb.pitt.edu/build/3Dmol-min.js"></script>')),
tags$div(
style="height: 400px; width: 400px; position: relative;",
class='viewer_3Dmoljs',
'data-pdb' ='1YCR',
'data-backgroundcolor' ='0xffffff',
'data-style' ='stick'
))
)
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
It look like the data-pdb, data-backgroundcolor and data-style are not recognized. If I remove these arguments I get a black box. Anybody knows how I could get this working? Also, would it be possible to direct the load-pdb to a local file?

Related

Removing up/down arrows from numericInput() R Shiny

I am interested in removing or hiding the side arrows that appear when you use numericInput() with shiny. I will attach an image of the arrows that I am referring to so everyone can understand which part I would like to remove/hide. After reading the documentation, it does not appear that there is an option to remove these arrows. So I am wondering if there is a way to use CSS to remove these arrows. I did see one other post that asked a similar question. However, I am only interested in using numericInput().
I will attach some sample code. The code essentially does nothing but it will give you a reproducible example.
library(shiny)
server <- function(input, output){
}
ui <- fluidPage(
titlePanel("Test1"),
sidebarLayout(
sidebarPanel(
numericInput("n",
label = h4("Test2"),
min=1,
value = 20),
numericInput("x",
label = h4("Test3"),
min=0,
value = 10),
h4(textOutput("pvalue"))
),
mainPanel(
plotOutput("nullplot")
)
)
)
shinyApp(ui = ui, server = server)
runApp()
WARNING: I have read online that the side arrows do not show up on all web browsers and some versions of RStudio. See here
It does not appear that there is a way to remove the arrows from a numericInput(), however, there is a way to hide them. Just to be clear there is a difference between removing and hiding. Removing the arrows, in theory, should completely remove the code for the arrows. Hiding the arrows will simply mask the code for the side arrows, however, the code will still be present but will not be seen by the user unless they inspect the page.
Below is CSS that can be used to hide the side arrows from numericInput().
tags$head(
tags$style(HTML("
input[type=number] {
-moz-appearance:textfield;
}
input[type=number]::{
-moz-appearance:textfield;
}
input[type=number]::-webkit-outer-spin-button,
input[type=number]::-webkit-inner-spin-button {
-webkit-appearance: none;
margin: 0;
}
"))
)
If you wanted to apply this code to the example given in the question, then you could do something like this
library(shiny)
server <- function(input, output){
}
ui <- fluidPage(
titlePanel("Test1"),
sidebarLayout(
sidebarPanel(
tags$head(
tags$style(HTML("
input[type=number] {
-moz-appearance:textfield;
}
input[type=number]::{
-moz-appearance:textfield;
}
input[type=number]::-webkit-outer-spin-button,
input[type=number]::-webkit-inner-spin-button {
-webkit-appearance: none;
margin: 0;
}
"))
),
numericInput("n",
label = h4("Test2"),
min=1,
value = 20),
numericInput("x",
label = h4("Test3"),
min=0,
value = 10),
h4(textOutput("pvalue"))
),
mainPanel(
plotOutput("nullplot")
)
)
)
shinyApp(ui = ui, server = server)
runApp()
Overall this is just a workaround because there is no option to remove the side arrows.

Building multipage shiny application userside (in ui.R) by using navbarPanel() and hiding the navigation bar?

I want to build a multipage shiny application where I can control which page the user can see. Dean Attali does something similiar in this demonstration app, using shinyjs to hide and show each page.
I suppose there could also be ways to do this by using navbar(), navlist() or tabsetPanel(), if one can hide the navigation bar or the navigation list. Advantages would be to update pages simply via updateTabsetPanel(), updateNavbarPage() or updateNavlistPabel(), and that shinyjs is not neccesary any more.
So my question is: How can I hide the navigation bar of navbarPanel(), for example using CSS?
An example application can be found here: https://shiny.rstudio.com/gallery/navbar-example.html. I tried to include some CSS in this example to hide the navigation bar, but until now I only managed to hide everything (by setting .navbar to visibility:hidden) or everything but the navbar-title (by setting .navbar-nav to visibility:hidden). What is the correct element to hide - or the correct combination of elements to hide and of subelements to make visible again?
EDIT: As Chabo pointed out - the main problem seems to be that when the visibility for the navbar is set to hidden, or even display=none, the app does not set an active tab so nothing else shows up.
#https://shiny.rstudio.com/gallery/navbar-example.html
library(shiny)
ui<- navbarPage("Navbar!",
tags$head(
#here something is wrong.
# .navbar makes everything invisible
#.navbar-nav makes everything invisible but the navbar-title
tags$style(HTML("
.navbar-nav{
visibility: hidden;
}
")
)
),
tabPanel("Plot",
sidebarLayout(
sidebarPanel(
radioButtons("plotType", "Plot type",
c("Scatter"="p", "Line"="l")
)
),
mainPanel(
plotOutput("plot")
)
)
),
tabPanel("Summary",
verbatimTextOutput("summary")
)
)
server<- function(input, output, session) {
output$plot <- renderPlot({
plot(cars, type=input$plotType)
})
output$summary <- renderPrint({
summary(cars)
})
output$table <- DT::renderDataTable({
DT::datatable(cars)
})
}
shinyApp(ui, server)

Set image as cursor in R Shiny

Is there a way to use a web image as cursor when hovering over a button?
I tried something like this:
tags$head(tags$style(HTML(" .custom { cursor: url(https://c2.staticflickr.com/2/1907/31794847918_04f9e687e1_b.jpg), auto;
} ")))
which has no effect, and I can't find any other examples on the web how to manage this in R shiny.
library(shiny)
ui <- fluidPage(
actionButton(inputId = 'messagebutton', label = 'click me')
)
server <- function(input, output, session) {}
shinyApp(ui = ui, server = server)
This example works for me. I think your image isnt working, but I'm not sure why exactly. It might be too big.
library(shiny)
csscode <- HTML("
#messagebutton {
cursor: url(http://www.javascriptkit.com/ajax.gif), auto;
}
")
ui <- fluidPage(
tags$head(tags$style(csscode)),
actionButton(inputId = 'messagebutton', label = 'click me')
)
server <- function(input, output, session) {}
shinyApp(ui = ui, server = server)

Shiny - resize other panels when one of them is set to hidden

I am using Shiny to build a web app. I am adding a button that will show/hide some element on the page. But after the element got hide, other page componemt does not resize themselves to fill the screen. For example, I try to hide the sidebar of a sidebarLayout, by using toggle function in shinyjs. Here's the code I have:
library(shiny)
library(shinyjs)
ui <- fluidPage(useShinyjs(), br(), wellPanel(sidebarLayout(
sidebarPanel(id="sidebar"),
mainPanel(wellPanel(actionButton("sideBarControl", label = "Show/Hide")))
)))
server <- function(input, output) {
observeEvent(input$sideBarControl, {
shinyjs::toggle(id = "sidebar")
# potentially some statements here to fix the layout? But what should they be?
})
}
shinyApp(ui = ui, server = server)
The sidebar hides/shows when clicking sidebarControl button correctly, but instead of resize mainPanel to fill the screen, it shifts mainPanel to the left, and left a space at the right. How to resolve this? See the pictures below:
Let me respond to the comment to my previous suggestion. Since this is quite different from the previous, I write a new answer instead of editing it.
In general, you can inspect what HTML code is generated from your UI description by running the command on console. For example,
sidebarPanel(id="sidebar", actionButton("b", "btn"))
##<div class="col-sm-4">
## <form class="well" id="sidebar">
## <button id="b" type="button" class="btn btn-default action-button">btn</button>
## </form>
##</div>
This tells us that sidebarPanel function generates a nested framework of
div with class col-sm-4; and
form with the supplied id
The reason why your example code did not shifts the main panel is clear now; Even if you hide sidebar, which is the form inside, there still is div that encloses it.
So we would like a way to hide the div. Unfortunately, I could not find a way to do so with sidebarPanel function. An alternative is to use column function.
column(width=3, id="col", actionButton("b", "btn"))
##<div class="col-sm-3" id="col">
## <button id="b" type="button" class="btn btn-default action-button">btn</button>
##</div>
You can see that the output of column is kind of similar to that of sidebarPanel. Importantly, column allows you to give an ID to the div element.
So, here is a toy example that shifts the main panel to the left (i.e. fully hide the sidebar).
library(shiny)
library(shinyjs)
ui <- fluidPage(useShinyjs(), br(), wellPanel(fluidRow(
column(width=4, id="spcol", actionButton("dummy", "dummy")),
column(width=8, wellPanel(actionButton("sideBarControl",
label = "Show/Hide")))
)))
server <- function(input, output) {
observeEvent(input$sideBarControl, {
shinyjs::toggle(id = "spcol")
})
}
shinyApp(ui = ui, server = server)
Now, let's tackle on your second point, that is, letting the main panel to fill, instead of shifting.
mainPanel()
##<div class="col-sm-8"></div>
So it does not fill because its width is set as 8. We want to change it to 12, and we can use toggleClass function from shinyjs library for that. In short, toggleClass adds a class to an element if it does not have one, and removes the class if it already does.
I believe the code below behaves as we wish.
library(shiny)
library(shinyjs)
ui <- fluidPage(useShinyjs(), br(), wellPanel(fluidRow(
column(width=4, id="spcol", actionButton("dummy", "dummy")),
column(width=8, id="main", wellPanel(actionButton("sideBarControl",
label = "Show/Hide")))
)))
server <- function(input, output) {
observeEvent(input$sideBarControl, {
shinyjs::toggle(id = "spcol")
shinyjs::toggleClass("main", "col-sm-8")
shinyjs::toggleClass("main", "col-sm-12")
})
}
shinyApp(ui = ui, server = server)
Also, here is another working example code, in which two versions of main panels with different widths are hidden and shown by turn.
library(shiny)
library(shinyjs)
ui <- fluidPage(useShinyjs(), br(), wellPanel(fluidRow(
column(width=4, id="spcol", actionButton("dummy", "dummy")),
column(width=8, id="main1", wellPanel(actionButton("sideBarControl",
label = "Show/Hide"))),
column(width=12, id="main2", wellPanel(actionButton("sideBarControl2",
label = "Show/Hide")))
)))
server <- function(input, output) {
shinyjs::toggle(id = "main2")
observeEvent(input$sideBarControl+input$sideBarControl2, {
shinyjs::toggle(id = "spcol")
shinyjs::toggle(id = "main1")
shinyjs::toggle(id = "main2")
})
}
shinyApp(ui = ui, server = server)
How about you try shinydashboard? It has the behavior you are looking for by default.
https://rstudio.github.io/shinydashboard/get_started.html

R shiny: color fileInput button and progress bar

Is there a way to color fileInput button in R shiny? It looks like it is possible as shown here on this page on github. However I cannot find the code for this to be done.
This is the simple application that I would like to modify to have the button and progress bar colored red.
In ui.R:
library(shiny)
shinyUI(fluidPage(
titlePanel("Test"),
fileInput("Test","")
))
and server.R
library(shiny)
shinyServer(
function(input, output) {
}
)
Thanks for any advice.
You can use standard Bootstrap classes to style action buttons:
library(shiny)
shinyApp(
ui=shinyUI(bootstrapPage(
actionButton("infoButton", "Info", class="btn-info"),
actionButton("warningButton", "Warning", class="btn-warning"),
actionButton("successButton", "Success", class="btn-success"),
actionButton("dangerButton", "Danger", class="btn-danger"),
actionButton("defaultButton", "Default", class="btn-default"),
actionButton("primaryButton", "Primary", class="btn-primary")
)),
server=shinyServer(function(input, output, session){
})
)
Regarding file inputs as far as I know it is not possible without using CSS directly. Page you've linked is an opened pull-request and it doesn't look like it will be merged soon.
This answer provides a good description how to create fancy upload buttons with bootstrap. It should work just fine in Shiny as well.
CSS could be used in shiny to custom your fileInput widget !
Use the following code in order to color it in red.
NB - Any browser you're using to view the app should have developer tools that let you inspect elements and see styles applied to any element. You have to right click on the relevant element and choose inspect !
library(shiny)
ui <- fluidPage(
fileInput(inputId = "Test",label = ""),
tags$style("
.btn-file {
background-color:red;
border-color: red;
}
.progress-bar {
background-color: red;
}
")
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)

Resources