ShinyApp with ggplot2, custom stat for ribbon (survival curve with confidence intervals)

app.R

library(shiny)
library(survival)
library(ggplot2)

## extension to geom_ribbon (from https://groups.google.com/forum/?fromgroups=#!topic/ggplot2/9cFWHaH1CPs)
stairstepn <- function(data, direction="hv", yvars="y") {
    direction <- match.arg( direction, c( "hv", "vh" ) )
    data <- as.data.frame( data )[ order( data$x ), ]
    n <- nrow( data )

    if ( direction == "vh" ) {
        xs <- rep( 1:n, each = 2 )[ -2 * n ]
        ys <- c( 1, rep( 2:n, each = 2 ) )
    } else {
        ys <- rep( 1:n, each = 2 )[ -2 * n ]
        xs <- c( 1, rep( 2:n, each = 2))
    }

    data.frame(x = data$x[ xs ], data[ ys, yvars, drop=FALSE ],
               data[ xs, setdiff( names( data ), c( "x", yvars ) ), drop=FALSE ])
}

stat_stepribbon <- function(mapping = NULL, data = NULL, geom = "ribbon", position = "identity", inherit.aes = TRUE) {
    layer(stat = Stepribbon, mapping = mapping, data = data, geom = geom,
                   position = position, inherit.aes = inherit.aes)
}

StatStepribbon <- ggproto("stepribbon", Stat,
                          compute_group = function(., data, scales, direction = "hv", yvars = c( "ymin", "ymax" ), ...) {
                              stairstepn( data = data, direction = direction, yvars = yvars ) }, required_aes = c( "x", "ymin", "ymax" ))


# Define the UI
ui <- bootstrapPage(
  plotOutput('plot')
)


# Define the server code
server <- function(input, output) {

    sfit <- data.frame(time = c(0, 1, 2, 3, 4),
                       surv = c(1, 0.537567714669201, 0.294594032546376, 0.209760214997243, 0.0948457531854178),
                       up = c(1, 0.707052113440639, 0.47514830780086, 0.393329500185471, 0.270292701179633),
                       low = c(1, 0.408709686826966, 0.182649590847976, 0.11186383877879, 0.0332813903521974),
                       cens = c(0, 3, 2, 0, 3))
    
  output$plot <- renderPlot({
      g <- ggplot(sfit, aes(time, surv), environment=environment())
      g <- g + geom_ribbon(aes(ymin=low, ymax=up), stat="stepribbon", alpha=1/10, show.legend=FALSE)
      g <- g + geom_step() + geom_point(data=subset(sfit, cens!=0), size=3, pch=3, show.legend=FALSE)
      g
  })

}

# Return a Shiny app object
shinyApp(ui = ui, server = server)

functions.R

## extension to geom_ribbon (from https://groups.google.com/forum/?fromgroups=#!topic/ggplot2/9cFWHaH1CPs)
stairstepn <- function(data, direction="hv", yvars="y") {
    direction <- match.arg( direction, c( "hv", "vh" ) )
    data <- as.data.frame( data )[ order( data$x ), ]
    n <- nrow( data )

    if ( direction == "vh" ) {
        xs <- rep( 1:n, each = 2 )[ -2 * n ]
        ys <- c( 1, rep( 2:n, each = 2 ) )
    } else {
        ys <- rep( 1:n, each = 2 )[ -2 * n ]
        xs <- c( 1, rep( 2:n, each = 2))
    }

    data.frame(x = data$x[ xs ], data[ ys, yvars, drop=FALSE ],
               data[ xs, setdiff( names( data ), c( "x", yvars ) ), drop=FALSE ])
}

stat_stepribbon <- function(mapping = NULL, data = NULL, geom = "ribbon", position = "identity", inherit.aes = TRUE) {
    layer(stat = Stepribbon, mapping = mapping, data = data, geom = geom,
                   position = position, inherit.aes = inherit.aes)
}

StatStepribbon <- ggproto("stepribbon", Stat,
                          compute_group = function(., data, scales, direction = "hv", yvars = c( "ymin", "ymax" ), ...) {
                              stairstepn( data = data, direction = direction, yvars = yvars ) }, required_aes = c( "x", "ymin", "ymax" ))