## =============================================================================
## A bouncing ball; ode with event location
## =============================================================================
require(deSolve)
#-----------------------------
# the model function
#-----------------------------
ballode<- function(t, y, parms) {
  dy1 <- y[2]
  dy2 <- -9.8
  list(c(dy1, dy2))
}

#-----------------------------
# the root and event function
#-----------------------------
# event triggered when the ball hits the ground (height =0)
root <- function(t, y, parms) y[1]

# bouncing
event <- function(t, y, parms) {
  y[1] <- 0
  y[2] <- -0.9 * y[2]
 return(y)
}

#-----------------------------
# initial values and times
#-----------------------------
yini  <- c(height = 0, v = 20)
times <- seq(0, 35, length.out=2001)

#-----------------------------
# solve the model
#-----------------------------
out   <- lsodar(times = times, y = yini, func = ballode, parms = NULL,
  events = list(func = event, root = TRUE), rootfun = root)

attributes(out)$troot

#------------------------------------------
# make time steps proportional to 1/speed
#------------------------------------------
rel   <- cumsum(pmin(abs(1/out[,"v"]), 1)) # 1: limit time spent at top position
f     <- approxfun(rel, times, rule=2)
t.rel <- f(seq(0, max(rel), length.out=101))

# add roots to make animation nicer (may be made even better ...)
t.rel <- sort(c(t.rel, attributes(out)$troot))


#------------------------------------------
# run again and show results
#------------------------------------------
out2  <- lsodar(times = t.rel, y = yini, func = ballode, parms = NULL,
                events = list(func = event, root = TRUE), rootfun = root)
for (i in 1:length(t.rel)) {
  #png(filename=paste("bball/image", i+1000, ".png", sep=""),
  #  type="cairo", width=300, height=100, antialias="subpixel")
  par(mar=rep(.1, 4))
  plot(out,which = "height", type="l", lwd=2, col="grey",
       axes=FALSE, main = "", xlab="", ylab = ""
       #main = "Bouncing Ball", xlab="Time", ylab = "Height"
  )
  box()
  points(t(out2[i,1:2]), pch=21, lwd=1, col=1, cex=2,
         bg=rainbow(30, v=0.6)[20-abs(out2[i,3])+1])
  Sys.sleep(.1)
  #dev.off()
}