Category Archives: Shiny

A Shiny App to Create Sentimental Tweets Based on Project Gutenberg Books

There was something about them that made me uneasy, some longing and at the same time some deadly fear – Dracula (Stoker, Bram)

Twitter is a very good source of inspiration. Some days ago I came across with this:

The tweet refers to a presentation (in Spanish) available here, which is a very concise and well illustrated document about the state-of-the-art of text mining in R. I discovered there several libraries that I will try to use in the future. In this experiment I have used one of them: the syuzhet package. As can be read in the documentation:

this package extracts sentiment and sentiment-derived plot arcs from text using three sentiment dictionaries conveniently packaged for consumption by R users. Implemented dictionaries include syuzhet (default) developed in the Nebraska Literary Lab, afinn developed by Finn Arup Nielsen, bing developed by Minqing Hu and Bing Liu, and nrc developed by Mohammad, Saif M. and Turney, Peter D.

You can find a complete explanation of the package in its vignette. A very interesting application of these techniques is the Sentiment Graph of a book, which represents how sentiment changes over time. This is the Sentiment Graph of Romeo and Juliet, by William Shakespeare, taken from Project Alexandria:

Darkest sentiments can be seen at the end of the book, where the tragedy reaches its highest level. It is also nice to see how sentiments are cyclical. This graphs can be very useful for people who just want to read happy endings books (my sister is one of those).

Inspired by this analysis, I have done another experiment in which I download a book from Project Gutenberg and measure sentiment of all its sentences. Based on this measurement, I filter top 5% (positive or negative sentiment) sentences to build tweets. I have done a Shiny app where all these steps are explained. The app is available here.

From a technical point of view I used selectize JavaScript library to filter books in a flexible way. I customized as well the appearance with CSS bootstrap from Bootswatch as explained here.

This is the code of the experiment.

UI.R:

library(shiny)

fluidPage(theme = "bootstrap.css",

  titlePanel(h1("Sentimental Tweets from Project Gutenberg Books", align="center"),
             windowTitle="Tweets from Project Gutenberg"),
  sidebarLayout(
      sidebarPanel(

        selectInput(
          'book', 'Choose a book:', 
          multiple=FALSE,
          selectize = TRUE,
          choices=c("Enter some words of title or author" = "", gutenberg_works$searchstr)
          ),
        
        radioButtons(inputId = "sent",
             label = "Choose sentiment:",
             choices = c("Dark"="1", "Bright"="20"),
             selected="1",
             inline=TRUE),
        
        radioButtons(inputId = "meth",
                    label = "Choose a method to measure sentiment:",
                    choices = c("syuzhet", "bing", "afinn", "nrc"),
                    selected="syuzhet",
                    inline=TRUE),
        
        radioButtons(inputId = "char",
                     label = "Number of characters (max):",
                     choices = list("140", "280"),
                     inline=TRUE),

        checkboxInput(inputId = "auth",
                      label = "Add author",
                      value=FALSE),
        
        checkboxInput(inputId = "titl",
                      label = "Add title",
                      value=FALSE),
        
        checkboxInput(inputId = "post",
                      label="Add link to post (thanks!)",
                      value=TRUE),
        
        textInput(inputId = "adds",
                  label="Something else?",
                  placeholder="Maybe a #hastag?"),
        
        actionButton('do','Go!', 
                     class="btn btn-success action-button", 
                     css.class="btn btn-success")
  ),
  

  
  mainPanel(
     tags$br(),
     p("First of all, choose a book entering some keywords of its 
        title or author and doing dropdown navigation. Books are 
        downloaded from Project Gutenberg. You can browse the complete 
        catalog", tags$a(href = "https://www.gutenberg.org/catalog/", "here.")),

     p("After that, choose the sentiment of tweets you want to generate. 
        There are four possible methods than can return slightly different results. 
        All of them assess the sentiment of each word of a sentence and sum up the 
        result to give a scoring for it. The more negative is this scoring, 
        the", em("darker") ,"is the sentiment. The more positive, the ", em("brighter."), 
        " You can find a nice explanation of these techniques",
        tags$a(href = "http://www.matthewjockers.net/2017/01/12/resurrecting/", "here.")),
        
        p("Next parameters are easy: you can add the title and author of the book where 
          sentence is extracted as well as a link to my blog and any other string you want. 
          Clicking on the lower button you will get after some seconds a tweet below. 
          Click as many times you want until you like the result."),
     
     p("Finally, copy, paste and tweet. ",strong("Enjoy it!")),
     tags$br(),
     tags$blockquote(textOutput("tweet1")),
     tags$br()

)))

Server.R:

library(shiny)

function(input, output) {
  
  values <- reactiveValues(default = 0)
  
  observeEvent(input$do,{
    values$default <- 1
  })

  book <- eventReactive(input$do, {
    GetTweet(input$book, input$meth, input$sent, input$char,
             input$auth, input$titl, input$post, input$adds)
  })
  
  output$tweet1 <- renderText({
    if(values$default == 0){
      "Your tweet will appear here ..."
    }
    else{
      book()
    }
  })
}

Global.R:

library(gutenbergr)
library(dplyr)
library(stringr)
library(syuzhet)

x <- tempdir() # Read the Project Gutenberg catalog and filter english works. I also create a column with # title and author to make searchings gutenberg_metadata %>%
  filter(has_text, language=="en", gutenberg_id>0, !is.na(author)) %>%
  mutate(searchstr=ifelse(is.na(author), title, paste(title, author, sep= " - "))) %>%
  mutate(searchstr=str_replace_all(searchstr, "[\r\n]" , "")) %>%
  group_by(searchstr) %>%
  summarize(gutenberg_id=min(gutenberg_id)) %>%
  ungroup() %>%
  na.omit() %>%
  filter(str_length(searchstr)<100)-> gutenberg_works

# This function generates a tweet according the UI settings (book, method, sentiment and
# number of characters). It also appends some optional strings at the end
GetTweet = function (string, method, sentim, characters,
                     author, title, link, hastag)
 {
  # Obtain gutenberg_id from book 
  gutenberg_works %>%
     filter(searchstr == string) %>%
     select(gutenberg_id) %>% .$gutenberg_id -> result
  
  # Download text, divide into sentences and score sentiment. Save results to do it once and
  # optimize performance
  if(!file.exists(paste0(x,"/","book",result,"_",method,".RDS")))
  {
    book=gutenberg_download(result)
    book[,2] %>% 
      as.data.frame() %>% 
      .$text %>% 
      paste(collapse=" ") -> text
    
    sentences_v <- get_sentences(text)
    sentiment_v <- get_sentiment(sentences_v, method=method) data.frame(sentence=sentences_v, sentiment=sentiment_v) %>% 
      mutate(length=str_length(sentence)) -> results
    saveRDS(results, paste0(x,"/","book",result,"_",method,".RDS"))
  }
   
  results=readRDS(paste0(x,"/","book",result,"_",method,".RDS"))
  book_info=gutenberg_metadata %>% filter(gutenberg_id==result)
  
  # Paste optional strings to append at the end
  post=""
  if (title)  post=paste("-", book_info[,"title"], post, sep=" ")
  if (author) post=paste0(post, " (", str_trim(book_info[,"author"]), ")")
  if (link)   post=paste(post, "https://wp.me/p7VZWY-16S", sep=" ")
  post=paste(post, hastag, sep=" ")
  length_post=nchar(post)

  # Calculate 5% quantiles
  results %>% 
    filter(length<=(as.numeric(characters)-length_post)) %>%
     mutate(sentiment=jitter(sentiment)) %>% 
     mutate(group = cut(sentiment, 
                        include.lowest = FALSE,
                        labels = FALSE,
                        breaks = quantile(sentiment, probs = seq(0, 1, 0.05)))) -> results
   
  # Obtain a sample sentence according sentiment and append optional string to create tweet
  results %>% 
     filter(group==as.numeric(sentim)) %>% 
     sample_n(1) %>% 
     select(sentence) %>% 
     .$sentence %>% 
     as.character() %>% 
     str_replace_all("[.]", "") %>% 
    paste(post, sep=" ") -> tweet
  
  return(tweet)

 }

A Shiny App to Draw Curves Based on L-System

Don’t worry about a thing ’cause every little thing gonna be alright (Three Little Birds, Bob Marley)

One of my favourite books is The Computational Beauty of Nature by Gary William Flake where there is a fantastic chapter about fractals in which I discovered the L-Systems.

L-Systems were conceived  in 1968 by Aristide Lindenmayer, a Hungarian biologist, as a mathematical description of plant growth. Apart from the Wikipedia, there are many places on the Internet where you can read about them. If you are interested, don’t miss The Algorithmic Beauty of Plants, an awesome book by Przemysław Prusinkiewicz that you can obtain here for free.

Roughly speaking, a L-System is a very efficient way to make drawings. In its simplest way consists in two different actions: draw a straigh line and change the angle. This is just what you need, for example, to draw a square: draw a straigh line of  any length, turn 90 degrees (without drawing), draw another straigh line of the same length, turn 90 degrees in the same direction, draw, turn and draw again. Denoting F as the action of drawing a line of length d and + as turning 90 degrees right, the whole process to draw a square can be represented as F+F+F+F.

L-Systems are quite simple to program in R. You only need to substitute the rules iteratively into the axiom (I use gsubfn function to do it) and split the resulting chain into parts with str_extract_all, for example. The result is a set of very simple actions (draw or turn) that can be visualized with ggplot and its path geometry. There are four important parameters in L-Systems:

  • The seed of the drawing, called axiom
  • The substitutions to be applied iteratively, called rules
  • How many times to apply substitutions, called depth
  • Angle of each turning

For example, let’s define the next L-System:

  • Axiom: F-F-F-F
  • Rule: F → F−F+F+FF−F−F+F

The rule means that every F must be replaced by F−F+F+FF−F−F+F while + means right turning and - left one. After one iteration, the axiom is replaced by F-F+F+FF-F-F+F-F-F+F+FF-F-F+F-F-F+F+FF-F-F+F-F-F+F+FF-F-F+F and iterating again, the new string is F-F+F+FF-F-F+F-F-F+F+FF-F-F+F+F-F+F+FF-F-F+F+F-F+F+FF-F-F+FF-F+F+FF-F-F+F-F-F+F+FF-F-F+F-F-F+F+FF-F-F+F+F-F+F+FF-F-F+F-F-F+F+FF-F-F+F-F-F+F+FF-F-F+F+F-F+F+FF-F-F+F+F-F+F+FF-F-F+FF-F+F+FF-F-F+F-F-F+F+FF-F-F+F-F-F+F+FF-F-F+F+F-F+F+FF-F-F+F-F-F+F+FF-F-F+F-F-F+F+FF-F-F+F+F-F+F+FF-F-F+F+F-F+F+FF-F-F+FF-F+F+FF-F-F+F-F-F+F+FF-F-F+F-F-F+F+FF-F-F+F+F-F+F+FF-F-F+F-F-F+F+FF-F-F+F-F-F+F+FF-F-F+F+F-F+F+FF-F-F+F+F-F+F+FF-F-F+FF-F+F+FF-F-F+F-F-F+F+FF-F-F+F-F-F+F+FF-F-F+F+F-F+F+FF-F-F+F. As you can see, the length of the string grows exponentially. Converting last string into actions, produces this drawing, called Koch Island:

It is funny how different axioms and rules produce very different drawings. I have done a Shiny App to play with L-systems. Although it is quite simple, it has two interesting features I would like to undeline:

  • Delay reactions with eventReactive to allow to set depth and angle values before refreshing the plot
  • Build a dynamic UI that reacts to user input depending on the curve choosen

There are twelve curves in the application: Koch Island (and 6 variations), cuadratic snowflake, Sierpinsky triangle, hexagonal Gosper, quadratic Gosper and Dragon curve. These are their plots:

The definition of all these curves (axiom and rules) can be found in the first chapter of the Prusinkiewicz’s book. The magic comes when you modify angles and colors. These are some examples among the infinite number of possibilities that can be created:

I enjoyed a lot doing and playing with the app. You can try it here. If you do a nice drawing, please let me know in Twitter or dropping me an email. This is the code of the App:

ui.R:

library(shiny)

shinyUI(fluidPage(
  titlePanel("Curves based on L-systems"),
  
  sidebarLayout(
    sidebarPanel(
      selectInput("cur", "Choose a curve:",
                  c("","Koch Island",
                    "Cuadratic Snowflake",
                    "Koch Variation 1",
                    "Koch Variation 2",
                    "Koch Variation 3",
                    "Koch Variation 4",
                    "Koch Variation 5",
                    "Koch Variation 6",
                    "Sierpinsky Triangle",
                    "Dragon Curve",
                    "Hexagonal Gosper Curve",
                    "Quadratic Gosper Curve"),
                  selected = ""),
      
      conditionalPanel(
        condition = "input.cur != \"\"",
        uiOutput("Iterations")),
      
      conditionalPanel(
        condition = "input.cur != \"\"",
        uiOutput("Angle")),
      
      conditionalPanel(
        condition = "input.cur != \"\"",
        selectInput("lic", label = "Line color:", choices = colors(), selected = "black")),
      
      
      conditionalPanel(
        condition = "input.cur != \"\"",
        selectInput("bac", label = "Background color:", choices = colors(), selected = "white")),
      
      conditionalPanel(
        condition = "input.cur != \"\"",
        actionButton(inputId = "go", label = "Go!", 
                     style="color: #fff; background-color: #337ab7; border-color: #2e6da4"))
      
      
      
      
    ), 
    mainPanel(plotOutput("curve", height="550px", width = "100%"))
  )
  
))

server.R:

library(shiny)
library(gsubfn)
library(stringr)
library(dplyr)
library(ggplot2)
library(rlist)

shinyServer(function(input, output) {
   
  curves=list(
    list(name="Koch Island",
         axiom="F-F-F-F",
         rules=list("F"="F-F+F+FF-F-F+F"),
         angle=90,
         n=2,
         alfa0=90),
    list(name="Cuadratic Snowflake",
         axiom="-F",
         rules=list("F"="F+F-F-F+F"),
         angle=90,
         n=4,
         alfa0=90),
    list(name="Koch Variation 1",
         axiom="F-F-F-F",
         rules=list("F"="FF-F-F-F-F-F+F"),
         angle=90,
         n=3,
         alfa0=90),
    list(name="Koch Variation 2",
         axiom="F-F-F-F",
         rules=list("F"="FF-F-F-F-FF"),
         angle=90,
         n=4,
         alfa0=90),
    list(name="Koch Variation 3",
         axiom="F-F-F-F",
         rules=list("F"="FF-F+F-F-FF"),
         angle=90,
         n=3,
         alfa0=90),
    list(name="Koch Variation 4",
         axiom="F-F-F-F",
         rules=list("F"="FF-F--F-F"),
         angle=90,
         n=4,
         alfa0=90),
    list(name="Koch Variation 5",
         axiom="F-F-F-F",
         rules=list("F"="F-FF--F-F"),
         angle=90,
         n=5,
         alfa0=90),
    list(name="Koch Variation 6",
         axiom="F-F-F-F",
         rules=list("F"="F-F+F-F-F"),
         angle=90,
         n=4,
         alfa0=90),
    list(name="Sierpinsky Triangle",
         axiom="R",
         rules=list("L"="R+L+R", "R"="L-R-L"),
         angle=60,
         n=6,
         alfa0=0),
    list(name="Dragon Curve",
         axiom="L",
         rules=list("L"="L+R+", "R"="-L-R"),
         angle=90,
         n=10,
         alfa0=90),
    list(name="Hexagonal Gosper Curve",
         axiom="L",
         rules=list("L"="L+R++R-L--LL-R+", "R"="-L+RR++R+L--L-R"),
         angle=60,
         n=4,
         alfa0=60),
    list(name="Quadratic Gosper Curve",
         axiom="-R",
         rules=list("L"="LL-R-R+L+L-R-RL+R+LLR-L+R+LL+R-LR-R-L+L+RR-", 
                    "R"="+LL-R-R+L+LR+L-RR-L-R+LRR-L-RL+L+R-R-L+L+RR"),
         angle=90,
         n=2,
         alfa0=90))
  
  output$Iterations <- renderUI({ if (input$cur!="") curve=list.filter(curves, name==input$cur) else curve=list.filter(curves, name=="Koch Island") iterations=list.select(curve, n) %>% unlist
    numericInput("ite", "Depth:", iterations, min = 1, max = (iterations+2))
  })
  
  output$Angle <- renderUI({ curve=list.filter(curves, name==input$cur) angle=list.select(curve, angle) %>% unlist
    numericInput("ang", "Angle:", angle, min = 0, max = 360)
  })
  
  data <- eventReactive(input$go, { curve=list.filter(curves, name==input$cur) axiom=list.select(curve, axiom) %>% unlist
    rules=list.select(curve, rules)[[1]]$rules
    alfa0=list.select(curve, alfa0) %>% unlist
    
    for (i in 1:input$ite) axiom=gsubfn(".", rules, axiom)
    actions=str_extract_all(axiom, "\\d*\\+|\\d*\\-|F|L|R|\\[|\\]|\\|") %>% unlist
    
    points=data.frame(x=0, y=0, alfa=alfa0)
    for (i in 1:length(actions)) 
    {
      if (actions[i]=="F"|actions[i]=="L"|actions[i]=="R")
      {
        x=points[nrow(points), "x"]+cos(points[nrow(points), "alfa"]*(pi/180))
        y=points[nrow(points), "y"]+sin(points[nrow(points), "alfa"]*(pi/180))
        alfa=points[nrow(points), "alfa"]
        points %>% rbind(data.frame(x=x, y=y, alfa=alfa)) -> points
      }
      else{
        alfa=points[nrow(points), "alfa"]
        points[nrow(points), "alfa"]=eval(parse(text=paste0("alfa",actions[i], input$ang)))
      }
    }
    return(points)
  })
  
  output$curve <- renderPlot({    
    ggplot(data(), aes(x, y)) + 
      geom_path(color=input$lic) + 
      coord_fixed(ratio = 1) +
      theme(legend.position="none",
            panel.background = element_rect(fill=input$bac),
            panel.grid=element_blank(),
            axis.ticks=element_blank(),
            axis.title=element_blank(),
            axis.text=element_blank())
  })
    
})

Sunflowers for COLOURlovers

Andar, lo que es andar, anduve encima siempre de las nubes (Del tiempo perdido, Robe)

If you give importance to colours, maybe you know already COLOURlovers. As can be read in their website, COLOURlovers is a creative community where people from around the world create and share colors, palettes and patterns, discuss the latest trends and explore colorful articles… All in the spirit of love.

There is a R package called colourlovers which provides access to the COLOURlovers API. It makes very easy to choose nice colours for your graphics. I used clpalettes function to search for the top palettes of the website. Their names are pretty suggestive as well: Giant Goldfish, Thought Provoking, Adrift in Dreams, let them eat cake … Inspired by this post I have done a Shiny app to create colored flowers using that palettes. Seeds are arranged according to the golden angle. One example:

Some others:

You can play with the app here.

If you want to do your own sunflowers, here you have the code. This is the ui.R file:

library(colourlovers)
library(rlist)
top=clpalettes('top')
sapply(1:length(top), function(x) list.extract(top, x)$title)-&gt;titles

fluidPage(
  titlePanel("Sunflowers for COLOURlovers"),
  fluidRow(
    column(3,
           wellPanel(
             selectInput("pal", label = "Palette:", choices = titles),
             sliderInput("nob", label = "Number of points:", min = 200, max = 500, value = 400, step = 50)
           )
    ),
    mainPanel(
      plotOutput("Flower")
    )
  )
  )

And this is the server.R one:

library(shiny)
library(ggplot2)
library(colourlovers)
library(rlist)
library(dplyr)

top=clpalettes('top')
sapply(1:length(top), function(x) list.extract(top, x)$title)->titles

CreatePlot = function (ang=pi*(3-sqrt(5)), nob=150, siz=15, sha=21, pal="LoversInJapan") {
  
  list.extract(top, which(titles==pal))$colors %>% 
    unlist %>% 
    as.vector() %>% 
    paste0("#", .) -> all_colors
  
  colors=data.frame(hex=all_colors, darkness=colSums(col2rgb(all_colors)))
  colors %>% arrange(-darkness)->colors
  
  background=colors[1,"hex"] %>% as.character

  colors %>% filter(hex!=background) %>% .[,1] %>% as.vector()->colors

  ggplot(data.frame(r=sqrt(1:nob), t=(1:nob)*ang*pi/180), aes(x=r*cos(t), y=r*sin(t)))+
    geom_point(colour=sample(colors, nob, replace=TRUE, prob=exp(1:length(colors))), aes(size=(nob-r)), shape=16)+
    scale_x_continuous(expand=c(0,0), limits=c(-sqrt(nob)*1.4, sqrt(nob)*1.4))+
    scale_y_continuous(expand=c(0,0), limits=c(-sqrt(nob)*1.4, sqrt(nob)*1.4))+
    theme(legend.position="none",
          panel.background = element_rect(fill=background),
          panel.grid=element_blank(),
          axis.ticks=element_blank(),
          axis.title=element_blank(),
          axis.text=element_blank())}

function(input, output) {
 output$Flower=renderPlot({
    CreatePlot(ang=180*(3-sqrt(5)), nob=input$nob, siz=input$siz, sha=as.numeric(input$sha), pal=input$pal)
  }, height = 550, width = 550 )}

The Ex Libris Generator

Go ahead stomp your feet on the floorboards
Clap your hands if that’s really what you came here for
(Heaven, The Milk Carton Kids)

Inspired by curves created by the harmonograph, I have done a Shiny app to generate random images that you can personalize and use as an Exlibris.  You can try the App here. For me, an exlibris (also known as bookplates) can be a nice, original and useful present for book-lovers. This is an example:
exlibris8
More examples:

I always put the code at the end of my posts. Since I always have doubts about how many people are interested in what I do, today will be different. I will share the code with those who ask it to me in any of the following ways:

  • Sending me a direct message on Twitter
  • Droping me an email

Cheers!

Three Shiny Apps to Celebrate the Beauty of Maths

Mathematics knows no races or geographic boundaries; for mathematics, the cultural world is one country (David Hilbert)

One of the best decisions I took this year related with this blog was to move it to my own self-hosted domain using WordPress.org. It allows to me, for example, to embed dynamic JavaScript visualizations like this one. Another thing I can do now is to upload my Shiny Apps to share them with my readers. In this post I have gathered three Apps I made some time ago; you can play with them as well as get the code I wrote for each one:

  • The Harmonograph: This App simulates harmonograph drawings. An harmonograph is a mechanism which draws trajectories by means of two pendulums: one moves a pencil and the other one moves a platform with a piece of paper on it. Click here to try it.
  • Shiny Wool Skeins: This App, inspired by this post, creates a plot consisting of chords inside a circle . You can change colors as well as the number and quality of the chords. Click here to try it.
  • The Coaster Maker: With this App you can create your own coasters using hypocicloids. Click here to try it.

I want to thank to my friend Jorge, without whom I would not have been able to make Shiny work in my server.

The Coaster Maker by Shiny

The word you invented is well formed and could be used in the Italian language (The Accademia della Crusca regarding to the word “Petaloso”, recently invented by an eight-year-old boy)

Are you tired of your old coasters? Do you like to make things by your own? Do you have a PC and a printer at home? If you answered yes to all these questions, just follow these simple instructions:

  • Install R and RStudio in your PC
  • Open RStudio and create a new Shiny Web App multiple file (ui.R/server.R)
  • Substitute sample code of each file by the code below
  • Press Run App
  • Press buttom Get your coaster! until you obtain a image you like
  • Print the image
  • Cut out the image
  • Place on the coaster your favorite drinking

These are some examples:

This is the code of ui.R

#
# This is the user-interface definition of a Shiny web application. You can
# run the application by clicking 'Run App' above.
#
# Find out more about building applications with Shiny here:
#
#    http://shiny.rstudio.com/
#
library(shiny)
shinyUI(fluidPage(
  titlePanel("The coaster maker"),
  sidebarLayout(
    sidebarPanel(
      #helpText(),
 
      # adding the new div tag to the sidebar
      tags$div(class="header", checked=NA,
               tags$p("This coasters are generated by hypocycloid curves.The curve is formed by the locus of a point,
                      attached to a circle, that rolls on the inside of another circle.
                      In the curve's equation the first part denotes the relative position between the two circles,
                      the second part denotes the rotation of the rolling circle.")),
      tags$div(class="header", checked=NA,
               HTML(
"More info <a href=\"http://www.2dcurves.com/roulette/rouletteh.html#rhodon\">here</a>")),
      actionButton('rerun','Get your coaster!')
    ),
    mainPanel(
      plotOutput("HarmPlot")
    )
  )
))

This is the code of server.R

# This is the server logic of a Shiny web application. You can run the
# application by clicking 'Run App' above.
#
# Find out more about building applications with Shiny here:
#
#    http://shiny.rstudio.com/
#
library(shiny)
library(ggplot2)
CreateDS = function ()
{
  t=seq(-31*pi, 31*pi, 0.002)
  a=sample(seq(from=1/31, to=29/31, by=2/31), 1)
  b=runif(1, min = 1, max = 3)
  data.frame(x=(1-a)*cos(a*t)+a*b*cos((1-a)*t), y=(1-a)*sin(a*t)-a*b*sin((1-a)*t))
}
shinyServer(function(input, output) {
  dat<-reactive({if (input$rerun) dat=CreateDS() else dat=CreateDS()})
    output$HarmPlot<-renderPlot({
    ggplot(dat())+
      geom_point(data=data.frame(x=0,y=0), aes(x,y), color=rgb(rbeta(1, .5, .5), rbeta(1, .5, .5), rbeta(1, .5, .5)) , shape=19, fill="yellow", size=220)+
      geom_polygon(aes(x, y), fill=rgb(rbeta(1, 2, 2), rbeta(1, 2, 2), rbeta(1, 2, 2))) +
      theme(legend.position="none",
            panel.background = element_rect(fill="white"),
            panel.grid=element_blank(),
            axis.ticks=element_blank(),
            axis.title=element_blank(),
            axis.text=element_blank())
  }, height = 500, width = 500)
})

Phyllotaxis By Shiny

Antonio, you don’t know what empathy is! (Cecilia, my beautiful wife)

Spirals are nice. In the wake of my previous post I have done a Shiny app to explore patterns generated by changing angle, shape and number of points of Fermat’s spiral equation. You can obtain an almost infinite number of images. This is just an example:
phyllotaxis12

I like thinking in imaginary flowers. This is why I called this experiment Phyllotaxis.
More examples:


Just one comment about code: I did the Shiny in just one R file as this guy suggested me some time ago because of this post.

This is the code. Do your own imaginary flowers:

library(shiny)
library(ggplot2)
CreatePlot = function (ang=pi*(3-sqrt(5)), nob=150, siz=15, alp=0.8, sha=16, col="black", bac="white") {
ggplot(data.frame(r=sqrt(1:nob), t=(1:nob)*ang*pi/180), aes(x=r*cos(t), y=r*sin(t)))+
geom_point(colour=col, alpha=alp, size=siz, shape=sha)+
scale_x_continuous(expand=c(0,0), limits=c(-sqrt(nob)*1.4, sqrt(nob)*1.4))+
scale_y_continuous(expand=c(0,0), limits=c(-sqrt(nob)*1.4, sqrt(nob)*1.4))+
theme(legend.position="none",
panel.background = element_rect(fill=bac),
panel.grid=element_blank(),
axis.ticks=element_blank(),
axis.title=element_blank(),
axis.text=element_blank())}
shinyApp(
ui = fluidPage(
titlePanel("Phyllotaxis by Shiny"),
fluidRow(
column(3,
wellPanel(
selectInput("col", label = "Colour of points:", choices = colors(), selected = "black"),
selectInput("bac", label = "Background colour:", choices = colors(), selected = "white"),
selectInput("sha", label = "Shape of points:",
choices = list("Empty squares" = 0, "Empty circles" = 1, "Empty triangles"=2,
"Crosses" = 3, "Blades"=4, "Empty diamonds"=5,
"Inverted empty triangles"=6, "Bladed squares"=7,
"Asterisks"=8, "Crosed diamonds"=9, "Crossed circles"=10,
"Stars"=11, "Cubes"=12, "Bladed circles"=13,
"Filled squares" = 15, "Filled circles" = 16, "Filled triangles"=17,
"Filled diamonds"=18), selected = 16),
sliderInput("ang", label = "Angle (degrees):", min = 0, max = 360, value = 180*(3-sqrt(5)), step = .05),
sliderInput("nob", label = "Number of points:", min = 1, max = 1500, value = 60, step = 1),
sliderInput("siz", label = "Size of points:", min = 1, max = 60, value = 10, step = 1),
sliderInput("alp", label = "Transparency:", min = 0, max = 1, value = .5, step = .01)
)
),
mainPanel(
plotOutput("Phyllotaxis")
)
)
),
server = function(input, output) {
output$Phyllotaxis=renderPlot({
CreatePlot(ang=input$ang, nob=input$nob, siz=input$siz, alp=input$alp, sha=as.numeric(input$sha), col=input$col, bac=input$bac)
}, height = 650, width = 650 )}
)

The 2D-Harmonograph In Shiny

If you wish to make an apple pie from scratch, you must first invent the universe (Carl Sagan)

I like Shiny and I can’t stop converting into apps some of my previous experiments: today is the turn of the harmonograph. This is a simple application since you only can press a button to generate a random harmonograph-simulated curve. I love how easy is to create a nice interactive app to play with from an existing code. The only trick in this case in to add a rerun button in the UI side and transfer the interaction to the server side using a simple if. Very easy. This is a screenshot of the application:

Shiny_2DHarmonograph

Press the button and you will get a new drawing. Most of them are nice scrawls and from time to time you will obtain beautiful shapely curves.

And no more candy words: It is time to complain. I say to RStudio with all due respect, you are very cruel. You let me to deploy my previous app to your server but you suspended it almost immediately for fifteen days due to “exceeded usage hours”. My only option is paying at least $440 per year to upgrade my current plan. I tried the ambrosia for an extremely short time. RStudio: Why don’t you launch a cheaper account? Why don’t you launch a free account with just one perpetual alive app at a time? Why don’t you increase the usage hours threshold? I can help you to calculate the return on investment of these scenarios.

Or, Why don’t you make me a gift for my next birthday? I promise to upload a new app per month to promote your stunning tool. Think about it and please let me know your conclusions.

Meanwhile I will run the app privately. This is the code to do it:

UI.R

# This is the user-interface definition of a Shiny web application.
# You can find out more about building applications with Shiny here:
# 
# http://www.rstudio.com/shiny/
 
library(shiny)
 
shinyUI(fluidPage(
  titlePanel("Mathematical Beauties: The Harmonograph"),
  sidebarLayout(
    sidebarPanel(
      #helpText(),
 
      # adding the new div tag to the sidebar            
      tags$div(class="header", checked=NA,
               tags$p("A harmonograph is a mechanical apparatus that employs pendulums to create a 
                       geometric image. The drawings created typically are Lissajous curves, or 
                       related drawings of greater complexity. The devices, which began to appear 
                       in the mid-19th century and peaked in popularity in the 1890s, cannot be 
                       conclusively attributed to a single person, although Hugh Blackburn, a professor 
                       of mathematics at the University of Glasgow, is commonly believed to be the official 
                       inventor. A simple, so-called \"lateral\" harmonograph uses two pendulums to control the movement 
                       of a pen relative to a drawing surface. One pendulum moves the pen back and forth along 
                       one axis and the other pendulum moves the drawing surface back and forth along a 
                       perpendicular axis. By varying the frequency and phase of the pendulums relative to 
                       one another, different patterns are created. Even a simple harmonograph as described 
                       can create ellipses, spirals, figure eights and other Lissajous figures (Source: Wikipedia)")),
               tags$div(class="header", checked=NA,
                       HTML("

Click <a href=\"http://paulbourke.net/geometry/harmonograph/harmonograph3.html\">here</a> to see an image of a real harmonograph

")
               ),
        actionButton('rerun','Launch the harmonograph!')
    ),
    mainPanel(
      plotOutput("HarmPlot")
    )
  )
))

server.R

# This is the server logic for a Shiny web application.
# You can find out more about building applications with Shiny here:
# 
# http://www.rstudio.com/shiny/
# 
 
library(shiny)
 
CreateDS = function () 
  {
   
  f=jitter(sample(c(2,3),4, replace = TRUE))
  d=runif(4,0,1e-02)
  p=runif(4,0,pi)
  xt = function(t) exp(-d[1]*t)*sin(t*f[1]+p[1])+exp(-d[2]*t)*sin(t*f[2]+p[2])
  yt = function(t) exp(-d[3]*t)*sin(t*f[3]+p[3])+exp(-d[4]*t)*sin(t*f[4]+p[4])
  t=seq(1, 200, by=.0005)
  data.frame(t=t, x=xt(t), y=yt(t))}
 
shinyServer(function(input, output) {
    dat<-reactive({if (input$rerun) dat=CreateDS() else dat=CreateDS()})
 output$HarmPlot<-renderPlot({
   plot(rnorm(1000),xlim =c(-2,2), ylim =c(-2,2), type="n")
   with(dat(), plot(x,y, type="l", xlim =c(-2,2), ylim =c(-2,2), xlab = "", ylab = "", xaxt='n', yaxt='n', col="gray10", bty="n"))
  }, height = 650, width = 650)
})

Shiny Wool Skeins

Chaos is not a pit: chaos is a ladder (Littlefinger in Game of Thrones)

Some time ago I wrote this post to show how my colleague Vu Anh translated into Shiny one of my experiments, opening my eyes to an amazing new world. I am very proud to present you the first Shiny experiment entirely written by me.

In this case I took inspiration from another previous experiment to draw some kind of wool skeins. The shiny app creates a plot consisting of chords inside a circle. There are to kind of chords:

  • Those which form a track because they are a set of glued chords; number of tracks and number of chords per track can be selected using Number of track chords and Number of scrawls per track sliders of the app respectively.
  • Those forming the background, randomly allocated inside the circle. Number of background chords can be chosen as well in the app

There is also the possibility to change colors of chords. This are the main steps I followed to build this Shiny app:

  1. Write a simple R program
  2. Decide which variables to parametrize
  3. Open a new Shiny project in RStudio
  4. Analize the sample UI.R and server.R files generated by default
  5. Adapt sample code to my particular code (some iterations are needed here)
  6. Deploy my app in the Shiny Apps free server

Number 1 is the most difficult step, but it does not depends on Shiny: rest of them are easier, specially if you have help as I had from my colleague Jorge. I encourage you to try. This is an snapshot of the app:

Skeins2

You can play with the app here.

Some things I thought while developing this experiment:

  • Shiny gives you a lot with a minimal effort
  • Shiny can be a very interesting tool to teach maths and programming to kids
  • I have to translate to Shiny some other experiment
  • I will try to use it for my job

Try Shiny: is very entertaining. A typical Shiny project consists on two files, one to define the user interface (UI.R) and the other to define the back end side (server.R).

This is the code of UI.R:

# This is the user-interface definition of a Shiny web application.
# You can find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com
#
 
library(shiny)
 
shinyUI(fluidPage(
 
  # Application title
  titlePanel("Shiny Wool Skeins"),
  HTML("

This experiment is based on <a href=\"https://aschinchon.wordpress.com/2015/05/13/bertrand-or-the-importance-of-defining-problems-properly/\">this previous one</a> I did some time ago. It is my second approach to the wonderful world of Shiny.

"),
  # Sidebar with a slider input for number of bins
  sidebarLayout(
    sidebarPanel(
      inputPanel(
        sliderInput("lin", label = "Number of track chords:",
                    min = 1, max = 20, value = 5, step = 1),
        sliderInput("rep", label = "Number of scrawls per track:",
                    min = 1, max = 50, value = 10, step = 1),
        sliderInput("nbc", label = "Number of background chords:",
                    min = 0, max = 2000, value = 500, step = 2),
        selectInput("col1", label = "Track colour:",
                    choices = colors(), selected = "darkmagenta"),
        selectInput("col2", label = "Background chords colour:",
                    choices = colors(), selected = "gold")
      )
       
    ),
 
    # Show a plot of the generated distribution
    mainPanel(
      plotOutput("chordplot")
    )
  )
))

And this is the code of server.R:

# This is the server logic for a Shiny web application.
# You can find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com
#
library(ggplot2)
library(magrittr)
library(grDevices)
library(shiny)
 
shinyServer(function(input, output) {
 
  df<-reactive({ ini=runif(n=input$lin, min=0,max=2*pi) 

  data.frame(ini=runif(n=input$lin, min=0,max=2*pi), 
             end=runif(n=input$lin, min=pi/2,max=3*pi/2))  -> Sub1

    Sub1=Sub1[rep(seq_len(nrow(Sub1)), input$rep),]
    Sub1 %>% apply(c(1, 2), jitter) %>% as.data.frame() -> Sub1
    Sub1=with(Sub1, data.frame(col=input$col1, x1=cos(ini), y1=sin(ini), x2=cos(end), y2=sin(end)))
    Sub2=runif(input$nbc, min = 0, max = 2*pi)
    Sub2=data.frame(x=cos(Sub2), y=sin(Sub2))
    Sub2=cbind(input$col2, Sub2[(1:(input$nbc/2)),], Sub2[(((input$nbc/2)+1):input$nbc),])
    colnames(Sub2)=c("col", "x1", "y1", "x2", "y2")
    rbind(Sub1, Sub2)
  })
   
  opts=theme(legend.position="none",
             panel.background = element_rect(fill="white"),
             panel.grid = element_blank(),
             axis.ticks=element_blank(),
             axis.title=element_blank(),
             axis.text =element_blank())
   
  output$chordplot<-renderPlot({
    p=ggplot(df())+geom_segment(aes(x=x1, y=y1, xend=x2, yend=y2), colour=df()$col, alpha=runif(nrow(df()), min=.1, max=.3), lwd=1)+opts;print(p)
  }, height = 600, width = 600 )
})