[R] log10(), floor() combo issue / APL-encode, APL-decode, chcode

[Peter Wolf]

D. Steuer wrote:

> On 14-Oct-2002 E.L. Willighagen wrote:
>>
>> Hi all,
>>
>> in my search for a nice binary2decimal method, I received this nice
>> code (thanx to Uwe Ligges):
>>
>>  bindec <- function(b)
>>    sum(as.integer(unlist(strsplit(b, ""))) * 2^(floor(log10(b)):0))
>
> Nice function!

Some years ago we used the nice APL-functions "decode" and "encode"
for such a job.There are a lot situations for using them, for example
to change the representation of a number.

For details, have a look at: http://www.acm.org/sigapl/encode.htm

Here are two simple R-Versions:

decode <- function(b, base) {
   # simple version of APL-decode / APL-base "_|_", pw10/02
   # "decode" converts "b" using the increments "base"
   b <- as.integer(b)
   if( length(base) == 1 ) base<-rep(base,length(b))
   base<-c(base,1)
   number<-as.vector( cumprod(rev(base)[ 1:length(b) ] ) %*% rev(b) )
   number
}

encode <- function(number, base) {
   # simple version of APL-encode / APL-representation "T", pw 10/02
   # "encode" converts the numbers "number" using the radix vector
"base"
   n.base <- length(base); result <- matrix(0, length(base),
length(number))
   for(i in n.base:1){
     result[i,] <- if(base[i]>0) number %% base[i] else number
     number     <- ifelse(rep(base[i]>0,length(number)),
                          floor(number/base[i]), 0)
   }
   return( if(length(number)==1) result[,1] else result )
}

For changing the number system ( bin to hex ) the function "chcode" may
help:

chcode <- function(b, base.in=2, base.out=10,
digits="0123456789ABCDEF"){
   # change of number systems, pw 10/02
   # e.g.: from 2 2 2 2 ...  ->  16 16 16 ...
   digits<-substring(digits,1:nchar(digits),1:nchar(digits))
   if(length(base.in)==1) base.in <- rep(base.in, max(nchar(b)-1))
   if(is.numeric(b)) b <- as.character(as.integer(b))
   b.num <- lapply(strsplit(b,""), function(x) match(x,digits)-1  )
   result <- lapply(b.num, function(x){
                cumprod(rev(c(base.in,1))[ 1:length(x) ] ) %*% rev(x)
             } )
   number<-unlist(result)
   cat("decimal representation:",number,"\n")
   if(length(base.out)==1){
      base.out<-rep(base.out,1+ceiling(log( max(number), base=base.out )
) )
   }
   n.base <- length(base.out); result <- NULL
   for(i in n.base:1){
     result <- rbind(number %% base.out[i], result)
     number <- floor(number/base.out[i])
   }
   result[]<-digits[result+1]
   apply(result, 2, paste, collapse="")
}

any comments for improvements?

Peter


--------------------------------------------------
Some examples:

> chcode(c("1000","1100","2000"),2,16)
decimal representation: 8 12 16
[1] "08" "0C" "10"
> chcode(c("08","0C","10"),16,2)
decimal representation: 8 12 16
[1] "01000" "01100" "10000"

> print(encode(c(15, 31, 32, 33, 75), c(16, 16, 16,16)))
     [,1] [,2] [,3] [,4] [,5]
[1,]    0    0    0    0    0
[2,]    0    0    0    0    0
[3,]    0    1    2    2    4
[4,]   15   15    0    1   11
> print(encode(c(15, 31, 32, 33, 75), c(4, 4, 4, 4)))
     [,1] [,2] [,3] [,4] [,5]
[1,]    0    0    0    0    1
[2,]    0    1    2    2    0
[3,]    3    3    0    0    2
[4,]    3    3    0    1    3
> print(encode(c(13), c(2, 2, 2, 2)))
[1] 1 1 0 1
> print(encode(c(62), c(16, 16, 16)))
[1]  0  3 14

> print(decode(c(1, 1, 1, 1), c(2, 2, 2, 2)))
[1] 15
# Convert 2 days, 3 hours, 5 minutes, and 27 seconds to seconds
> print(decode(c(2, 3, 5, 27), c(0, 24, 60, 60)))
[1] 183927


---------------------------------------------
Dr. Peter Wolf
Dept. of Economics
University of Bielefeld
pwolf at wiwi.uni-bielefeld.de

-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-
r-help mailing list -- Read http://www.ci.tuwien.ac.at/~hornik/R/R-FAQ.html
Send "info", "help", or "[un]subscribe"
(in the "body", not the subject !)  To: r-help-request at stat.math.ethz.ch
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._