###--- R function that does the same as 'scientific' in

###--- /usr/local/R-0.50/src/main/format.c
###--- ~~~~~~~~~~~||||||~~~~~~~~~~~~~~~~~~

scientific <- function(x, digits = getOption('digits')) ## eps = 10^-(digits)
{
  ##-   /* for 1 number  x , return
  ##-    *      sgn    = 1_{x < 0}  {0/1}
  ##-    *      kpower = Exponent of 10;
  ##-    *      nsig   = min(digits, #{significant digits of alpha})
  ##-    *
  ##-    * where  |x| = alpha * 10^kpower   and  1 <= alpha < 10
  ##-    */

  eps <- 10 ^(-digits)

  if (x == 0) {
    kpower <- 0
    nsig <- 1
    sgn <- 0
  } else {
    if(x < 0) {
      sgn <- 1; r <- -x
    } else {
      sgn <- 0; r <- x
    }
    kpower <- floor(log10(r));##-->      r = |x| ;  10^k <= r

    if (kpower <= -308) ## close to denormalization -- added for R 2.x.y
        alpha <- (r * 1e+30) / 10^(kp+30)
    else
        alpha <- r / 10^kpower

    ## make sure that alpha is in [1,10)

    if (10 - alpha < eps) {
      cat(".. scientific(.) correcting alpha=",format(alpha),
	  ".  x=", formatC(x,dig=2,w=1), "  >>> RARE ! <<<\n")
      alpha <- alpha/10
      kpower<- kpower + 1
    }

    ## compute number of digits

    a <- alpha
    nsig <- digits
    for (j in 1:nsig) {
      if (abs(a - floor(a+0.5)) < eps * a) {
        nsig <- j
        break
      }
      a <- a * 10
    }
  }
  left <- kpower + 1
  c(sgn = sgn, kpower = kpower, nsig = nsig,
    left = left, right = nsig - left,
    sleft = sgn + max(1,left))
}

names.num <- function(v, dig=2)
{
  ## Purpose: Add names to vector if it hasn't
  ## Author: Martin Maechler, Date: 16 Jul 97, 08:49
  names(v) <- formatC(v, w=1, dig=dig)
  v
}

do.sci <- function(v, nam.dig = 3, digits = getOption('digits'))
{
  ## Purpose: Call scientific(.) and do some more
  ## -------------------------------------------------------------------------
  ## Author: Martin Maechler, Date: 16 Jul 97, 17:03
  ## -- names.num(.) is from /u/maechler/R/Util.R ---
  r <- sapply(names.num(v, dig= nam.dig), scientific, digits=digits)
  cbind(r, min = apply(r,1,min), max = apply(r,1,max))
}
