Archive version of: base-convert.r ... version: 1 ... sunanda 29-Aug-2004

Amendment note: new script || Publicly available? Yes

REBOL [
   file: %base-convert.r
   title: "Base conversion functions"
   author: "Sunanda"
   date: 01-aug-2004
   version: 0.0.1
   purpose: {Functions to convert an decimal whole number to and from any arbitrary base}
   library: [
       level: 'intermediate
       platform: 'all
       type: [tool function]
       domain: [math scientific financial]
       tested-under: [win]
       support: none
       license: 'GPL
       see-also: none
     ]
    ]

;; --------------
;; Documentation:
;; --------------
;; see http://www.rebol.org/cgi-bin/cgiwrap/rebol/documentation.r?script=base-convert.r


base-convert: make object! [

;;  Customisable data items
;;  -----------------------
    maximum-decimal: 999999999
    default-digits: "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    case-sensitive: false
    error-messages: [
        "Maximum base should be "
        "Base minimum is 2. Not "
        "Base contains duplicate characters: "
        "Number to convert must be 0 or greater"
        "Number has unrecognised digit: "
        "Number larger than "
        "Number should be a whole number (no decimal places)"
    ]

;;  ================
;;  to-base function
;;  ================

    to-base: func [number-in [number!]
        to-base [integer! string!]
        /local
         number-out
         int-part
         frac-part
    ][
        if number-in < 0 [make error! error-messages/4]  ;; too small
        if 0 <> (number-in // 1)  [make error! error-messages/7] ;; not whole number
        if number-in > maximum-decimal [make error! join error-messages/6 maximum-decimal] ;; too big
        to-base: make-base-string to-base
        number-out: copy ""
        int-part: number-in
        until
        [
            frac-part: 1 + (int-part // length? to-base)
            if frac-part > length? to-base [frac-part: 1]
            insert number-out to-base/:frac-part
            int-part: to-integer (int-part / length? to-base)
            int-part = 0
        ]
        return number-out
    ] ;; func

;;  ==================
;;  from-base function
;;  ==================
    from-base: func [number-in [string!]
        from-base [integer! string!]
        /local
         number-out
         curr-digit
    ][
        from-base: make-base-string from-base
        number-out: 0.0
        foreach digit number-in
        [   number-out: number-out * length? from-base
            either case-sensitive
            [curr-digit: find/case from-base to-string digit]
            [curr-digit: find from-base to-string digit]
            if none? curr-digit [make error! join error-messages/5 to-string digit]  ;; bad digit
            number-out: number-out - 1 + index? curr-digit
        ]
        return number-out
    ] ;; func

;;  ====================================
;;  internal function:  make base string
;;  ====================================
    make-base-string: func [item [integer! string!]
    ][
        if integer? item
        [
            if item > length? default-digits
            [make error! join error-messages/1 length? default-digits] ;; base too large
            item: copy/part default-digits item
        ]
        if not case-sensitive [uppercase item]
        if 2 > length? item
           [make error! join error-messages/2 length? item]  ;; gotta be at least base-2
        if all [not case-sensitive (length? item) <> length? unique item] ;; duplicate digits
           [make error! join error-messages/3 item]
        if all [case-sensitive (length? item) <> length? unique/case item] ;; duplicate
           [make error! join error-messages/3 item]
        return item
    ] ;; func

;;  =======================================================
;;  function to test drive the conversions -- useful if you
;;  make changes and want to run some verification tests
;;  =======================================================
    test-drive: func [/local tests-count
                             base
                             number
    ][
        tests-count: 0
        forever
        [
            if 0 = (tests-count // 1000)
            [
                print [now/time " Tests completed: " tests-count]
            ]
            tests-count: tests-count + 1

        ;;  Test decimal --> base --> decimal
        ;;  ---------------------------------

            base: maximum 2 random/secure 36
            number: random/secure maximum-decimal
            if number <> result: from-base to-base number base base
            [
                print [tests-count "//1: Failure on base:" base " Number: " number " -- " result]
            ]

        ;;  Test base --> decimal --> base
        ;;  ------------------------------
            base: random/secure copy default-digits
            base: copy/part base maximum 2 random/secure length? base
            number: copy ""

            loop random/secure length? base [append number random/only base]

            loop -1 + length? number   ;; remove leading "zeroes" from number
                [either number/1 = base/1
                    [number: copy skip number 1]
                    [break]
                ]
            result: from-base number base
            if result < maximum-decimal   ;; can't convert back if too large
              [result: to-base result base
                if result <> number
                [
                    print [tests-count "//2: Failure on base:" base " Number: " number " -- " result]
                ]
              ]
        ] ;; forever
    ] ;; func
] ;; object