On Apr 27, 7:29 am, m...@[EMAIL PROTECTED]
(Marcel Hendrix) wrote:
> This Euler problem was relatively complicated.
> Download names.txt
fromhttp://projecteuler.net/index.php?section=problems.
>
> $PROCESS "string-process"
IFORTH
> ( c-addr u xt -- )
> The counted string described by c-addr and u becomes the tem****ary
input
> buffer during the execution of xt. The following code is
equivalent:
>
> CREATE foo 4 ,
> S" foo " ' CREATE $PROCESS 4 ,
>
> See also: EVALUATE
>
> $PROCESS is available in Gforth under a name I can never remember.
>
> DL****FT "d-l-****ft"
IFORTH
> ( d1 x -- d2 )
> Logically ****ft d1 over x bits to the left, giving the result d2. A
0
> bit is inserted at the right end of the value.
>
> DR****FT "d-r-****ft"
IFORTH
> ( d1 x -- d2 )
> Logically ****ft d1 over x bits to the right, giving the result d2.
A 0
> bit is inserted at the left end of the value. Since this bit is
also the
> sign bit for signed numbers, the sign bit is cleared by this
command.
>
> <WORD> "fast-word"
IFORTH
> ( c -- c-addr u )
> Perform the scanning functions of WORD . However the result is
given as
> a character string. In this way the command executes much faster
than
> WORD .
>
> -marcel
>
> --
--------------------------------------------------------------------------------------
> : DOUBLE[] 2* CELLS + ;
> : []DOUBLE SWAP 2* CELLS + ;
> : CELL[] CELLS + ;
> : []CELL SWAP CELLS + ;
>
> (*
> Using names.txt, a 46K text file containing over five-thousand
first names,
> begin by sorting it into alphabetical order. Then working out
the alphabetical
> value for each name, multiply this value by its alphabetical
position in the
> list to obtain a name score.
>
> For example, when the list is sorted into alphabetical order,
COLIN, which is
> worth 3 + 15 + 12 + 9 + 14 = 53, is the 938th name in the list.
So, COLIN would
> obtain a score of 938 * 53 = 49714.
>
> What is the total of all the name scores in the file?
>
> Example output:
>
> FORTH> euler22
>
> The total of all the name scores in the file names.txt is
18,049,839,040
I arrive at a much smaller number.
> 0.005 seconds elapsed. ok
> FORTH> .colin
> COLIN should be item #938, worth 53, score of 938 * 53 = 49714
> COLIN_______is worth 53, score = 49714 ok
> FORTH> 0 5 .index
> AARON_______ $00000031
> ABBEY_______ $00000023
> ABBIE_______ $00000013
> ABBY________ $0000001E
> ABDUL_______ $00000028 ok
> *)
>
> 0 VALUE #items
> CREATE nameindex #6000 2* CELLS ALLOT
> CREATE namevals #6000 CELLS ALLOT
> CREATE dummy #12 1+ CHARS ALLOT
>
> \ names.txt is quoted, comma-delimited, uppercased and contains no line
feeds.
> : fetch-names ( -- addr size )
> S" names.txt" R/O BIN OPEN-FILE THROW LOCALS| handle |
> PAD #100000 handle READ-FILE THROW
> handle CLOSE-FILE THROW
> PAD SWAP ;
>
> : SKIP-, ( -- ) BEGIN SOURCE DROP >IN @[EMAIL PROTECTED]
+ C@[EMAIL PROTECTED]
',' = WHILE 1 >IN +!
REPEAT ;
> : EOI? ( -- bool ) SOURCE NIP >IN @[EMAIL PROTECTED]
<= ;
>
> : indexed ( c-addr u1 -- )
> 0. DLOCAL hash
> dummy #13 '_' FILL #12 MIN dummy PACK COUNT DROP
> #12 0 ?DO C@[EMAIL PROTECTED]
'A' - $1F AND 0 hash 5 DL****FT D+ TO hash LOOP
DROP
> hash nameindex #items DOUBLE[] 2! ;
>
> : PRINT~NAME ( ud -- )
> DLOCAL name
> CR #12 0 DO name #11 I - 5 * DR****FT DROP $1F AND 'A' + EMIT
LOOP ;
>
> \ Test 1; print the index. This succeeds in printing names that are 12
characters
> \ or shorter. This is however only a side-effect: names are not stored.
> : .INDEX ( begin end -- )
> 2DUP > IF SWAP ENDIF #items MIN SWAP 0 MAX
> ?DO nameindex I DOUBLE[] 2@[EMAIL PROTECTED]
PRINT~NAME
> 4 SPACES
> namevals I CELL[] @[EMAIL PROTECTED]
H.
> LOOP ;
>
> \ 'A' is worth 1 etc.
> : alphabeticized ( c-addr u1 -- )
> 0 -ROT 0 ?DO C@[EMAIL PROTECTED]
'A' - 1+ ROT + SWAP LOOP DROP
> namevals #items CELL[] ! ;
>
> \ Test 2. It is defined where COLIN should be.
> : .COLIN ( -- )
> CR ." COLIN should be item #938, worth 53, score of 938 * 53 =
49714"
> nameindex #938 1- DOUBLE[] 2@[EMAIL PROTECTED]
PRINT~NAME
> ." is worth " namevals #938 1- CELL[] @[EMAIL PROTECTED]
DUP 0 .R ." , score = "
#938 * . ;
>
> \ C.A.R Hoare's famous QUICKSORT
>
> : $>= ( ix1 ix2 -- bool ) SWAP nameindex []DOUBLE 2@[EMAIL PROTECTED]
ROT nameindex
[]DOUBLE 2@[EMAIL PROTECTED]
D>= ;
> : $> ( ix1 ix2 -- bool ) SWAP nameindex []DOUBLE 2@[EMAIL PROTECTED]
ROT nameindex
[]DOUBLE 2@[EMAIL PROTECTED]
D> ;
>
> : XCHG ( ix1 ix2 -- )
> 0 0 LOCALS| a2 a1 ix2 ix1 |
> nameindex ix1 DOUBLE[] TO a1
> nameindex ix2 DOUBLE[] TO a2
> a1 2@[EMAIL PROTECTED]
a2 2@[EMAIL PROTECTED]
a1 2! a2 2!
> namevals ix1 CELL[] TO a1
> namevals ix2 CELL[] TO a2
> a1 @[EMAIL PROTECTED]
a2 @[EMAIL PROTECTED]
a1 ! a2 ! ;
>
> \ The newest qsort algorithm (Bentley) integrates 3-way partioning.
> : QUICKSORT ( l r -- ) RECURSIVE
> 2DUP >= IF 2DROP EXIT ENDIF
> 0 0 0 0 LOCALS| m I J pivot r l |
> l 1- TO I r TO J
> r l - 3 > IF r l + 2/ TO m ( median-of-three pivot selection )
> l m $> IF l m XCHG ENDIF
> l r $> IF l r XCHG ELSE
> r m $> IF r m XCHG ENDIF ENDIF
> ENDIF
> r TO pivot ( note that we need a check on J becoming out of
bounds )
> BEGIN BEGIN 1 +TO I I pivot $>= UNTIL
> BEGIN 1 -TO J J pivot $> WHILE J l = UNTIL THEN
> I J <
> WHILE I J XCHG
> REPEAT I r XCHG
> l I 1- QUICKSORT
> I 1+ r QUICKSORT ;
>
> : INDEXED-SORT ( -- ) 0 #items 1- QUICKSORT ;
>
> : store ( -- )
> CLEAR #items
> BEGIN
> &" <WORD>
> 2DUP indexed
> alphabeticized
> 1 +TO #items
> SKIP-,
> EOI?
> UNTIL ;
>
> \ index should go from 1 to #items for the purpose of counting.
> : NAME-SCORES ( -- ud )
> 0. #items 0 DO namevals I CELL[] @[EMAIL PROTECTED]
I 1+ * 0 D+ LOOP ;
>
> : Euler22 ( -- )
> fetch-names
> ['] store $PROCESS
> INDEXED-SORT
> CR ." The total of all the name scores in the file names.txt is
" NAME-SCORES D. ;
>
> : .ABOUT CR ." Euler22 -- What is the total of all the name scores in
the file names.txt?" ;
>
> .ABOUT
Ruby:
def name_val name
sum = 0
name.each_byte{|b| sum += b - ?A + 1 }
sum
end
def show_some start, count
$names[start,count].each do |name|
puts name.ljust(12,"_") + " $" +
name_val(name).to_s(16).rjust(8,'0')
end
end
$names = IO.read("names.txt").strip[1..-2].split( '","' ).sort
sum = 0
$names.each_with_index do |name,i|
score = (i + 1) * name_val(name)
puts "COLIN's score is #{ score }" if "COLIN" == name
sum += score
end
p sum
show_some 0, 5
--- output ---
COLIN's score is 49714
871198282
AARON_______ $00000031
ABBEY_______ $00000023
ABBIE_______ $00000013
ABBY________ $0000001e
ABDUL_______ $00000028
|
