Re: Euler problem #22
- From: William James <w_a_x_man@xxxxxxxxx>
- Date: Sun, 27 Apr 2008 13:51:04 -0700 (PDT)
On Apr 27, 7:29 am, m...@xxxxxx (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 temporary 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.
DLSHIFT "d-l-shift" IFORTH
( d1 x -- d2 )
Logically shift d1 over x bits to the left, giving the result d2. A 0
bit is inserted at the right end of the value.
DRSHIFT "d-r-shift" IFORTH
( d1 x -- d2 )
Logically shift 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 @ + C@ ',' = WHILE 1 >IN +! REPEAT ;
: EOI? ( -- bool ) SOURCE NIP >IN @ <= ;
: indexed ( c-addr u1 -- )
0. DLOCAL hash
dummy #13 '_' FILL #12 MIN dummy PACK COUNT DROP
#12 0 ?DO C@+ 'A' - $1F AND 0 hash 5 DLSHIFT D+ TO hash LOOP DROP
hash nameindex #items DOUBLE[] 2! ;
: PRINT~NAME ( ud -- )
DLOCAL name
CR #12 0 DO name #11 I - 5 * DRSHIFT 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@ PRINT~NAME
4 SPACES
namevals I CELL[] @ H.
LOOP ;
\ 'A' is worth 1 etc.
: alphabeticized ( c-addr u1 -- )
0 -ROT 0 ?DO C@+ '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@ PRINT~NAME
." is worth " namevals #938 1- CELL[] @ DUP 0 .R ." , score = " #938 * . ;
\ C.A.R Hoare's famous QUICKSORT
: $>= ( ix1 ix2 -- bool ) SWAP nameindex []DOUBLE 2@ ROT nameindex []DOUBLE 2@ D>= ;
: $> ( ix1 ix2 -- bool ) SWAP nameindex []DOUBLE 2@ ROT nameindex []DOUBLE 2@ D> ;
: XCHG ( ix1 ix2 -- )
0 0 LOCALS| a2 a1 ix2 ix1 |
nameindex ix1 DOUBLE[] TO a1
nameindex ix2 DOUBLE[] TO a2
a1 2@ a2 2@ a1 2! a2 2!
namevals ix1 CELL[] TO a1
namevals ix2 CELL[] TO a2
a1 @ a2 @ 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[] @ 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
.
- Follow-Ups:
- Re: Euler problem #22
- From: William James
- Re: Euler problem #22
- References:
- Euler problem #22
- From: Marcel Hendrix
- Euler problem #22
- Prev by Date: Re: Euler problem #20
- Next by Date: Re: Taylor series FSIN, FCOS, FTAN
- Previous by thread: Euler problem #22
- Next by thread: Re: Euler problem #22
- Index(es):
Relevant Pages
|
