Doodling in R!

August 21, 2013

(This article was first published on Econometrics by Simulation, and kindly contributed to R-bloggers)

# I am working on creating some functions that will be capable of creating shapes and plots that look hand drawn.
# I have made some progress in this goal.

# In that process I have also discovered that I can make some doodles that look hand drawn as well.
# In order to accomplish the goal of simulating hand drawing I want to simulate the momentum of hand writing.
# In order to do that I will break the task down into a goal oriented system where each end point is a target.
doodle <- function(
targets = rbind(c(0,10),c(10,10), c(10,0), c(0,0)) ,
tdist = .25,
speed = c(0,0),
accel = .1,
resis = .005,
jitter = .0005,
chncStp = 0) {
# start - We start with the starting position
# targ - Points that will be pursued (initially just a square)
# tdist - How close we need to get to each point before moving on
# speed - Initial speed
# accel - How fast does the drawer accelerate towards that point
# resis - What percentage of speed is lost each round
# jitter - A normal draw random jitter that moves the writing tool in an unexpected direction.
# chncStp - There is some chance that the drawing tool will kill all momentum and stop.
# First off I define a function uvect to convert any two sets of points
# into a unit vector and measure the distance between the two points.
uvect <- function(p1,p2=NULL) {
if (is.null(p2)) {
p2 <- p1[[2]]
p1 <- p1[[1]]
list(vect=(p2-p1)/sqrt(sum((p1-p2)^2)), dist=sqrt(sum((p1-p2)^2)))
# Starup parameters
i <- 1
plist <- position <- start # plist saves all of the points that the drawing tool has passed through
vect <- uvect(position,targets[i,])
while(i<=nrow(targets)) {
# Calculate the appropriate unit vector and distance from end point
vect <- uvect(position,targets[i,])
# Remove some amount of speed from previous velocity
speed <- speed*(1-resis)
# IF drawer randomly stops remove all speed
if (rbinom(1,1,chncStp)) speed<-0
speed <- speed + accel*vect[[1]] + rnorm(2)*jitter
position <- position + speed
plist <- rbind(plist,position)
vect <- uvect(position,targets[i,])
if (vect[[2]]) i <- i+1
plist <- doodle()
plot(plist, type="n", lwd=3)
lcol <- rainbow(nrow(plist-1))
for (i in 1:(nrow(plist)-1)) lines(plist[c(i:(i+1)),], type="l", lwd=3, col=lcol[i])

# However this was not the primary intention of this function.
# The main intention is to be able to make plots that look hand drawn.
shape1 <- doodle(cbind(c(0,10,10,0),c(10,10,0,0)),resis=.25)
plot(shape1, type="l", lwd=1)

shape2 <- doodle(cbind(c(0,-2,5,15,10,0),c(5,9,10,5,2,0)),resis=.25)
plot(shape2, type="l", lwd=1)

# To tell you the truth.  I don't know what is going on some I am going to have to debug this function for a while.  In the mean time it is making unexpected shapes which look pretty crazy.

To leave a comment for the author, please follow the link and comment on their blog: Econometrics by Simulation. offers daily e-mail updates about R news and tutorials on topics such as: Data science, Big Data, R jobs, visualization (ggplot2, Boxplots, maps, animation), programming (RStudio, Sweave, LaTeX, SQL, Eclipse, git, hadoop, Web Scraping) statistics (regression, PCA, time series, trading) and more...

If you got this far, why not subscribe for updates from the site? Choose your flavor: e-mail, twitter, RSS, or facebook...

Comments are closed.

Search R-bloggers


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)