gsl.bs <- function(...) UseMethod("gsl.bs")

gsl.bs.default <- function(x,
                           degree=3,
                           nbreak=2,
                           deriv=0,
                           x.min=NULL,
                           x.max=NULL,
                           intercept=FALSE,
                           knots=NULL,
                           ...) {

  x <- as.vector(x)
  ## Some error checking

  if (length(degree) != 1L || is.na(degree) || !is.finite(degree) ||
      degree != floor(degree))
    stop(" degree must be a positive integer")
  if (length(deriv) != 1L || is.na(deriv) || !is.finite(deriv) ||
      deriv != floor(deriv))
    stop(" deriv must be a non-negative integer")
  if (length(nbreak) != 1L || is.na(nbreak) || !is.finite(nbreak) ||
      nbreak != floor(nbreak))
    stop(" nbreak must be an integer at least 2")
  if(degree <= 0) stop(" degree must be a positive integer")
  if(deriv < 0) stop(" deriv must be a non-negative integer")
  if(deriv > degree +1 ) stop(" deriv must be smaller than degree plus 2") 
  if(nbreak <= 1) stop(" nbreak must be at least 2")

  if(!is.null(knots)) {
    if (length(knots) < 2L)
      stop(" knots must contain at least two values")
    if (anyNA(knots) || any(!is.finite(knots)))
      stop(" knots must contain finite non-missing values")
  }

#  if(!is.null(knots)) nbreak <- length(knots)
  if(!is.null(knots)&&length(knots)!=nbreak) {
    nbreak <- length(knots)
    .np_warning(paste(" nbreak and knots vector do not agree: resetting nbreak to", nbreak))
  }

  ## For evaluation (newx) must use min/max for x unless otherwise
  ## specified - check that mix < max


  if(!is.null(x.min) && !is.null(x.max)) if(x.min >= x.max) stop(" x.min must be less than x.max")
  if(is.null(x.min)) {
			x.min <- min(x)
			ol <- FALSE
	}
	else {
			ol <- x < x.min 
	}
  if(is.null(x.max)) {
			x.max <- max(x)
			or <- FALSE
	}
	else {
			or <- x > x.max 
	}

  ## We check whether the Xs are within knots. It seems that if 'knots'
  ## is given, we don't require x.min and x.max, otherwise, we check
  ## the boundary.

	if(!is.null(knots)) {
			ol <- ol | x < min(knots)
			or <- or | x > max(knots)
	}

	outside <- ol | or 

	if(any(outside)){
			.np_warning("some 'x' values beyond boundary knots may cause ill-conditioned bases")
			ord <- degree + 1
			derivs<- deriv:degree
			if(ord == deriv) 
					scalef = 1
			else
					scalef <- gamma(1L:(ord-deriv))
			B <- array(0, c(length(x), nbreak+degree-1))
			
			if(any(ol) && (ord>deriv)){ #ord <=deriv,  derivatives should be zero..#
					k.pivot <- x.min
					if(degree == deriv){
							xl <- cbind(1)
					}
					else {
							xl <- cbind(1, outer(x[ol]-k.pivot, 1L:(degree-deriv),  "^"))
					}
					tt <- bs.des(rep(k.pivot, ord-deriv), degree, nbreak, deriv=derivs, x.min, x.max, knots)  
					B[ol, ] <- xl %*% (tt/scalef)
			}
			if(any(or) && (ord>deriv)){
					k.pivot <- x.max
					if(degree == deriv){
							xr <- cbind(1)
					}
					else {
							xr <- cbind(1, outer(x[or]-k.pivot, 1L:(degree-deriv),  "^"))
					}
					tt <- bs.des(rep(k.pivot, ord-deriv), degree, nbreak,deriv= derivs, x.min, x.max, knots)
					B[or, ] <- xr %*% (tt/scalef)
			}
			inside <- !outside
			if(any(inside))
					B[inside, ] <- bs.des(x[inside], degree, nbreak, rep(deriv, length(x[inside])), x.min, x.max, knots)
	}
	else {
			B <- bs.des(x, degree, nbreak, rep(deriv, length(x)), x.min, x.max,knots)
	}


	if(!intercept) B <- B[,-1,drop=FALSE]

	attr(B, "degree") <- degree
	attr(B, "nbreak") <- nbreak
	attr(B, "deriv") <- deriv
	attr(B, "x.min") <- x.min
	attr(B, "x.max") <- x.max
	attr(B, "intercept") <- intercept
	attr(B, "knots") <- knots
	# Keep "gsl.bs" as a compatibility superclass while crs remains the
	# public owner of predict.gsl.bs.
	attr(B, "class") <- c("np_gsl.bs","gsl.bs","matrix")

	return(B)

}

bs.des     <- function(x,
											 degree=3,
											 nbreak=2,
											 deriv=integer(length(x)),   ## now deriv is a vector to represent the derivivative for each element of x 
											 x.min=NULL,
											 x.max=NULL,
											 knots=NULL,
											 ...) {

		x <- as.vector(x)
		n <- length(x)
		deriv <- as.vector(deriv)
    if (length(deriv) != n)
      stop(" deriv must have length equal to x")
    if (anyNA(deriv) || any(!is.finite(deriv)) || any(deriv != floor(deriv)))
      stop(" deriv must contain finite non-missing integers")
    if (any(deriv < 0))
      stop(" deriv must be non-negative")
    if (any(deriv > degree + 1))
      stop(" deriv must be smaller than degree plus 2")
    if(!is.null(knots)) {
      if (length(knots) != nbreak)
        stop(" knots length must match nbreak")
      if (anyNA(knots) || any(!is.finite(knots)))
        stop(" knots must contain finite non-missing values")
    }

		if(!is.null(x.min) && !is.null(x.max)) if(x.min >= x.max) stop(" x.min must be less than x.max")
		if(is.null(x.min)) x.min <- min(x)
		if(is.null(x.max)) x.max <- max(x)

		## 0 == don't use user supplied knots, 1 = use

		knots.int <- if (is.null(knots)) 0 else 1

		ncol <- nbreak+degree-1;

		if(all(deriv==0)) {

				B <- .Call("C_gsl_bspline",
									 as.double(x),
									 as.integer(degree),
									 as.integer(nbreak),
									 as.double(x.min),
									 as.double(x.max),
									 as.double(knots),
									 as.integer(knots.int),
									 PACKAGE="np" )

		} else {

				B <- .Call("C_gsl_bspline_deriv",
									 as.double(x),
									 as.integer(degree),
									 as.integer(nbreak),
									 as.integer(deriv),
									 as.double(x.min),
									 as.double(x.max),
									 as.double(knots),
									 as.integer(knots.int),
									 PACKAGE="np" )

		}

		return(B)

}

.np_predict_gsl_bs_impl <- function(object,
											 newx=NULL,
											 ...) {

		newx.ind <- NULL

		if(is.null(newx))

				## If No new data provided, return sample fit.
				B <- object

		else{

				x.min <- attr(object, "x.min")
				x.max <- attr(object, "x.max")

				newx <- as.numeric(newx)

#				if(min(newx)<x.min || max(newx)>x.max) {
#						.np_warning(" evaluation data lies beyond spline support: resetting those values to min/max")
#						newx[newx < x.min] <- x.min
#						newx[newx > x.max] <- x.max
#						newx.ind <- sort(c(which(newx < x.min),which(newx > x.max)))
#				}

				B <- gsl.bs(newx,
										degree=attr(object, "degree"),
										nbreak=attr(object, "nbreak"),
										deriv=attr(object, "deriv"),
										intercept=attr(object, "intercept"),
										knots=attr(object, "knots"),
										x.min=x.min,
										x.max=x.max)

		}

		attr(B, "newx") <- newx
		attr(B, "newx.trimmed") <- newx.ind

		return(B)

}

predict.np_gsl.bs <- function(object,
														 newx=NULL,
														 ...) {
		.np_predict_gsl_bs_impl(object = object, newx = newx, ...)
}

predict.gsl.bs <- function(object,
													 newx=NULL,
													 ...) {
		.np_predict_gsl_bs_impl(object = object, newx = newx, ...)
}
