Build a solver for the "N balls on a scale" problem The twelve-balls problem is a famous problem where you are given twelve balls, one of which is a different weight, but you don't know whether it is heavier or lighter than the other balls. Using only three weighings of a two-sided scale, it is possible to find the differently weighted ball, and determine whether it is heavier or lighter.

Your task is to build a program that does the following:


Accept a number of balls N to be compared, from 8 to 100. (In the traditional problem, N = 12.)
Produce two lists of numbers, representing the balls to be placed on each side of the balance. An equal number of balls must be placed on each side.
Accept an input signifying whether the left side of the scale is heavier, the right side is heavier, or the two sides are equal (this can be represented any way you want to: e.g. -1 for left, 0 for equal, 1 for right, or 1 for left, 2 for right, and 3 for equal), and in response, either produce another pair of lists of balls to be weighed, or a guess as to which ball is the different one and whether it is heavier or lighter.


Your score is the sum of the maximum number of weighings for each value of N from 8 to 100 that it took to figure out the right answer for N balls using your algorithm (each case of "ball x is heavier/lighter" must be tested). Lowest score wins.

For example, if for N = 12, your algorithm managed to get 3 weighings for every case except "ball 8 is heavy" where it took 4 weighings, your score for N = 12 is 4. If your maximum score was 10 weighings for each N from 8 to 100, your final score would be 930.

Your algorithm must return the correct answer for all possible test cases (for any N, there are 2N possible test cases, which is a total of 10,044). In addition, the source code of your solution may not exceed 51,200 bytes (50 KB) in size.
Tcl, 455 426

proc weight n {
   set num [expr {int(log($n*2-1)/log(3))+1}]
   set len [expr {$n/3}]
   set pn 0
   set pri {2 5 7 11 13 17 19 23 29 31 37 41 43 59 61 67}
   for {set i 0} {$i &lt; $num} {incr i} {
       set a {}
       while {![llength $a]} {
           set a {}
           set b {}
           set c {}
           while {
               ($n+1)%[lindex $pri $pn]==0
             ||($n-1)%[lindex $pri $pn]==0
             ||$n%[lindex $pri $pn]==0} {incr pn; puts $pn}
           set cpn [lindex $pri $pn]
           for {set j 0} {$j &lt; $len} {incr j} {
               set tmp [expr {($j*$cpn)%$n}]
               lappend a $tmp
               incr tmp 1
               if {$tmp in $a} {set a {}; break}
               lappend b $tmp
           }
           incr pn
       }
       for {set j 0} {$j &lt; $n} {incr j} {
           if {$j ni $a &amp;&amp; $j ni $b} {lappend c $j}
       }
       puts "[lsort -integer $a] VS [lsort -integer $b] - Which is havier? -1 = left, 0 = equal, 1 = right"
       set idx [expr {[gets stdin] + 1}]
       if {$i == 0} {
           if {$idx == 1} {
               set p1 $c
               set p2 $c
           } elseif {$idx == 0} {
               set p1 $a
               set p2 $b
           } else {
               set p1 $b
               set p2 $a
           }
       } else {
           set lists [list $a $c $b]
           set p1 [lmap it [lindex $lists $idx] {if {$it ni $p1} continue; set it}]
           set p2 [lmap it [lindex $lists 2-$idx] {if {$it ni $p2} continue; set it}]
       }
   }
   if {[llength $p1]} {puts "Result $p1"} {puts "Result $p2"}
}
puts "Number of balls?"
weight [gets stdin]


No matter what you choose, the next question is always the same.