Welcome, guest | Sign In | My Account | Store | Cart

Origin: http://wiki.tcl.tk/1067 Author: Michael A. Cleverly

The other day someone on OpenACS.org asked [http://openacs.org/bboard/q-and-a-fetch-msg.tcl?msg_id=0000k2&topic_id=11&topic=OpenACS] for a Tcl proc that would convert a base-62 number into a base-10 integer. I replied with a version I'd written. Here is a slightly expanded one. convert_number employs some Salt and Sugar which I quite like.

(One caveat is that base_n_to_decimal will either return an incorrect answer or generate an error for really large numbers that are > than 2147483647.)

Tcl, 65 lines
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
proc base_characters {base_n} {
    set base [list 0 1 2 3 4 5 6 7 8 9 A B C D E F G H I J K L M \
	    N O P Q R S T U V W X Y Z a b c d e f g h i j k l m n o p \
	    q r s t u v w x y z]
    if {$base_n < 2 || $base_n > 62} {
	error "Invalid base \"$base_n\" (should be an integer between 2 and 62)"
    }
    return [lrange $base 0 [expr $base_n - 1]]
}

proc base_n_to_decimal {number base_n} {
    set base   [base_characters $base_n]
    # trim white space in case [format] is used
    set number [string trim $number]
    # bases 11 through 36 can be treated in a case-insensitive fashion
    if {$base_n <= 36} {
	set number [string toupper $number]
    }
    set decimal 0
    set power [string length $number]

    foreach char [split $number ""] {
	incr power -1
	set dec_val [lsearch $base $char]
	if {$dec_val == -1} {
	    error "$number is not a valid base $base_n number"
	}
	set decimal [expr $decimal + $dec_val * int(pow($base_n,$power))]
    }

    return $decimal
}

proc decimal_to_base_n {number base_n} {
    set base [base_characters $base_n]
    # trim white space in case [format] is used
    set number [string trim $number]

    if {![string is integer $number] || $number < 0} {
	error "$number is not a base-10 integer between 0 and 2147483647"
    }

    while 1 {
	set quotient  [expr $number / $base_n]
	set remainder [expr $number % $base_n]
	lappend remainders $remainder
	set number $quotient
	if {$quotient == 0} {
	    break
	}
    }

    set base_n [list]

    for {set i [expr [llength $remainders] - 1]} {$i >= 0} {incr i -1} {
	lappend base_n [lindex $base [lindex $remainders $i]]
    }

    return [join $base_n ""]

}

proc convert_number {number "from" "base" base_from "to" "base" base_to} {
    return [decimal_to_base_n [base_n_to_decimal $number $base_from] $base_to]
}
Created by andreas kupries on Mon, 17 Jun 2002 (MIT)
Tcl recipes (162)
andreas kupries's recipes (20)

Required Modules

  • (none specified)

Other Information and Tasks