## Implementing the beta growth function from (Yin et al 2003)

## bgf <- function(t, w.max, t.e, t.m){

##   stopifnot(t.m < t.e)
  
##   tmp1 <- t.e / (t.e - t.m)
##   tmp2 <- (t/t.e)^tmp1
##   tmp3 <- (1 + (t.e - t)/(t.e - t.m))
##   ans <- w.max * tmp3 * tmp2
##   ans

## }

bgfInit <- function(mCall, LHS, data){

  xy <- sortedXyData(mCall[["time"]], LHS, data)
  if(nrow(xy) < 4){
    stop("Too few distinct input values to fit a bgf")
  }
  w.max <- max(xy[,"y"])
  t.e <- NLSstClosestX(xy, w.max)
  t.m <- NLSstClosestX(xy, w.max/2)
  value <- c(w.max, t.e, t.m)
  names(value) <- mCall[c("w.max","t.e","t.m")]
  value

}


bgf <- function(time, w.max, t.e, t.m){

  .expr1 <- t.e / (t.e - t.m)
  .expr2 <- (time/t.e)^.expr1
  .expr3 <- (1 + (t.e - time)/(t.e - t.m))
  .value <- w.max * .expr3 * .expr2

  ## Derivative with respect to t.e
  .exp1 <- .value
  .exp2 <- (1/(t.e-t.m)-t.e/(t.e-t.m)^2) * log(time/t.e) - 1/(t.e-t.m)
  .exp3 <- w.max * (1/(t.e-t.m) -
                    (t.e-time)/(t.e-t.m)^2)*(time/t.e)^(t.e/(t.e-t.m))
  .exp4 <- .exp1 * .exp2 * .exp3

  ## Derivative with respect to t.m
  .ex1 <- (t.e * .value * log(time/t.e)) / ((t.e-t.m)^2)
  .ex2 <- (w.max * (t.e - time) * (time/t.e)^(t.e/(t.e-t.m))) / ((t.e-t.m)^2)
  .ex3 <- .ex1 + .ex2
  
  .actualArgs <- as.list(match.call()[c("w.max", "t.e", "t.m")])

  ## I think there is something wrong with this gradient
##   if (all(unlist(lapply(.actualArgs, is.name)))) {
##     .grad <- array(0, c(length(.value), 3L), list(NULL, c("w.max", 
##                                                           "t.e", "t.m")))
##     .grad[, "w.max"] <- .expr3 * .expr2
##     .grad[, "t.e"] <- .exp4
##     .grad[, "t.m"] <- .ex3 
##     dimnames(.grad) <- list(NULL, .actualArgs)
## #    print(.grad)
##     attr(.value, "gradient") <- .grad
##   }
    .value
}

SSbgf <- selfStart(bgf, initial = bgfInit, c("w.max", "t.e", "t.m"))