home bbs files messages ]

Forums before death by AOL, social media and spammers... "We can't have nice things"

   comp.lang.forth      Forth programmers eat a lot of Bratwurst      117,927 messages   

[   << oldest   |   < older   |   list   |   newer >   |   newest >>   ]

   Message 116,456 of 117,927   
   Krishna Myneni to Krishna Myneni   
   Re: Best Euler #13 solution? (1/2)   
   03 May 24 17:02:55   
   
   From: krishna.myneni@ccreweb.org   
      
   On 5/2/24 22:07, Krishna Myneni wrote:   
   > On 5/2/24 16:14, minforth wrote:   
   >> My first similar idea was:   
   >> 50 decimal digits are equivalent to 167 binary digits. So splitting   
   >> the numbers in half would allow the use double number arithmetic   
   >> of a 64-bit Forth system for each half column.   
   >   
   > Here's the first part of this to read in the numbers into an array, as   
   > double length integers on a 64-bit Forth system (kforth64).   
   >   
   > -- Krishna   
   >   
   > === begin code ===   
   > \ euler13.4th   
   > \   
   > \ Work out the first ten digits of the sum of the   
   > \ following one-hundred 50-digit numbers.   
   >   
   > 1 CELLS 8 < ABORT" Needs 64-bit Forth!"   
   >   
   > 10 constant LF   
   > 100 constant N   
   >   50 constant Ndig   
   >   
   > create $nums N Ndig * allot   
   > create Dnums[ N 2* 16 * allot   
   > : ]D@ ( a idx -- ud ) 16 * + 2@ ;   
   > : ]D! ( ud a idx -- ) 16 * + 2! ;   
   > : $>ud ( a u -- ud )  0 s>d 2swap >number 2drop ;   
   > : $>2ud ( a u -- ud_low ud_high )   
   >     drop Ndig 2/ 2dup + over $>ud 2swap $>ud ;   
   >   
   > \ Read N big numbers as strings and then parse into   
   > \ double length array   
   > : read-numbers ( -- )   
   >      N 0 DO   
   >          refill IF   
   >            LF parse dup Ndig <> ABORT" String Length Error!"   
   >            $nums Ndig I * + swap move   
   >          ELSE  ABORT   
   >          THEN   
   >      LOOP   
   >      N 0 DO   
   >        $nums Ndig I * + Ndig   
   >        $>2ud Dnums[ I 2* 1+ ]D! Dnums[ I 2* ]D!   
   >      LOOP ;   
   >   
   > \ read into array of 2*N doubles   
   > read-numbers   
   > 37107287533902102798797998220837590246510135740250   
   > 46376937677490009712648124896970078050417018260538   
   > 74324986199524741059474233309513058123726617309629   
   > ...   
   > === end code ===   
   >   
   > And, here's the check to ensure the numbers loaded into the array Dnums[   
   >   
   > === test above code ===   
   > include euler13   
   >   ok   
   > Dnums[ 0 ]D@ ud.   
   > 8220837590246510135740250  ok   
   > Dnums[ 1 ]D@ ud.   
   > 3710728753390210279879799  ok   
   > Dnums[ 2 ]D@ ud.   
   > 4896970078050417018260538  ok   
   > Dnums[ 3 ]D@ ud.   
   > 4637693767749000971264812  ok   
   > \ ...   
   > Dnums[ 198 ]D@ ud.   
   > 4075591789781264330331690  ok   
   > Dnums[ 199 ]D@ ud.   
   > 5350353422647252425087405  ok   
   > === end test ===   
   >   
      
   Here's the full program to solve Euler13 using addition of double   
   numbers on a 64-bit Forth system using only standard words and no   
   floating point. With a little work, it can be used to print the full sum   
   as well.   
      
   -- KM   
      
   === begin code ===   
   \ euler13.4th   
   \   
   \ Work out the first ten digits of the sum of the   
   \ following one-hundred 50-digit numbers.   
      
   1 CELLS 8 < ABORT" Needs 64-bit Forth!"   
      
   10 constant LF   
   100 constant N   
     50 constant Ndig   
      
   create $nums N Ndig * allot   
   create Dnums[ N 2* 16 * allot   
   : ]D@ ( a idx -- ud ) 16 * + 2@ ;   
   : ]D! ( ud a idx -- ) 16 * + 2! ;   
   : $>ud ( a u -- ud )  0 s>d 2swap >number 2drop ;   
   : $>2ud ( a u -- ud_low ud_high )   
       drop Ndig 2/ 2dup + over $>ud 2swap $>ud ;   
      
   \ Read N big numbers as strings and then parse into   
   \ double length array   
   : read-numbers ( -- )   
        N 0 DO   
            refill IF   
              LF parse dup Ndig <> ABORT" String Length Error!"   
              $nums Ndig I * + swap move   
            ELSE  ABORT   
            THEN   
        LOOP   
        N 0 DO   
          $nums Ndig I * + Ndig   
          $>2ud Dnums[ I 2* 1+ ]D! Dnums[ I 2* ]D!   
        LOOP ;   
      
   read-numbers   
   37107287533902102798797998220837590246510135740250   
   46376937677490009712648124896970078050417018260538   
   74324986199524741059474233309513058123726617309629   
   91942213363574161572522430563301811072406154908250   
   23067588207539346171171980310421047513778063246676   
   89261670696623633820136378418383684178734361726757   
   28112879812849979408065481931592621691275889832738   
   44274228917432520321923589422876796487670272189318   
   47451445736001306439091167216856844588711603153276   
   70386486105843025439939619828917593665686757934951   
   62176457141856560629502157223196586755079324193331   
   64906352462741904929101432445813822663347944758178   
   92575867718337217661963751590579239728245598838407   
   58203565325359399008402633568948830189458628227828   
   80181199384826282014278194139940567587151170094390   
   35398664372827112653829987240784473053190104293586   
   86515506006295864861532075273371959191420517255829   
   71693888707715466499115593487603532921714970056938   
   54370070576826684624621495650076471787294438377604   
   53282654108756828443191190634694037855217779295145   
   36123272525000296071075082563815656710885258350721   
   45876576172410976447339110607218265236877223636045   
   17423706905851860660448207621209813287860733969412   
   81142660418086830619328460811191061556940512689692   
   51934325451728388641918047049293215058642563049483   
   62467221648435076201727918039944693004732956340691   
   15732444386908125794514089057706229429197107928209   
   55037687525678773091862540744969844508330393682126   
   18336384825330154686196124348767681297534375946515   
   80386287592878490201521685554828717201219257766954   
   78182833757993103614740356856449095527097864797581   
   16726320100436897842553539920931837441497806860984   
   48403098129077791799088218795327364475675590848030   
   87086987551392711854517078544161852424320693150332   
   59959406895756536782107074926966537676326235447210   
   69793950679652694742597709739166693763042633987085   
   41052684708299085211399427365734116182760315001271   
   65378607361501080857009149939512557028198746004375   
   35829035317434717326932123578154982629742552737307   
   94953759765105305946966067683156574377167401875275   
   88902802571733229619176668713819931811048770190271   
   25267680276078003013678680992525463401061632866526   
   36270218540497705585629946580636237993140746255962   
   24074486908231174977792365466257246923322810917141   
   91430288197103288597806669760892938638285025333403   
   34413065578016127815921815005561868836468420090470   
   23053081172816430487623791969842487255036638784583   
   11487696932154902810424020138335124462181441773470   
   63783299490636259666498587618221225225512486764533   
   67720186971698544312419572409913959008952310058822   
   95548255300263520781532296796249481641953868218774   
   76085327132285723110424803456124867697064507995236   
   37774242535411291684276865538926205024910326572967   
   23701913275725675285653248258265463092207058596522   
   29798860272258331913126375147341994889534765745501   
   18495701454879288984856827726077713721403798879715   
   38298203783031473527721580348144513491373226651381   
   34829543829199918180278916522431027392251122869539   
   40957953066405232632538044100059654939159879593635   
   29746152185502371307642255121183693803580388584903   
   41698116222072977186158236678424689157993532961922   
   62467957194401269043877107275048102390895523597457   
   23189706772547915061505504953922979530901129967519   
   86188088225875314529584099251203829009407770775672   
   11306739708304724483816533873502340845647058077308   
   82959174767140363198008187129011875491310547126581   
      
   [continued in next message]   
      
   --- SoupGate-Win32 v1.05   
    * Origin: you cannot sedate... all the things you hate (1:229/2)   

[   << oldest   |   < older   |   list   |   newer >   |   newest >>   ]


(c) 1994,  bbs@darkrealms.ca