R language WIP

[shawwn]

I'm submitting this as an example of extending Lumen to compile to additional languages, without necessarily being self-hosted.

This adds support for the R language.

Example:

(library shiny)

(when-compiling
  (define-macro \page body
    `(fluidPage ,@body))
  (define-macro \h1 args
    `(titlePanel ,@args))
  (define-macro \sidebar body
    `(sidebarPanel ,@body))
  (define-macro \main body
    `(mainPanel ,@body))
  (define-macro \vsplit (lh rest: body)
    `(sidebarLayout ,lh (\main ,@body)))
  ; (define-macro \side args
  ;   `(sidebarPanel ,@args))
  ; (define-macro \body args
  ;   `(mainPanel ,@args))
  (define-macro \menu (id label choices selected rest: args)
    `(selectInput inputId: ,id
                  label: ,label
                  choices: ,choices
                  selected: ,selected
                  ,@args))
  (define-macro \range (id label value min max step rest: args)
    (set min (either min 0))
    (set max (either max 100))
    (set value (either value min))
    `(sliderInput
       inputId: ,id
       label: ,label
       min: ,min
       max: ,max
       value: ,value
       step: ,step
       ,@args))
  (define-macro \num (id label value min max step rest: args)
    `(numericInput
       inputId: ,id
       label: ,label
       value: ,(either value 0)
       min: ,min
       max: ,max
       step: ,step
       ,@args))
  (define-macro \int args `(\num ,@args))
  (define-macro \bool (id label value rest: args)
    ;`(\menu ,id ,label (list "yes" "no") (|`if`| ,(or value 'false) "yes" "no") ,@args))
    `(checkboxInput inputId: ,id label: ,label value: ,value ,@args))
  (define-macro \oplot (name rest: args)
    `(plotOutput
       outputId: ,name
       ,@args))
  (define-macro \otext (name rest: args)
    `(verbatimTextOutput ,name ,@args))
  (define-macro \otable (name rest: args)
    `(tableOutput ,name ,@args))
  nil)

(define-global ui1
  (\page
    (\h1 "Hello Shiny!")
    (\vsplit
      (\sidebar 
        (\menu "choice1" "Choose" (list "yes" "no") "no")
        (\range "bins" "Number of bins" 30 1 50)
        (\num "i" "Number")
        (\bool "opt1" "Option1" true)
        (\bool "opt2" "Option2" false))
      (\oplot "distPlot"))))

(define-global server1 (input output)
  (define (get output $distPlot)
    (renderPlot
      (%block
        (define x (get faithful $waiting))
        (define bins (seq (min x) (max x) length.out: (+ (get input $bins) 1)))

        (hist x breaks: bins col: "#75AADB" border: "white"
              xlab: "Waiting time to next eruption (in mins)"
              main: "Histogram of waiting times")))))

(shinyApp ui: ui1 server: server1 options: '(port: 3000))

Compiles to:

library(shiny)
ui1 <- fluidPage(titlePanel("Hello Shiny!"), sidebarLayout(sidebarPanel(selectInput(
  inputId = "choice1",
  label = "Choose",
  choices = list("yes", "no"),
  selected = "no"), sliderInput(
  inputId = "bins",
  label = "Number of bins",
  min = 1,
  max = 50,
  value = 30), numericInput(
  inputId = "i",
  label = "Number",
  value = 0), checkboxInput(
  inputId = "opt1",
  label = "Option1",
  value = TRUE), checkboxInput(
  inputId = "opt2",
  label = "Option2",
  value = FALSE)), mainPanel(plotOutput(
  outputId = "distPlot"))))
server1 <- function (input, output) {
  output$distPlot <- renderPlot({
    x <- faithful$waiting
    bins <- seq(min(x), max(x), 
      length.out = input$bins + 1)
    hist(x, 
      breaks = bins,
      col = "#75AADB",
      border = "white",
      xlab = "Waiting time to next eruption (in mins)",
      main = "Histogram of waiting times")
  })
}
shinyApp(
  ui = ui1,
  server = server1,
  options = list(
    port = 3000))