Laplacian Experiments/Nonlinear Laplacian ODEs

From Worden
Jump to: navigation, search

If instead of writing dedt=L(e(0))e(t) to "diffuse" graph edges to near neighbors, we write a more consistent differential equation, dedt=L(e(t))e(t), we can no longer solve the equation in closed form, at least not easily.

Well, so what, let's evaluate it numerically!

V.nonlinear.ode-experiment.Rstep
prereq: nonlinear.laplacian.diffusion.R $(MF)/graph.plotting.functions.RData $(MF)/V.graph.RData
library(network)
library(deSolve)
ptrag.prefix <<- 'V.nonlinear.ode-experiment'
ptrag.index <<- 0
ptrag.coord <<- NULL
result <- make.sequence.ode(V.graph(),laplacian.ode.function, 
  seq(0,4,by=0.02),plot.timeseries.row.as.graph)

[log]V.nonlinear.ode-experiment.animate.gif

Ha! This one ends up with different colored arrowheads at different vertices too!

Here's another diff eq that I'm curious about, though I don't think it's literally a Laplacian.

V.nonlaplacian.ode-experiment.Rstep
prereq: nonlaplacian.diffusion.R nonlinear.laplacian.diffusion.Rstep $(MF)/graph.plotting.functions.RData $(MF)/V.graph.RData
library(network)
library(deSolve)
ptrag.prefix <<- 'V.nonlaplacian.ode-experiment'
ptrag.index <<- 0
ptrag.coord <<- NULL
result <- make.sequence.ode(V.graph(), nonlaplacian.ode.function, 
  seq(0,4,by=0.02),plot.timeseries.row.as.graph)
plot(result, type='l')

[log]V.nonlaplacian.ode-experiment.animate.gif

Much to my shock and frustration, this one doesn't go to a complete graph either! I did some back-of-envelope writing and verified that this is plausible: it has multiple equilibria and apparently doesn't go to the one I was thinking of. So confusing...

Note from the future: don't despair! Try the two-sided matrix Laplacianoid!

Code

nonlinear.laplacian.diffusion.Rstep
prereq: $(MF)/laplacian.functions.RData
laplacian.ode.function <- function(n)
{ function(t, state, params) {
    with (as.list(c(state,params)), {
      e <- matrix(state,n,n)
      L <- standard.laplacian(e)
      dedt <- (- L) %*% e
      return(list(as.vector(dedt)))
    })
  }
}
 
# hackish function to make each frame of animation for make.sequence.ode
ptrag.coord=NULL
ptrag.index=0
ptrag.prefix=NULL
ptrag.n=0
plot.timeseries.row.as.graph <- function(row, directed=TRUE) {
  t <- row[1]
  e.t <- matrix(row[2:length(row)],ptrag.n,ptrag.n)
  net <- network(e.t,directed=directed,loops=TRUE)
  set.edge.value(net,'weight',e.t)
  ptrag.coord <<- plot.network.png(net,
    paste(ptrag.prefix,'frame',format(ptrag.index,width=3),'png',sep='.'),
    edgecol=matrix(sapply(e.t,make.edge.color),nrow(e.t),ncol(e.t)),
    edgewid=matrix(sapply(e.t,make.edge.width),nrow(e.t),ncol(e.t)),
    coord=ptrag.coord)
  ptrag.index <<- ptrag.index + 1
}
 
plot.timeseries.row.as.graph.undirected <- function(row) {
  return(plot.timeseries.row.as.graph(row,FALSE))
}
 
make.sequence.ode <- function(net,ode.generator,times,plot.row.function)
{ n <- network.size(net)
  # names : matrix of strings e.g. "e.1.2"
  e.names <- outer(1:n,1:n,function(x,y){paste('e.',x,'.',y,sep='')})
  # init.cond : matrix of eqns e.g. "e.1.2 = 1"
  #init.cond <- mapply(function(x,y){list(x,y)},e.names,as.matrix(net))
  init.cond <- as.vector(as.matrix(net))
  names(init.cond) <- as.vector(e.names)
  params <- c(n=n)
  func <- ode.generator(n)
  result <- ode(y=init.cond,times=times,func=func,parms=params)
  ptrag.n <<- n
  apply(result,1,plot.row.function)
  return(result)
}

nonlaplacian.diffusion.Rstep
nonlaplacian.ode.function <- function(n)
{ function(t, state, params) {
    with (as.list(c(state,params)), {
      e <- matrix(state,n,n)
      e2 <- e %*% e
      dedt <- sum(e) * e2 - sum(e2) * e
      return(list(as.vector(dedt)))
    })
  }
}

Personal tools
Namespaces

Variants
Actions
Navigation
Projects
Toolbox