I made the following script to show 1.pdf, but nothing shows up after clicking on start.
Any comments would be great.
Appreciate!
shinyApp(
ui <- function(){
tagList(tabPanel(""),
pageWithSidebar(
headerPanel(
""
),
sidebarPanel
(
tags$head(tags$style(type="text/css", ".well { max-width: 280px; }")),
actionButton("strt", label = "Start",style="width:32%;"),
actionButton("logout", "Logout",style="color: red; width:32%;")
),
mainPanel(tableOutput('path'))
)
)
},
server = (function(input, output,session) {
observeEvent(input$strt, {
output$path <- renderUI({tags$iframe(src="E:/shiny/Correct/www/1.pdf",style="height:800px; width:100%;scrolling=yes")})
})
})
)
I solved it as follows:
observeEvent(input$strt, {
addResourcePath("pdf_folder","E:/shiny/Correct")
output$path <- renderUI({tags$iframe(src="pdf_folder/1.pdf",style="height:800px; width:100%;scrolling=yes")})
})
Related
I want to understand how we can interact server section of code with pure JS (or Jquery). I prepared two examples - Basically I want to hide h4( ) on clicking of button by user. First example works as expected but second one does not work as h4() is in renderUI( ) in server. I know this can be solved via observeEvent or shinyJS package but I am more interested to make it work with pure JS not running JS code in server.
Example 1
library(shiny)
ui <- fluidPage(
fluidRow(
h4("Testing"),
actionButton("Disable", "Disable Element"),
tags$script("
$(document).ready(function() {
$('#Disable').click(function(){
$('h4').css('display', 'none');
});
})")
)
)
shinyApp(ui, server = function(input, output) { })
Example 2
ui <- fluidPage(
fluidRow(
h4("Testing"),
uiOutput("myfun"),
tags$script("
$(document).ready(function() {
$('#Disable').click(function(){
$('h4').css('display', 'none');
});
})")
)
)
shinyApp(ui, server = function(input, output) {
output$myfun <- renderUI({
tagList(
actionButton("Disable", "Disable Element")
)
})
})
One option is to add an onclick event to the button itself.
ui <- fluidPage(
fluidRow(
h4("Testing"),
uiOutput("myfun"),
tags$script("hideH4 = function() {$('h4').css('display', 'none');}")
)
)
shinyApp(ui, server = function(input, output) {
output$myfun <- renderUI({
tagList(
actionButton("Disable", "Disable Element", onclick="hideH4()")
)
})
})
Or add a document event hadler for the click and check the ID
ui <- fluidPage(
fluidRow(
h4("Testing"),
uiOutput("myfun"),
tags$script("
$(document).click(function(evt) {
if (evt.target.id=='Disable') {
$('h4').css('display', 'none');
}})")
)
)
shinyApp(ui, server = function(input, output) {
output$myfun <- renderUI({
tagList(
actionButton("Disable", "Disable Element")
)
})
})
How do I increase the width of the R Shiny notification popup? Right now it's cutting off longer error messages.
library(shiny)
ui <- fluidPage(
actionButton("test", "Test")
)
server <- function(input, output, session) {
observeEvent(input$test, {
showNotification("You did it! Now make me wider", type = "message")
})
}
shinyApp(ui, server)
You can adjust several aspects of the appearance with css
library(shiny)
ui <- fluidPage(
tags$style(".shiny-notification {color: black; background-color: red; border: 1px solid red;padding: 0 50px 0 50px;}"),
actionButton("test", "Test")
)
server <- function(input, output, session) {
observeEvent(input$test, {
showNotification("You did it! Now make me wider", type = "message")
})
}
shinyApp(ui, server)
https://developer.mozilla.org/en-US/docs/Web/CSS/box-sizing
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)
I have RShiny code, with which i want to disable/enable number input with checkbox. However, it works only for disable.
library(shiny)
runApp(shinyApp(
ui = fluidPage(
shinyjs::useShinyjs(),
numericInput("test", "Test", 5),
checkboxInput("submit", label="Choose")
),
server = function(input, output, session) {
observeEvent(input$submit, {
shinyjs::disable("test")
})
}
))
How could I fix that?
Your code is mostly correct. The bug is in what you are observing. Your code would work fine if you are using an action button. But for the checkbox, you need to disable the input when the checkbox is unchecked, and enable when checked, and not just observe the event.
library(shiny)
runApp(shinyApp(
ui = fluidPage(
shinyjs::useShinyjs(),
numericInput("test", "Test", 5),
checkboxInput("submit", label="Choose")
),
server = function(input, output, session) {
observeEvent(input$submit, {
if(input$submit == F){
shinyjs::disable("test")
} else {
shinyjs::enable("test")
}
})
}
))
I am using R-3.2.0 hosted on Red Hat Linux version 6.5 with shiny package (version 0.12.0). I am trying to utilize shinydashboard functionality to design a few reports. The RStudio version is 0.98.1103
I have successfully setup ui.R and server.R
ui.R - :
ibrary(shinydashboard)
library(htmlwidgets)
library(rpivotTable)
library(leaflet)
dashboardPage(
dashboardHeader(title="Reports",
dropdownMenu(type = "task",
messageItem(
from = "Download",
message = "test",
icon = icon("gear")
),
messageItem(
"Download",
message = "TEST",
icon = icon("life-ring"),
href= "http://www.google.com"
)
)
),
dashboardSidebar(
sidebarMenu(
menuItem("Srts", tabName = "ServiceItems", icon = icon("dashboard"))
)
),
dashboardBody(
tags$head(tags$style(
type = 'text/css',
'#test{ overflow-x: scroll; }')),
rpivotTableOutput('PivotTable')
)
)
server.R -:
library(shiny)
library(ggplot2)
library(wordcloud)
library(devtools)
library(htmlwidgets)
library(rpivotTable)
library(leaflet)
shinyServer(function(input, output) {
PivotTable <- read.csv("Book2.csv",head=TRUE,sep= ',')
output$PivotTable <- rpivotTable::renderRpivotTable({
rpivotTable(PivotTable, rows="Ar", col="DTM", aggregatorName="Count",
vals="Ar", rendererName="Table")})
tableFirst<-as.data.frame(sort(table(PivotTable$Area),decreasing=TRUE))
})
The following code to enable scrolling in the dashboard body was taken from https://github.com/smartinsightsfromdata/rpivotTable/issues/19 :-
tags$head(tags$style(
type = 'text/css',
'#test{ overflow-x: scroll; }')),
rpivotTableOutput('PivotTable')
The issue I face is that the code added to help scrolling does not work. I have stripped my code of all tabs , layouts etc but I am still enable to get scrolling to work.
I have observed that if I remove the dashboardPage command, scrolling does work but the display is very awkward and not really presentable.
However, when I combine the codes as follows (in RStudio) and run the scrolling works just fine.
library(shiny)
library(shinydashboard)
library(rpivotTable)
library(ggplot2)
PivotTable <- read.csv("Book2.csv",head=TRUE,sep= ',')
header <- dashboardHeader(title="Reports",
dropdownMenu(type = "task",
messageItem(
from = "Download",
message = "test",
icon = icon("gear")
),
messageItem(
"Download",
message = "TEST",
icon = icon("life-ring"),
href= "http://www.google.com"
)
)
)
sidebar <- dashboardSidebar()
body <- dashboardBody(
tags$head(tags$style(HTML('
.skin-blue.main-header .logo {
background-color: #3c8dbc;
}
.skin-blue .main-header .logo:hover {
background-color: #3c8dbc;
}
'))
),
tags$head(tags$style(type = 'text/css',
'#test{ overflow-x: scroll; }')),
rpivotTableOutput("test")
)
shinyApp(
ui = dashboardPage(header, sidebar, body),
server = function(input, output) {
output$test <- rpivotTable::renderRpivotTable({
rpivotTable(PivotTable, rows="Ar", col="DTM", aggregatorName="Count",vals="Ar", rendererName="Table")})
})
However, I cannot provide this as a final solution because the business users that need this are not adept at copying and pasting code on RStudio (If there is a possible way that I can use the combined code just like the usual one I can consider that as well).
Can someone please help me understand the issue with my original code that prevents scrolling.
Thanks a lot !
The problem is your CSS selector otherwise everything looks OK. Your setting the scroll-property on a element with ID test but I can't find a element with this ID in your example. Try something like this:
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(
tags$head(
tags$style(
HTML("
#myScrollBox{
overflow-y: scroll;
overflow-x: hidden;
height:120px;
}
")
)
),
# Boxes need to be put in a row (or column)
fluidRow(
div(id="myScrollBox",
plotOutput("plot1", height = 250)),
box(
title = "Controls",
sliderInput("slider", "Number of observations:", 1, 100, 50)
)
)
)
)
server <- function(input, output) {
set.seed(122)
histdata <- rnorm(500)
output$plot1 <- renderPlot({
data <- histdata[seq_len(input$slider)]
hist(data)
})
}
shinyApp(ui, server)
You need to change the CSS selector to the element you want to put the scroll on, in the example this is "myScrollBox".
The only thing which you should be taking in to consideration is to pass the exact same id before CSS code, so in this code replace #test to #PivotTable and bingo... your code should work...
tags$head(tags$style(
type = 'text/css',
'#test{ overflow-x: scroll; }')),
rpivotTableOutput('PivotTable')