Create Your Own Siri, Cortana or Alexa: Part 1

[This article was first published on Dan Thompson, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

Summary

In this blog post I will show you how to make your own personal assistant (think Siri, Cortana, Alexa) in R, very quickly.

This will be done in three steps:

  1. Get R to recognise your voice and convert it to text
  2. Set up a system which uses text from (1) as a query to Google or pre-defined functions
  3. Return the action or answer to the app

Standing on the Shoulders of Giants

I must mention this leverages the awesome work done by Yihue Xie using his app which allows you to edit a graph by talking to it.

Step 1: Voice Input

I took the base of Yihue’s app, and stripped it back to harness the voice input functionality. Note this is based on annyang!, a JavaScript library which processes voice input.

The app will need a key phrase to recognise so it knows what text to process – I will call mine Albert.

I decided to have two functions in my app:

  • Have custom calls which allow user-defined functions such as answering a personal question, sending an email, going to a website, running some simulations, etc.
  • Get Google to tell you answers to your questions

For this example, for my custom calls, I have one personal question, and one action. I have used if statements but in reality questions, answers and actions should be written to a data frame.

My custom calls are as follows:

        if(question=="when is my next appointment")
        {
          answer<-"Tomorrow at 3pm, in London Bridge."
        } else if(question=="show me something cool")
        {
          shell.exec("http://www.r-bloggers.com")
          answer<-""
        }

As you can see, if I ask it for my next appointment, it tells me where and when it is. If I ask for a suggestion of something cool, it opens a browser and takes me to R-Bloggers.

If the question asked isn’t in the list of custom calls, it simply asks Google and hopes what is returned is sensible:

        ....
        ....
        } else 
        {
          # It's not in our list, let's see if Google knows the answer
          search.term<-question
          quotes <- "FALSE"
          google.url <- getGoogleURL(search.term=search.term, quotes=quotes)
          #
          links <- getGoogleLinks(google.url)
          #
          if(length(links)>0)
          {
            for(i in 1:length(links))
            {
              if(i==1)
              {
                answer<-xmlValue(links[[1]])
              } 
              else
              {
                answer<-c(answer,xmlValue(links[[i]]))
              }
            }
          }
        }

Googolplexed?

Don’t be perplexed by getting information from Google!

The above custom functions attempt to get the initial results from Google - a very crude version of Summly, if you will. The functions are defined as follows.

getGoogleURL <- function(search.term, domain = '.co.uk', quotes=TRUE) 
{
  search.term <- gsub(' ', '%20', search.term)
  if(quotes) search.term <- paste('%22', search.term, '%22', sep='') 
  getGoogleURL <- paste('http://www.google', domain, '/search?q=',
                        search.term, sep='')
}

getGoogleLinks <- function(google.url) {
  doc <- getURL(google.url, httpheader = c("User-Agent" = "R
                                           (2.10.0)"))
  html <- htmlTreeParse(doc, useInternalNodes = TRUE, error=function
                        (...){})
  nodes <- getNodeSet(html, "//div[@class='_o0d']")
  return(nodes)
}

As mentioned, they are very crude, so please improve on them if you can! They simply use the RCurl and XML packages to help you get answers.

We're There!

Now, we can ask it a question and get an answer. Cool!

Here’s how you do it:

  1. Make sure you have shiny, RCurl and XML packages installed.
  2. Save the app.R and init.js files into a single folder.
  3. Open app.R, and run the app
  4. The browser will open, and use the keyword "Albert" before asking a question. Try these:
    1. "Albert, where is the Eiffel Tower?"
    2. "Albert, when is my next appointment?"
    3. "Albert, show me something cool!"

What's Next?

This version listens to your questions and presents answers in text on screen. The obvious next step is to be spoken back to - watch this space for part 2 of this blog.

Full code below (save both files in the same folder):

app.R

library(shiny)
library(RCurl)
library(XML)

getGoogleURL <- function(search.term, domain = '.co.uk', quotes=TRUE) 
{
  search.term <- gsub(' ', '%20', search.term)
  if(quotes) search.term <- paste('%22', search.term, '%22', sep='') 
  getGoogleURL <- paste('http://www.google', domain, '/search?q=',
                        search.term, sep='')
}

getGoogleLinks <- function(google.url) {
  doc <- getURL(google.url, httpheader = c("User-Agent" = "R
                                           (2.10.0)"))
  html <- htmlTreeParse(doc, useInternalNodes = TRUE, error=function
                        (...){})
  nodes <- getNodeSet(html, "//div[@class='_o0d']")
  return(nodes)
}

shinyApp(
  options(browser = "C:/Program Files (x86)/Google/Chrome/Application/chrome.exe"),
  ui = fluidPage(
    singleton(tags$head(
      tags$script(src="//cdnjs.cloudflare.com/ajax/libs/annyang/1.4.0/annyang.min.js"),
      includeScript('init.js')
    )),
    fluidRow(
      column(4),
      column(6,
      h1("Awesome R Robot")
             )
    ),
    fluidRow(
      column(3),
      column(2,
             h3("My Question"),
             wellPanel(
               textOutput("question")
             )
             ),
      column(4,
             h3("Answer"),
             textOutput("answer")
             ),
      column(3)
    )
  ),
  
  
  server = function(input, output) {
    output$answer<-renderText({""})
    output$question<-renderText({""})
    observe({
      print("START ASK QUESTION")
      question<-input$albert
      print(question)
      answer<-""
      if(length(question)>0)
      {
        if(question=="when is my next appointment")
        {
          answer<-"Tomorrow at 3pm, in London Bridge."
        } else if(question=="show me something cool")
        {
          shell.exec("http://www.r-bloggers.com")
          answer<-""
        } else 
        {
          # It's not in our list, let's see if Google knows the answer
          search.term<-question
          quotes <- "FALSE"
          google.url <- getGoogleURL(search.term=search.term, quotes=quotes)
          #
          links <- getGoogleLinks(google.url)
          #
          if(length(links)>0)
          {
            for(i in 1:length(links))
            {
              if(i==1)
              {
                answer<-xmlValue(links[[1]])
              } 
              else
              {
                answer<-c(answer,xmlValue(links[[i]]))
              }
            }
          }

        }
      }
      output$question<-renderText({
        paste0(question,"?")
      })
      output$answer<-renderText({answer})
    })
  }
)

init.js

var initVoice = function() {
  if (annyang) {
    Shiny.onInputChange('albert', '');
    var commands = {
      'albert *albert': function(albert) {
        Shiny.onInputChange('albert', albert);
      }
    };
    annyang.addCommands(commands);
    annyang.start();
  }
};

$(function() {
  setTimeout(initVoice, 3);
});

To leave a comment for the author, please follow the link and comment on their blog: Dan Thompson.

R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

Never miss an update!
Subscribe to R-bloggers to receive
e-mails with the latest R posts.
(You will not see this message again.)

Click here to close (This popup will not appear again)