## ragged data
## Many of these functions use order() to get time ordering correct
## without sorting the entire data frame (and without reordering the
## original copy).

##(a). 
with(ragged, table(table(id)))

##(b)
episode<-function(idvar, timevar, data){
  episode<-integer(nrow(data))
  split(episode, data[[idvar]]) <- lapply(split(data[[timevar]], data[[idvar]]), rank)
  episode
}
     
##(c)
carryforward<-function(idvar, timevar, xvar, data){
  index <- order(data[[timevar]], data[[idvar]])
  listxnow <- split(data[[xvar]][index], data[[idvar]][index])
  listxlag <- lapply(listxnow, function(xi) c(NA,xi[-length(xi)]))
  xlag <- data[[xvar]][index]
  split(xlag, data[[idvar]][index]) <- listxlag
  xlag
}

##(d)
## It would be easy to give this an extra argument asking for a list
## of ids where xvar is not constant

reallyconstant<-function(idvar, xvar, data){
  index<-order(data[[idvar]])
  n<-nrow(data)
  
  idchange<-data[[idvar]][index][-1]!=data[[idvar]][index][-n]
  xchange<-data[[xvar]][index][-1]!=data[[xvar]][index][-n]

  all(xchange %in% idchange)
}

lastobs<-function(time, timevar, idvar,data){
  index <- order(data[[idvar]], data[[timevar]])
  before <- which(time > data[[timevar]][index])
  lastbefore<-by(before, data[[idvar]][index][before], max)
  obs<-data[[timevar]][index][lastbefore]
  id<-data[[idvar]][obs]
  list(id=id,obs=obs)
}

nextobs<-function(time, timevar, idvar,data){
  index <- order(data[[idvar]], data[[timevar]])
  after <- which(time < data[[timevar]][index])
  nextafter<-by(after, data[[idvar]][index][after], min)
  obs<-data[[timevar]][index][nextafter]
  id<-data[[idvar]][obs]
  id<-data[[idvar]][obs]
  list(id=id,obs=obs)
}

###### folding problem

##recursive algorithm: elegant, but runs out of stack space
accumulate<-function(x, op){
  op<-match.fun(op)
  if (length(x)==1)
    return(x)
  else
   return(c(x[1], op(x[1], accumulate(x[-1],op))))
}

## iterative version
accumulate<-function(x, op){
  op<-match.fun(op)
  n<-length(x)
  if (length(x)==0) return(NULL)
  rval<-x
  if (n>1){
    for(i in 2:n)
      rval[i]<-op(rval[i-1], x[i])
  }
  return(rval)
}

## elegant recursive version
reduce<-function(x,op){
  op<-match.fun(op)
  n<-length(x)
  if (n<2) stop("need n>1")

  if(n==2)
    op(x[1],x[2])
  else
    op(x[1], reduce(x[-1],op))
  
}

## iterative version.
## The 'identity' argument is used to make sure the result is of the
## correct type when n=0 or n=1. It should be a value such that
## op(x, op(y,identity)) == op(x, y)
## You could just assume that the type of the result is the same as
## the type of x

reduce<-function(x, op, identity){
  op<-match.fun(op)
  n<-length(x)
  if(n==0) return(identity)
  rval<-identity
  for(i in 1:n)
    rval<-op(rval,x[i])

  return(rval)
}