.packageName <- "cwhstring"
capply <- function(str, ff) {
  sapply(lapply(strsplit(str, NULL), ff), paste, collapse="")
}

cap <- function(char) {
  # change lower letters to upper, others leave unchanged
  if (any(ind <- letters==char)) LETTERS[ind]
  else char
}

capitalize <- function(str) { # vector of words
  ff <- function(x) paste(lapply(unlist(strsplit(x, NULL)),cap),collapse="")
  capply(str,ff)
}
       
lower <- function(char) {
  # change upper letters to lower, others leave unchanged
  if (any(ind <- LETTERS==char)) letters[ind]
  else char
}

lowerize <- function(str) {
  ff <- function(x) paste(lapply(unlist(strsplit(x, NULL)),lower),collapse="")
  capply(str,ff)
}

"CapLeading" <- function(str) {
  ff <- function(x) {r <- x; r[1]<-cap(x[1]); r}
  capply(str,ff)
}

#cap("f")
#cap("R")
#capitalize(c("TruE","faLSe"))
#capitalize(c("faLSe","TruE"))
#lower("f")
#lower("R")
#lowerize("TruE")
#lowerize("faLSe")
    

"cpos" <- function(str,sub,start=1)
{### find the first position of string sub in string str, starting from position start
  lstr  <- nchar(str)
  lsub1 <- nchar(sub)-1
  if (start+lsub1 > lstr) return(NA)
  else {
    str <- substring(str,start,lstr)
    str <- substring(str, 1:(lstr-lsub1), (1+lsub1):lstr)
    p <- ((start:lstr)[str==sub])[1]
    if (is.na(p>0)) return(NA)
    else return(p)
  }
}

"substring.location" <- function(str, sub, restrict) {
  if(length(str)>1) stop('only works with a single string str')
  l.str   <- nchar(str)
  l.sub <- nchar(sub)
  if(l.sub > l.str) return(list(first=0,last=0))
  if(l.sub==l.str)  return(if(str==sub)list(first=1,last=l.str) else 
    list(first=0,last=0))

  is <- 1:(l.str-l.sub+1)
  ss <- substring(str, is, is+l.sub-1)
  k <- ss==sub
  if(!any(k)) return(list(first=0,last=0))
  k <- is[k]
  if(!missing(restrict)) k <- k[k>=restrict[1] & k<=restrict[2]]
  if(length(k)==0) return(list(first=0,last=0))
  list(first=k, last=k+l.sub-1)
}

spacC <- "  "  ## extra space in indexLine and charMat
"datetime" <- function( ) {
  format(Sys.time(), "%Y-%m-%d, %X")
}

"mytime" <- function( ) {format(Sys.time(), "%X")
}

"mydate" <- function( ) {format(Sys.time(), "%Y-%m-%d")
}
dc <- function(x,d,ch="&") { # d=0: "x&0"
##  frac <- function(x,d) {  # fractional part
##    res <- abs(x-trunc(x))
##    if (!missing(d)) res <- round(10^d*res)
##    res
##  }
  paste(trunc(x),ch,frac(x,d),sep="")
}

dcn <- function(x,d,ch="&") { # d=0: no "&"
  s <- sapply(x,function(x) eval(parse(text = paste("sprintf('%.", d, "f',", x, ")", sep = ""))))
  replacechar(s,".",ch)
}
"delstr" <- function(str,del) {
  ## delete the character sequence del from string str, if contained
  if ((nchar(str)<nchar(del)) | (nchar(del)==0)) str
  else if (str==del) ""
  else {
    n1 <- nchar(del)-1
    ns <- nchar(str)
    ss <- substring(str,1:ns,c((1+n1):ns,rep(ns,n1)))
    ind <- seq(1:ns)[ss == del]
    if (is.na(ind > 0)) # test if ind exists
      str
    else {
      for (i in length(ind):1) { # backwards !!
        ss <- ss[-(ind[i]:(ind[i]+n1))]
      }
      paste(substring(ss,1,1),collapse="")
    }
  }
}

dt2str <- function(dt,verbose=FALSE) {
  hr <- dt %/% 3600; rest <- dt %% 3600
  mi <- rest %/% 60; rest <- rest %%60
  se <- rest
  if (verbose) paste(hr,"hours",mi,"minutes",se,"seconds",sep=" ")
  else paste(hr,mi,se,sep=":")
}
"formatFix" <- function(x,after,before=2,extend=TRUE) {  # 2001.08.29, C.Hoffmann
  stripform <- function(x,after,len) {
    st <- format(x,digits=min(max(1,after),22),trim=TRUE,nsmall=after)
    difflen <- nchar(st) - len
    while (difflen < 0) {
      st <- paste(" ",st,sep="")
      difflen <- difflen+1
    }
    while ((difflen > 0) & (substring(st,1,1) == " ")) {
      st <- substring(st,2)
      difflen <- difflen-1
    }
    if (difflen) paste(rep("*",len),collapse="")
    else st
  }
  maxA  <- 1.0e8
  after <- max(after,0)
  withdot <- after>0
  toobig  <- ifelse(is.na(x),TRUE,abs(x)>=maxA)
  decim <- pmax(floor(log10(abs(x))*(1+.Machine$double.eps)),0)
  reqbef  <- ifelse(is.na(x),2,pmax(decim,0) + as.numeric(x<0) + 1)
  placesbefore <- ifelse(is.na(x),2,ifelse(rep(extend,length(x)),decim+2,pmin(before,reqbef)))
  placesbefore[toobig] <- 0
  xx     <- round(abs(x)*10^after)  #  treat as integer
  before <- max(before,placesbefore)
  filldot <- reqbef > before
  regular <- !filldot & !toobig
  len <- mlen <- before+after+1
  if (!withdot) mlen <- mlen-1
  if (extend & any(toobig)) {
    ncc <- max(nchar(format(x[toobig],digits=min(max(1,after),22)))) - mlen
    if (ncc>0) {mlen <- mlen+ncc; len <- len+ncc}
  }
  str <- matrix("*",mlen,length(x))
  str[,regular] <- " "
  if (any(regular)) {
    kk <- 1
    while (kk <= after) {
      str[len-kk+1,regular] <- xx[regular] %% 10
      xx[regular] <- xx[regular] %/% 10
      kk <- kk+1
    }
    if (withdot) str[len-kk+1,regular] <- "."
    while (max(xx[regular]) > 0 | kk == after+1) { # latter for leading 0
      str[len-kk,regular] <- ifelse(xx[regular] > 0 | kk == after+1,xx[regular] %% 10,str[len-kk,regular])
      xx[regular] <- xx[regular] %/% 10
      kk <- kk+1
    }
    str[cbind(len-after-placesbefore,seq(ncol(str)))[regular & (x<0),]] <- "-"
  }
  res <- apply(str,2,paste,collapse="")
  if (any(toobig)) res[toobig] <- sapply(x[toobig],stripform,after,mlen)
  names(res) <- names(x)
  res
}

formula2string <- function(form)  {
  ## take a formula and return the left and the right hand sides
  dput(form,"xxxxformula")
  vec <- scan(file="xxxxformula",character(),quiet = TRUE)
  str <- paste(vec, sep=" ", collapse="")
  tilde <- substring.location(str,"~")$first[1]
  unlink("xxxxformula")
  list(left = substring(str,1,tilde-1), right = substring(str,tilde+1))
# list(left = if (attr(terms(form),"response")==0) "" else as.character(attr(terms(form),"variables"))[2], right = attr(terms.formula(form),"term.labels"))
}

formula2term.names <- function(form,side)  {
  ##  take a formula and return the names of the terms of the side hand side
  fstr <- formula2string(form)
  strsplit(unlist(fstr[names(fstr)==side], use.names=FALSE),"\\+")
}

formula2Rterm.names <- function(form)  {
  formula2term.names(form,"right")
}

"n22dig" <- function(x, symm = TRUE) {
  n22dig0 <- function(y) { ifelse(y == "00", " I", y) }
  y <- format(round(100 * x))
  if(nchar(y[1] == 3)) y <- substring(y, 2)
  if (is.matrix(x))
    y <- ifelse((row(x) < col(x)) & symm, " ", n22dig0(y))
  else
    y <- n22dig0(x)
  y
}
n2c <- function(x, symm = FALSE){
  n2c0 <- function(y) {
    ifelse(y >= 10e10, "X", ifelse(y >= 1.0, 
      as.character(trunc(log(y, 10))), ifelse(y >= 0.9, "&",
      ifelse(y >= 0.8, "%", ifelse(y >= 0.7, "#", 
      ifelse(y >= 0.6, "*", ifelse(y >= 0.5, "=", ifelse(y >= 0.4, "+", 
      ifelse(y >= 0.3, "-", ifelse(y >= 0.2, ":", ifelse(y >= 0.1, ",", 
      ifelse(y >= 0.05, ":", " ")))))))))))) }
  if (is.matrix(x))
    y <- ifelse((row(x) < col(x)) & symm, " ", n2c0(abs(x)))
  else
    y <- n2c0(abs(x))
  attr(y,"legend") <- ">=1:log, >=0. 9& 8% 7# 6* 5= 4+ 3- 2: 1, 05. ' ' "
  y
}  ## n2c

indexLine <- function(n) {
  L <- c(rep(".",n),spacC)  # extra space needed for charMat
  if (n>=5) {
    T <- seq(n%/%5)
    L[5*T] <- ";"
    if (n>=10) {
      T <- seq(n%/%10)
      L[10*T] <- T
    }
  }
  paste(L,collapse="")
} ## indexLine

n2cCompact <- function(x, symm=FALSE) {
  nB <- n2c(x, symm=symm)
  cc <- indexLine(ncol(x))
  c(cc,paste(apply(nB,2,paste,collapse=""),spacC,if (is.null(rownames(x))) seq(nrow(x)) else abbreviate(rownames(x),minlength = 10),sep=""),cc,paste("legend: ",attr(nB,"legend"),sep=""))
} ## n2cCompact

charMat <- function(cc) { ## lines of type n2cCompact
  rows <- length(cc)-3    ## strip lines 1 and -2, -1
  colP <- nchar(cc[1])
  colS <- colP-nchar(spacC)     ## without extra space in indexLine
  cc1  <- substring(cc,1,colP)  ## last place for cc2, see below
  cc2  <- substring(cc,colP+1)
  cm1  <- rev(rev(cc1[-1])[-c(1,2)])
  cm2  <- rev(rev(cc2[-1])[-c(1,2)])
  U <- rep(colP,rows)
  x <- unlist(lapply(U,seq))
  y <- rep(seq(U),U)
  tx <- unlist(strsplit(cm1,split=""))
  tx[colP*seq(rows)] <- cm2
  list(x=x, y=y, tx=tx) 
} ## charMat
num2Latex <- function (x, digits = 0) {
     op <- options(scipen = -digits)
     on.exit(options(op))
     x <- as.character(x)
     ind <- grep("e", x)
     x[ind] <- sapply(strsplit(x[ind], "e"), function(s) paste(s[1], 
 "e", as.numeric(s[2]), sep = ""))
     x[ind] <- paste(gsub("e", " \\cdot 10^{", x[ind], fixed = TRUE), 
 "}", sep = "")
     x
}  # num2Latex
"numeric.string" <- function(str) {
  oldop <- options(warn = -1)
  on.exit(options(oldop))
  !is.na(as.numeric(str))
} 

"all.digits" <- function(str) {
  k <- length(str)
  result <- logical(k)
  for(i in 1:k) {
    st <- str[i]
    ls <- nchar(st)
    ex <- substring(st, 1:ls, 1:ls)
    result[i] <- all(match(ex,c('0','1','2','3','4','5','6','7','8','9'),nomatch=0)>0)
  }
  result
}
"padding" <- function(str, space, with, to=c("left","right","center"))
{
  mto <- match.arg(to)
  free  <- space - nchar(str)
  fill   <- substring(paste(rep(with, ceiling(free / nchar(with))), collapse = ""),1,free)
## cat("	free=",free,",  fill=",fill,",  mto=",mto,"\n")
  if(free <= 0)
	  invisible("")
  else if  (mto == "left") paste(str,fill,sep = "")
  else if  (mto == "right") paste(fill,str,sep = "")
  else  paste(substring(fill,1,free %/% 2),str,substring(fill,1+free %/% 2,free), sep = "")
}

"%&%" <- function(a,b) { paste(a,b,sep="") }
pasteRound <- function (..., digits=16, sep=" ", collapse=NULL) {
  args <- list(...)
  if (length(args) == 0)
    if (length(collapse) == 0)
      character(0)
    else ""
  else{
    for(i in seq(along=args))
      if(is.numeric(args[[i]])) args[[i]] <-  as.character(round(args[[i]], digits))
      else args[[i]] <- as.character(args[[i]])
   .Internal(paste(args, sep, collapse))
  }
}



replacechar <- function(str, char = "_", newchar = ".")
  {  ## tjoelker@redwood.rt.cs.boeing.com (Rod Tjoelker 865-3197)
  under <- grep(char, str)
  for(i in under) {
    nc <- nchar(str[i])
    ch <- substring(str[i], 1:nc, 1:nc)
    ch <- ifelse(ch == char, newchar, ch)
    str[i] <- paste(ch, collapse = "")
  }
  return(str)
}
str2formula <- function(s) {
  formula(paste(s[[1]],s[[2]],sep="~"))
}

term.names2formula <- function(ls,rs) {
  formula(paste(ls,paste(rs,collapse="+"),sep="~"))
}
strmatch <- function( inputs, target) {
    if (!(is.character(inputs) && is.character(target)))
	stop ("Input must be character strings")

    if (length(inputs) <1) return(NULL)
    if (length(target) <1) return(rep(NA, length(inputs)))

    temp <- .C("strmatch", inputs, length(inputs), target, length(target),
		   result=integer(length(inputs)),PACKAGE="base")

    ifelse(temp$result<0, NA, temp$result)
}
.First.lib <- function(lib, pkg) {
    require("cwhmath")
}
