ResistorFinder

FF 2007-05-13: Resistor finder is a little application for electronic amateurs like me, for approximately finding a specific value of resistor. It happens that while mounting a little circuit on a bredboard, one donesn't have a specific resistor value, so has to do something like adding two resistors in serie or in parallel, searching to the available values he owns.... Here you put all your resistor in the program "database", then type a value and the program will find the best try for you (choosing the better match between: single resistor you own, serie between 2 r, or parallel between 2 r).

Cool, uh? :)

https://wiki.tcl-lang.org/_repo/images/FF/ResistorFinder.gif


 #!/bin/sh
 # This line continues for Tcl, but is a single line for 'sh' \
 exec wish "$0" ${1+"$@"}

 #######################################################################
 #
 # ResistorFinder v0.1
 # written by Federico Ferri - 2007
 #
 #######################################################################
 #
 # This program is free software; you can redistribute it and/or modify
 # it under the terms of the GNU General Public License as published by
 # the Free Software Foundation; version 2 of the License.
 #   
 # This program is distributed in the hope that it will be useful,
 # but WITHOUT ANY WARRANTY; without even the implied warranty of
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 # GNU General Public License for more details.
 #
 #######################################################################

 # put your values below ;P

 #        value        qty        tolrnc        watts
 set rdb {
         4100000        4        5        0.25
         2200000        1        5        0.25
         1000000        32        5        0.25
         2200000        5        5        0.25
         100000        6        5        0.25
         68000        1        5        0.25
         22000        3        5        0.25
         10000        28        5        0.25
         4700        19        5        0.25
         3300        1        5        0.25
         2200        13        5        0.25
         1500        1        5        0.25
         1000        20        5        0.25
         470        1        5        0.5
         410        10        5        0.25
         220        7        5        0.25
         220        17        6        0.25
         200        1        6        0.25
         100        20        5        0.25
         41        10        5        0.25
         22.1        1        1        0.25
         22        10        5        0.25
         10        10        5        0.25
         4.1        10        5        0.25
         2.2        10        5        0.25
         1        9        5        0.25
 }

 set debug 0

 proc par {r1 r2} {
        return [expr 1.*$r1*$r2/($r1+$r2)]
 }

 proc parse {v} {
        set dgt {}
        set mult 1
        foreach ch [split $v {}] {
                switch $ch {
                        0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9
                        {set dgt "$dgt$ch"}
                        k
                        {set dgt "$dgt."; set mult 1000}
                        M
                        {set dgt "$dgt."; set mult 1000000}
                }
        }
        return [expr $dgt * $mult]
 }

 proc find1 {val} {
        # find single
        set delta 1000000000
        set best [list [list $val 0 0 0]]
        foreach {v q t w} $::rdb {
                set delta2 [expr abs($val-$v)]
                if $::debug {
                        puts "find1: {$v $q $t $w} (delta=$delta2)"
                }
                if {$delta2 < $delta} {
                        set delta $delta2
                        if $::debug {
                                puts "found better delta: $delta"
                        }
                        set best [list [list $v $q $t $w]]
                }
        }
        set best
 }

 proc find2 {val} {
        # find parallel(2)
        set delta 1000000000
        set best [list [list $val 0 0 0] [list 1000000000 0 0 0]]
        foreach {v q t w} $::rdb {
                foreach {vp qp tp wp} $::rdb {
                        if {$v == $vp && $t == $tp && $w == $wp} {
                                if {$q < 2} continue
                        }
                        set par [par $v $vp]
                        set delta2 [expr abs($val-$par)]
                        if $::debug {
                                puts "find2: {$v $q $t $w}{$vp $qp $tp $wp} (par=$par) (delta=$delta2)"
                        }
                        if {$delta2 < $delta} {
                                set delta $delta2
                                if $::debug {
                                        puts "found better delta: $delta"
                                }
                                set best [list [list $v $q $t $w] [list $vp $qp $tp $wp]]
                        }
                }
        }
        set best
 }

 proc find3 {val} {
        # find serie(2)
        set delta 1000000000
        set best [list [list $val 0 0 0]]
        foreach {v q t w} $::rdb {
                foreach {vp qp tp wp} $::rdb {
                        if {$v == $vp && $t == $tp && $w == $wp} {
                                if {$q < 2} continue
                        }
                        set par [expr $v + $vp]
                        set delta2 [expr abs($val-$par)]
                        if $::debug {
                                puts "find3: {$v $q $t $w}{$vp $qp $tp $wp} (ser=$par) (delta=$delta2)"
                        }
                        if {$delta2 < $delta} {
                                set delta $delta2
                                if $::debug {
                                        puts "found better delta: $delta"
                                }
                                set best [list [list $v $q $t $w] [list $vp $qp $tp $wp]]
                        }
                }
        }
        set best
 }

 proc draw_r {c tag x y val} {
        set v1 [lindex [split "$val" ""] 0]
        set v2 [lindex [split "$val" ""] 1]
        if {$v2 == "."} {set v2 [lindex [split "$val" ""] 2]}
        set v3 [r_mult $val]
        set v4 g
        set r [$c create polygon \
 4 0        12 0        14 2        18 4        40 4        44 2        46 0        54 0        56 2\
 58 6        58 14        56 18        54 20        46 20        44 18        40 16        18 16        14 18\
 12 20        4 20        2 18        0 14        0 6        2 2        4 0\
        -fill [r_color bg1] -outline [r_color bdr] -tags $tag]
        set c1 [$c create rectangle 6 0 12 20  -fill [r_color $v1] -tags $tag]
        set c2 [$c create rectangle 18 4 24 16 -fill [r_color $v2] -tags $tag]
        set c3 [$c create rectangle 30 4 36 16 -fill [r_color $v3] -tags $tag]
        set c4 [$c create rectangle 46 0 52 20 -fill [r_color $v4] -tags $tag]
        $c move $tag $x $y
 }

 proc draw_r1 {c tag x y val1} {
        set W 56 ; set H 20        ; set U 12
        set Ax [expr $x+0]         ; set Ay [expr ($H/2)+$y+0]
        set Bx [expr $x+$U]        ; set By [expr ($H/2)+$y+0]
        set Cx [expr $x+$U+$W]     ; set Cy [expr ($H/2)+$y+0]
        set Dx [expr $x+$U*2+$W]   ; set Dy [expr ($H/2)+$y+0]
        set Tw $tag.wire
        set Ta $tag.A
        $c create line $Ax $Ay $Bx $By -tags $Tw
        $c create line $Cx $Cy $Dx $Dy -tags $Tw
        draw_r $c $Ta $Bx [expr $Dy-($H/2)] $val1
 }

 proc draw_rp {c tag x y val1 val2} {
        set W 56 ; set H 20      ; set U 12
        set Ax [expr $x+0]       ; set Ay [expr ($H/2)+$y+$U]
        set Bx [expr $x+$U]      ; set By [expr ($H/2)+$y+$U]
        set Cx [expr $x+$U]      ; set Cy [expr ($H/2)+$y+0]
        set Dx [expr $x+$U*2]    ; set Dy [expr ($H/2)+$y+0]
        set Ex [expr $x+$U*2+$W] ; set Ey [expr ($H/2)+$y+0]
        set Fx [expr $x+$U*3+$W] ; set Fy [expr ($H/2)+$y+0]
        set Gx [expr $x+$U*3+$W] ; set Gy [expr ($H/2)+$y+$U]
        set Hx [expr $x+$U*4+$W] ; set Hy [expr ($H/2)+$y+$U]
        set Ix [expr $x+$U]      ; set Iy [expr ($H/2)+$y+$U*2]
        set Jx [expr $x+$U*2]    ; set Jy [expr ($H/2)+$y+$U*2]
        set Kx [expr $x+$U*2+$W] ; set Ky [expr ($H/2)+$y+$U*2]
        set Lx [expr $x+$U*3+$W] ; set Ly [expr ($H/2)+$y+$U*2]
        set Tw $tag.wire
        set Ta $tag.A
        set Tb $tag.B
        $c create line $Ax $Ay $Bx $By -tags $Tw
        $c create line $Gx $Gy $Hx $Hy -tags $Tw
        $c create line $Dx $Dy $Cx $Cy $Ix $Iy $Jx $Jy -tags $Tw
        $c create line $Ex $Ey $Fx $Fy $Lx $Ly $Kx $Ky -tags $Tw
        draw_r $c $Ta $Dx [expr $Dy-($H/2)] $val1
        draw_r $c $Tb $Jx [expr $Jy-($H/2)] $val2
 }

 proc draw_rs {c tag x y val1 val2} {
        set W 56 ; set H 20        ; set U 12
        set Ax [expr $x+0]         ; set Ay [expr ($H/2)+$y+0]
        set Bx [expr $x+$U]        ; set By [expr ($H/2)+$y+0]
        set Cx [expr $x+$U+$W]     ; set Cy [expr ($H/2)+$y+0]
        set Dx [expr $x+$U*2+$W]   ; set Dy [expr ($H/2)+$y+0]
        set Ex [expr $x+$U*2+$W*2] ; set Ey [expr ($H/2)+$y+0]
        set Fx [expr $x+$U*3+$W*2] ; set Fy [expr ($H/2)+$y+0]
        set Tw $tag.wire
        set Ta $tag.A
        set Tb $tag.B
        $c create line $Ax $Ay $Bx $By -tags $Tw
        $c create line $Cx $Cy $Dx $Dy -tags $Tw
        $c create line $Ex $Ey $Fx $Fy -tags $Tw
        draw_r $c $Ta $Bx [expr $Dy-($H/2)] $val1
        draw_r $c $Tb $Dx [expr $Dy-($H/2)] $val2
 }

 proc r_mult {v} {
        if {$v < 10} {
                return g
        } elseif {$v < 100} {
                return 0
        } elseif {$v < 1000} {
                return 1
        } elseif {$v < 10000} {
                return 2
        } elseif {$v < 100000} {
                return 3
        } elseif {$v < 1000000} {
                return 4
        } elseif {$v < 10000000} {
                return 5
        } elseif {$v < 100000000} {
                return 6
        } elseif {$v < 1000000000} {
                return 7
        }
 }

 proc r_color {n} {
        switch $n {
                0 { return "#000000"}
                1 { return "#653332"}
                2 { return "#fe0000"}
                3 { return "#ff5b10"}
                4 { return "#fffd01"}
                5 { return "#33cc33"}
                6 { return "#6666fa"}
                7 { return "#cd66ff"}
                8 { return "#939393"}
                9 { return "#ffffff"}
                g { return "#ce9836"}
                s { return "#cccccc"}
                bg1 { return "#cece9a"}
                bg2 { return "#6799f8"}
                bdr { return "#000000"}
        }
 }

 proc float {v {n 2}} {
        return [expr 1.*floor($v*pow(10,$n))/pow(10,$n)]
 }

 proc burzum {} {
        set vv $::reval
        foreach t {R_orig R_parl R_serie R_orig.wire R_parl.wire R_serie.wire R_orig.A R_parl.A R_serie.A R_orig.B R_parl.B R_serie.B R_m R_m.wire R_m.A R_m.B} {
                .c delete $t
                .cp delete $t
                .cs delete $t
                .cm delete $t
        }
        .cm configure -background [.c cget -background]
        .cs configure -background [.c cget -background]
        .cp configure -background [.c cget -background]
        set v [parse $vv]
        set m1 [find1 $v]
        set m1a [lindex [lindex $m1 0] 0]
        set err [expr 100*($v-$m1a)/$v]
        set m2 [find2 $v]
        set m2a [lindex [lindex $m2 0] 0]
        set m2b [lindex [lindex $m2 1] 0]
        set m2p [par $m2a $m2b]
        set errp [expr 100*($v-$m2p)/$v]
        set m3 [find3 $v]
        set m3a [lindex [lindex $m3 0] 0]
        set m3b [lindex [lindex $m3 1] 0]
        set m3s [expr $m3a + $m3b]
        set errs [expr 100*($v-$m3s)/$v]
        draw_r1 .c R_orig 0 4  $v
        draw_r1 .cm R_m  40 8  $m1a
        draw_rp .cp R_parl  36 8  $m2a $m2b
        draw_rs .cs R_serie 12 8  $m3a $m3b
        set ::txtlm "Best match:\n[float $m1a] Ohm\nError: [float $err]%"
        set ::txtlp "Best parallel:\n[float $m2a] // [float $m2b] = [float $m2p] Ohm\nError: [float $errp]%"
        set ::txtls "Best serie:\n[float $m3a] + [float $m3b] = [float $m3s] Ohm\nError: [float $errs]%"
        set err [expr abs($err)]
        set errs [expr abs($errs)]
        set errp [expr abs($errp)]
        if {$err < $errs} {
                if {$err < $errp} {
                        .cm configure -background "#ffffff"
                } else {
                        .cp configure -background "#ffffff"
                }
        } else {
                if {$errs < $errp} {
                        .cs configure -background "#ffffff"
                } else {
                        .cp configure -background "#ffffff"
                }
        }
        #set ::reval $v
        .r selection range 0 end
 }


 set reval 4k7
 set txtlp ""
 set txtls ""
 set txtlm ""
 font create tFnt -family Helvetica -size 18 -weight bold -slant roman
 font create tFn2 -family Helvetica -size 8
 label .ttle -text "ResistorFinder" -font tFnt
 grid .ttle -row 0 -column 0 -columnspan 3
 label .copy -text "by Federico Ferri - 2007\nreleased under the GNU/GPL license\nsee the source code for full license agreement\n\n" -font tFn2
 grid .copy -row 1 -column 0 -columnspan 3
 entry .r -textvar ::reval
 bind .r <Return> "burzum"
 grid .r -row 2 -column 0
 label .spc1 -text "      "
 grid .spc1 -row 2 -column 1
 canvas .c -width 79 -height 27
 grid .c -row 2 -column 2

 label .lm -textvar ::txtlm
 grid .lm -row 3 -column 0 -columnspan 3
 canvas .cm -width 179 -height 37
 grid .cm -row 4 -column 0 -columnspan 3

 label .ls -textvar ::txtls
 grid .ls -row 5 -column 0 -columnspan 3
 canvas .cs -width 179 -height 37
 grid .cs -row 6 -column 0 -columnspan 3

 label .lp -textvar ::txtlp
 grid .lp -row 7 -column 0 -columnspan 3
 canvas .cp -width 179 -height 67
 grid .cp -row 8 -column 0 -columnspan 3

 focus .r
 .r selection range 0 end
 .r icursor end

See also: Ohm-O-Graph


S_M 2007-07-06 : there are a couple of issues entering the value 1.0. The 1 ohm resistor is drawn without the black band. To fix it add in draw_r after if {$v2 == '.'}:

            if {$v2 == ""} {set v2 0}

Also the value 1.0 is read as 10, add in parse the case for '.' (also add uppercase K):

                  switch $ch {
                         .
                         {set dgt "$dgt."}

swatz - 2009-11-23 15:56:26

THANK A LOT , IT'S THE PROGRAM OF MY DREAM . i probably try to make the same think with Octave to do my calcul . ++