BROKEN - NEW VERSION IN PROGRESS. ................................................. - users input a function of several variables, select one unknown and several parameter values, the app produces a customizable plot. This is a first version. Also experimental is the layout, based on several panels: they don't always look good, depending on zoom…

global.R

# global.R

# Author: Patrick Toche, first version 12 January 2014
# I am very grateful for generous help received on stackoverflow and on the shiny-discuss forum 
# Please fix, improve, fork, share, whatever...

# gArg = default arguments
# gFun = default function

# Static Parameters
gArg <- list(a = 1, b = 2, c = 1, d = 1)

# Static Function
gFun <- function(a = 1, b = 2, ...) {
  max(a,b)*sign(b)*abs(a)^b
} 

server.R

# server.R

library("shiny")
library("ggplot2")
library("grid") # provides function unit() for ggplot2

shinyServer(
  function(input, output, session) {
   
    
    # Part I. Reactive Argument
    Arg <- reactive({
         list(a = input$a, b = input$b, c = input$c, input$d)
    })

    
    
    # Part II. Reactive Function

    Fun <- reactive({
        # 1. replace selected parameter input$x with x
        # 2. replace all non-selected parameters a with input$a
        # 3. pass list to global function and return a function of x
        function(var = input$X, par = Arg()){
          par[[var]] = as.name("x")
          
          # Version 1 # input in global.R: gFun
          # function(x) {do.call(gFun, par)}
          
          # Version 2 # input in box: function(a=1,b=2,...) {max(a,b)*sign(b)*abs(a)^b}
          function(x) {do.call(eval(parse(text = input$inFun)), par)}
          
          # Version 3 # input in box: max(a,b)*sign(b)*abs(a)^b
#          function(x) {do.call(eval(parse(text = 
#                paste0("function(",Arg(),",...){",input$inFun,"}")
#          )), par)}
        }
    })
    
    
    # Part III. Reactive Plot

    Plot <- reactive({
      if (is.null(input$Xlabs) || !nzchar(input$Xlabs)) {Xlabs <- input$X} else {Xlabs <- input$Xlabs}
      if (is.null(input$Ylabs) || !nzchar(input$Ylabs)) {Ylabs <- paste0("f(",input$X,")")} else {Ylabs <- input$Ylabs}
      if (input$Nolabs) {Xlabs <- NULL; Ylabs <- NULL}
      if (input$Yflip) {Yangle <- 90} else {Yangle <- 0}
      if (input$Bgflip) {Bgcol <- "white"} else {Bgcol <- "grey90"}
      if (input$Grflip) {Grcol <- "grey95"; Grmaj <- 0; Grmin <- 0} else {Grcol <- "black"; Grmaj <- 0.12; Grmin <- 0.03}
      
      # basic plot
      df <- data.frame(x = input$Xrange)
      p <- ggplot(df, aes(x))
      p <- p + ylim(input$Yrange)
      p <- p + stat_function(fun = Fun()(input$X)
        , geom = ifelse(input$Geom=="symbol", "point", input$Geom)
        , colour = input$Colour
        , alpha = (input$Alpha)
        , shape = ifelse(input$Geom=="symbol",as.numeric(input$Shape),16)
        , size = as.numeric(input$Size) # as.numeric needed for some reason...
      )
      
      # plot refinements
      p <- p + labs(x = Xlabs, y = Ylabs)
      p <- p + ggtitle(paste(input$Title))
      p <- p + theme( 
        axis.title = element_text(size = rel(1.5*input$fontSize))
        , axis.text = element_text(size = rel(1.3*input$fontSize))
        , axis.title.y = element_text(angle = Yangle)
        , panel.background = element_rect(fill = "white")
        , plot.background = element_rect(fill = Bgcol)
        , panel.grid.major = element_line(colour = Grcol, size = Grmaj)
        , panel.grid.minor = element_line(colour = Grcol, size = Grmin)
        , plot.title  = element_text(face = 'bold', colour = "black", size = 20, vjust = 2)
        , plot.margin = unit(c(10, 20, 10, 10), "mm")
      )
      
      # bare plot
      if (input$Noaxis) {
      p <- p + theme(axis.line = element_blank()
        , axis.text = element_blank()
        , axis.ticks = element_blank()
      )}
      
      return(p)
    })
    
    output$plot <- renderPlot({
        print(Plot())
    })
    
    
    # Part IV. Save Plot
    
    output$downloadEPS <- downloadHandler(
    filename = "plot.ps", content = function(file) {
      postscript(file, height=6, width=8, onefile = FALSE, horizontal = FALSE)
      print(Plot())
      dev.off()
    })
    
    output$downloadPDF <- downloadHandler(
    filename = "plot.pdf", content = function(file) {
      pdf(file, height=6, width=8)
      print(Plot())
      dev.off()
    })    
    
    # Part V. Debug Area 
    
    output$Debug <- renderPrint({
         # input$X                                                        # okay
         # input$a                                                        # okay
         # input[["a"]]                                                   # okay
         # gA                                                             # okay
         # gF                                                             # okay
         # gF()                                                           # okay
         # gF(a = 2, b = 20)                                              # okay
         # gF(a = input$a, b = input$b)                                   # okay
         # do.call(gF, list(a = 2, b = 20))                               # okay
         # do.call(gF, list(a = input[["a"]], b = input[["b"]]))          # okay
         # Fun()                                                          # okay
         # input$Xrange                                                   # okay
         # input$Colour                                                   # okay
         # input$Size                                                     # okay
         # input$Alpha                                                    # okay
         # Arg()                                                          # okay
         # input$inFun                                                    # okay
         paste0("function(",Arg(),",...){",input$inFun,"}")
    })
  }
)

ui.R

# ui.R

library("shiny")
library("ggplot2")
library("grid") # provides function unit() for ggplot2

pageWithMultiPanels <- function(headerPanel,mainPanel,sidePanel1,sidePanel2,sidePanel3,footerPanel) {
  bootstrapPage(div(class = "container-fluid"
    , div(class = "row-fluid", headerPanel)
    , div(class = "row-fluid", mainPanel, sidePanel1, sidePanel2, sidePanel3)
    , div(class = "row-fluid", footerPanel)
  ) )
}

shinyUI(
  pageWithMultiPanels(
    headerPanel = headerPanel(h5("Passing arguments to function with substitutions - demo with ggplot - under construction - tested on Firefox & Chrome"))
    ,
    mainPanel = wellPanel(
      # customize display settings    
      tags$head(tags$style(type='text/css'
          , "#main {width: 70%; float: left;}"
          , "#side1 {min-width: 20%; max-width: 35%; float: right;}"
          , "#side2 {min-width: 20%; width: 45%; float: left;}"
          , "#side3 {min-width: 20%; width: 45%; float: right;}"
          , "#inFun {height: 30px; width: 100%;}"
          , "select {width: 100%;}"
          , "textarea, input[type='text'] {width: 100%;}"
          , "body {font-size: 80%;}"
      ) ) 
      , 
      id = "main"
      ,
      plotOutput("plot")
      , 
      sliderInput("Xrange", h4("Horizontal range:"), min = -100, max = 100, value = c(-10,10))
      ,
      sliderInput("Yrange", h4("Vertical range:"), min = -1000, max = 1000, value = c(-100,100))
    )
    ,
    sidePanel1 = wellPanel(
      id = "side1"
      ,
      textInput(inputId = "inFun", label = h4("1. Enter a function:"), value = `gFun` ) #"max(a,b)*sign(b)*abs(a)^b")
      ,
      tags$br()
      ,
      selectInput(inputId = "X", label = h4("2. Select a variable:"), choices = names(gArg))
      ,
      tags$br(), tags$br()
      ,
      h4("3. Select parameters:")
      ,
      conditionalPanel(condition = "input.X != 'a'"
        , sliderInput("a", h4("a"), min = -100, max = 100, value = 3)
        , tags$br()
      )
      ,
      conditionalPanel(condition = "input.X != 'b'"
        , sliderInput("b", h4("b"), min = -100, max = 100, value = 2)
        , tags$br()
      )
      ,
      list(downloadButton('downloadEPS', "Save ps"),downloadButton('downloadPDF', "pdf"))
    )
    , 
    sidePanel2 = wellPanel(
      id = "side2"
      ,
      checkboxInput(inputId = "showStyles", label = h4("Plot style:"), value = TRUE)
      ,
      conditionalPanel(condition = "input.showStyles == true"
        , 
        selectInput(inputId = "Geom", label = h5("style"), choices = c("line","point","symbol","smooth","histogram","density","bar","jitter"), selected = "symbol")
        ,
        selectInput(inputId = "Shape", label = h5("symbol"), choices = c(seq(0,20,1)), selected = 0)
        ,
        selectInput(inputId = "Colour", label = h5("colour"), choices = c("black","brown","red","darkblue","blue","darkgreen","green","cyan","white"), selected = "red")
        ,
        selectInput(inputId = "Alpha", label = h5("transparency"), choices = c(seq(0,1,0.1)), selected = 1)
        ,
        selectInput(inputId = "Size", label = h5("thickness"), choices = c(seq(1,10,1)), selected = 2)
      )
    )
    , 
    sidePanel3 = wellPanel(
      id = "side3"
      ,
      checkboxInput(inputId = "showDeco", label = h4("Plot decorations:"), value = TRUE)
      ,
      conditionalPanel(condition = "input.showDeco == true"
        , 
        textInput(inputId = "Title", label = "Enter title here:", value = "Editable Plot Title")
        ,
        textInput(inputId = "Xlabs", label = "Edit horizontal label:", value = NULL)
        ,
        textInput(inputId = "Ylabs", label = "Edit vertical label:", value = NULL)
        ,
        sliderInput("fontSize", h5("Font scale:"), min = 0, max = 2, value = 1, step = 0.1)
        ,
        checkboxInput(inputId = "Yflip", label = "Flip vertical label", value = FALSE)
        ,
        checkboxInput(inputId = "Nolabs", label = "Remove labels", value = FALSE)
        ,
        checkboxInput(inputId = "Bgflip", label = "Remove background", value = FALSE)
        ,
        checkboxInput(inputId = "Grflip", label = "Remove grid", value = FALSE)
        ,
        checkboxInput(inputId = "Noaxis", label = "Remove axes", value = FALSE)
      )
    )
    ,
    footerPanel = wellPanel(
      checkboxInput(inputId = "showDebug", label = "Debug?", value = FALSE)
      ,
      conditionalPanel(condition = "input.showDebug == true"
        , wellPanel(h5("Debug Panel (edit ui.R and server.R):"),textOutput("Debug"), br(), br()
          , h5("Comments:")
          , helpText("This version is limited to 5 parameters 'a', 'b', 'c', 'd', 'e': This can be extended easily by modifying gArg and gFun in global.R and the reactive function Arg() in server.R")
          , helpText("This version is limited to an input of the form: function(a=1,b=2,...){a*b}, together with the ... argument")
          , helpText("To do: allow user to input an expression to be converted in function")
          , helpText("To do: generalize the number of parameters with lapply or do.call or something.")
          , helpText("To do: add slider limits to a numericInput and add updateSliderInput (I know how to do it, just can't be bothered now)") 
          , helpText("To do: dynamically add functions and overlay several plot (maybe try shinyIncubator for this)") 
          , helpText("To do: enable variable names like 'alpha' and 'x1' (may not be that easy to do if you want to use and nest functions like 'min()', 'sign()', etc.  )") 
        )
      )      
    )
  )
)