function(input, output, session) {
histColor <- reactive({
input$color1
input$color2
sample(colors(), 1)
})
output$distPlot <- renderPlot({
Sys.sleep(2)
x <- faithful[, 2] # Old Faithful Geyser data
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = histColor(), border = 'white',
main = input$title)
})
output$slider_info1 <- renderPrint({
cat('The value of the slider input is', input$bins)
})
output$slider_info2 <- renderPrint({
cat('The value of the slider input is', input$bins)
})
output$error_info <- renderPrint({
stop('A bad error occurred!')
})
observe({
updateTextInput(session, 'title', value = paste(input$bins, 'bins'))
})
observeEvent(input$message, {
session$sendCustomMessage('special', list(a = rnorm(10), b = letters))
})
observeEvent(input$busy, {
message('Shiny will be busy for 2 seconds')
Sys.sleep(2)
})
observeEvent(input$end, session$close())
}
library(shiny)
fluidPage(
title = 'JavaScript events in shiny',
tags$head(singleton(tags$script(src = 'events.js'))),
sidebarLayout(
sidebarPanel(
textInput('title', 'Title', 'Histogram Title'),
sliderInput('bins', 'Number of bins:', min = 1, max = 50, value = 30),
actionButton('color1', 'Change color'),
actionButton('color2', 'Change color (canceled)'),
actionButton('message', 'Send message'),
actionButton('busy', 'Be busy for 2 seconds'),
actionButton('end', 'End session')
),
mainPanel(
plotOutput('distPlot'),
verbatimTextOutput('slider_info1'),
verbatimTextOutput('slider_info2'),
textOutput('error_info')
)
),
div(
id = 'busyModal', class = 'modal', role = 'dialog', 'data-backdrop' = 'static',
div(
class = 'modal-dialog modal-sm',
div(
class = 'modal-content',
div(class = 'modal-header', h4(class = 'modal-title', 'Shiny is busy!')),
div(class = 'modal-body', p(paste(
'This dialog box will disappear',
'automatically after shiny is idle.'
)))
)
)
)
)
$(function() {
$(document).on({
'shiny:connected': function(event) {
$('form.well').fadeOut(3000).fadeIn(2000);
},
'shiny:disconnected': function(event) {
alert('Disconnected! The web socket state is ' + event.socket.readyState);
},
'shiny:busy': function(event) {
$('#busyModal').modal('show');
},
'shiny:idle': function(event) {
$('#busyModal').modal('hide');
},
'shiny:inputchanged': function(event) {
switch (event.name) {
// modify the title value during the event
case 'title':
event.value += ' (title modified by the JS event based on input$title)';
break;
// cancel the event so this button does not update the color
case 'color2':
event.preventDefault();
break;
default:
}
},
'shiny:message': function(event) {
console.log('Received a message from Shiny');
var msg = event.message;
if (msg.hasOwnProperty('custom') && msg.custom.hasOwnProperty('special')) {
console.log('This is a special message from Shiny:');
console.log(msg.custom.special);
}
},
'shiny:bound': function(event) {
console.log('An ' + event.bindingType + ' (' + event.binding.name + ') was bound to Shiny');
},
'shiny:updateinput': function(event) {
console.log({
'Input message': event.message,
'To be applied to': event.target
});
},
'shiny:value': function(event) {
if (event.name === 'slider_info2') {
event.value = 'My output was modified by the shiny:value event.\n' +
'Now I do not know the value of the slider.';
}
},
'shiny:error': function(event) {
if (event.name === 'error_info') {
event.error.message = 'A nice error occurred :)';
}
},
'shiny:recalculating': function(event) {
console.log('An output is being recalculated... ' + new Date());
},
'shiny:recalculated': function(event) {
console.log('An output has been recalculated! ' + new Date());
}
});
// when the slider input is bound, add a red border to it
$('#bins').on('shiny:bound', function(event) {
$(this).parent().css('border', 'dotted 2px red');
});
Shiny.addCustomMessageHandler('special', function(message) {
//
});
});