Site icon R-bloggers

Sync

[This article was first published on Wiekvoet, 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.
I am listening to the audiobook Sync: How Order Emerges from Chaos in the Universe, Nature, and Daily Lifeby Steven Strogatz which I got from Audible. Obviously a mathematical book is not ideal to listen to, but lacking illustrations I can make them myself. On top of that, you learn more from programming than listening.

He mentioned a simple system which synchronizes itself. As far as I understand a large number of items are considered. Each  item has more or less the same properties. Small steps are taken. Every step has a small additive effect, a multiplicative decrease. When an item gets over a limit, then it resets to zero and causes a small increase in the other items.

What is supposed to happen is that at low values you get steep slopes and at high values small slopes. As time progresses the small increases due to resets cause a synchronization.

To program this was not difficult, except for the initialization. If you start the items at random levels you have too many at low levels. In the end I decided to add an item at each time point for an init period. What did surprise me, was that calculating what happens actually takes less computer time than plotting it. But maybe that is because I wanted to use ggplot and a low alpha to show the bunching of items. I also discovered it is also not wise to display too complex a figure in ggplot running in Eclipse. It can freeze the whole program. I took to saving all plots rather than displaying within Eclipse.

In the init phase every item has different start and ending times. Note the black line at level 0 which consists of not yet running items
After 10000 steps it is still chaos, with a few somewhat fatter lines.
But at 50000 steps it is clear that the things are synchronizing.
Not that they are perfect after 300000 steps, but it gets more and more closer.
It is really happening. So simple and it works. Having said that, it took some tweaking to get parameters which take a while to result in sync, yet do not degenerate either. I guess it gets more easy to sync when more items are syncing, but that rapidly gets to the end of my hardware. I must say that I look forward to listening to the rest of the book. Hope to make more plots and get a bit of the math which is supposed to be behind all this.

R code



library(ggplot2)

plotpart <- function(xmat,fname=’een.png’,xstart=1) {
  fin <- ncol(xmat)
  nitems <- nrow(xmat)
  df <- data.frame(score=as.numeric(xmat),
      time=rep((1:fin)+xstart,each=nitems),
      item =rep(1:nitems,fin))
  g<- ggplot(df,aes(x=time,y=score,group=item,alpha=score)) + 
      geom_line() + 
      scale_alpha_continuous(range=c(.05,.0501) )+
      theme(legend.position=’none’)
  png(fname)
  print(g)
  dev.off()
}

nextgen <- function(x,add,shrink=.99,limit=1,spil=.0105) {
  x <- x*shrink+add
  maxed <- x>limit
  x[maxed]<- .01#add[maxed]
  x[!maxed] <- x[!maxed] + sum(maxed)*spil
  x[x>limit] <- limit
  x
}

ngenmat <- function(xstart,niter,add,spil) {
  nitems <- length(xstart)
  xmat <- matrix(0,nrow=nitems,ncol=niter)
  xmat[,1 ] <- xstart
  for ( i in 2:niter) {
    xmat[,i] <- nextgen(xmat[,i-1],add=add,spil=spil)
  }
  xmat
}

ngenmove <- function(xstart,niter,add,spil) {
  for ( i in 1:niter) {
    xstart <- nextgen(xstart,add=add,spil=spil)
  }
  xstart
}

# init a run
nitems <- 1000
niter <- 1000
xmat <- matrix(0,nrow=nitems,ncol=niter)
for (i in 1:nitems) xmat[i,i] <- runif(1,min=.01,max=.02)
add <- rnorm(nitems,.0103,.00005)
spil=.000025
for ( i in 2:niter) {
  todo <- xmat[,i-1]>0
  xmat[todo,i] <- nextgen(xmat[todo,i-1],add=add[todo],spil=spil)
}
#and show it
show <- sample(1:nrow(xmat),50)
plotpart(xmat[show,],fname=’een.png’,xstart=1)

# move 9000 steps
x1 <- ngenmove(xmat[,ncol(xmat)],niter=9000,add=add,spil=spil)
xm1 <- ngenmat(x1,niter=1000,add=add,spil=spil)
plotpart(xm1[show,],fname=’twee.png’,xstart=10000)

x2 <- ngenmove(xm1[,ncol(xm1)],niter=39000,add=add,spil=spil)
xm2 <- ngenmat(x2,niter=1000,add=add,spil=spil)
plotpart(xm2[show,],fname=’drie.png’,xstart=50000)

x3 <- ngenmove(xm2[,ncol(xm2)],niter=49000,add=add,spil=spil)
xm3 <- ngenmat(x3,niter=1000,add=add,spil=spil)
plotpart(xm3[show,],99000,fname=’vier.png’)

x4 <- ngenmove(xm3[,ncol(xm3)],niter=49000,add=add,spil=spil)
xm4 <- ngenmat(x4,niter=1000,add=add,spil=spil)
plotpart(xm4[show,],150000,fname=’vijf.png’)

x5 <- ngenmove(xm4[,ncol(xm4)],niter=49000,add=add,spil=spil)
xm5 <- ngenmat(x5,niter=1000,add=add,spil=spil)
plotpart(xm5[show,],200000,fname=’zes.png’)

x6 <- ngenmove(xm5[,ncol(xm5)],niter=99000,add=add,spil=spil)
xm6 <- ngenmat(x6,niter=1000,add=add,spil=spil)
plotpart(xm6[show,],300000,fname=’zeven.png’)


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

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.