Anadromes: Difference between revisions
Content added Content deleted
(Added AppleScript.) |
(Added Algol 68) |
||
Line 18: | Line 18: | ||
=={{header|ALGOL 68}}== |
|||
Reads the words from standard input, stopping when a word = ZZZ is found (which is the last word in words.txt).<br> |
|||
Unfortunately, Algol 68G doesn't like an array of STRINGs with more than 300 000 elements, even though it allows INT arrays to have millions - at least under Windows<br> |
|||
(I haven't tried it with Linux).<br> |
|||
So you will need to use another compiler under Windows.<br> |
|||
As in the Wren sample, the words are quicksorted so binary searching can be used to find the reversed words. |
|||
<lang algol68>BEGIN # find some anadromes: words that whwn reversed are also words # |
|||
# in-place quick sort an array of strings # |
|||
PROC s quicksort = ( REF[]STRING a, INT lb, ub )VOID: |
|||
IF ub > lb |
|||
THEN |
|||
# more than one element, so must sort # |
|||
INT left := lb; |
|||
INT right := ub; |
|||
# choosing the middle element of the array as the pivot # |
|||
STRING pivot := a[ left + ( ( right + 1 ) - left ) OVER 2 ]; |
|||
WHILE |
|||
WHILE IF left <= ub THEN a[ left ] < pivot ELSE FALSE FI |
|||
DO |
|||
left +:= 1 |
|||
OD; |
|||
WHILE IF right >= lb THEN a[ right ] > pivot ELSE FALSE FI |
|||
DO |
|||
right -:= 1 |
|||
OD; |
|||
left <= right |
|||
DO |
|||
STRING t := a[ left ]; |
|||
a[ left ] := a[ right ]; |
|||
a[ right ] := t; |
|||
left +:= 1; |
|||
right -:= 1 |
|||
OD; |
|||
s quicksort( a, lb, right ); |
|||
s quicksort( a, left, ub ) |
|||
FI # s quicksort # ; |
|||
# returns TRUE if item is in list, FALSE otherwise # |
|||
# - based on the iterative routine in the binary search task # |
|||
PROC contains = ( []STRING list, STRING item, INT lb, ub )BOOL: |
|||
BEGIN |
|||
INT low := lb, |
|||
INT high := ub; |
|||
WHILE low < high DO |
|||
INT mid = ( low + high ) OVER 2; |
|||
IF list[ mid ] > item THEN high := mid - 1 |
|||
ELIF list[ mid ] < item THEN low := mid + 1 |
|||
ELSE low := high := mid |
|||
FI |
|||
OD; |
|||
list[ low ] = item |
|||
END # contains # ; |
|||
[ 1 : 500 000 ]STRING words; |
|||
INT t count := 0; |
|||
INT w count := 0; |
|||
INT max length := 0; |
|||
BOOL at eof := FALSE; |
|||
WHILE NOT at eof |
|||
DO |
|||
STRING word; |
|||
read( ( word, newline ) ); |
|||
at eof := word = "ZZZ"; |
|||
t count +:= 1; |
|||
INT w length := 1 + ( UPB word - LWB word ); |
|||
IF w length > 6 THEN |
|||
w count +:= 1; |
|||
words[ w count ] := word; |
|||
IF w length > max length THEN max length := w length FI |
|||
FI |
|||
OD; |
|||
print( ( "read ", whole( t count, 0 ), " words, " |
|||
, "the longest is ", whole( max length, 0 ), " characters" |
|||
, newline |
|||
, " ", whole( w count, 0 ), " words are longer than 6 characters" |
|||
, newline, newline |
|||
) |
|||
); |
|||
s quicksort( words, 1, w count ); # sort the words for binary search # |
|||
print( ( "The following anadromes are present:", newline, newline ) ); |
|||
INT a count := 0; |
|||
FOR i TO w count DO |
|||
STRING word = words[ i ]; |
|||
STRING reverse word := ""; |
|||
FOR w pos FROM LWB word TO UPB word DO word[ w pos ] +=: reverse word OD; |
|||
IF word < reverse word THEN |
|||
IF contains( words, reverse word, 1, w count ) THEN |
|||
# have an anadromic pair # |
|||
INT w length = 1 + ( UPB words[ i ] - LWB words[ i ] ); |
|||
FOR c TO 10 - w length DO print( ( " " ) ) OD; |
|||
print( ( words[ i ], " :: ", reverse word, newline ) ); |
|||
a count +:= 1 |
|||
FI |
|||
FI |
|||
OD; |
|||
print( ( newline, "Found ", whole( a count, 0 ), " anadromes", newline ) ) |
|||
END</lang> |
|||
{{out}} |
|||
<pre> |
|||
read 466551 words, the longest is 45 characters |
|||
387537 words are longer than 6 characters |
|||
The following anadromes are present: |
|||
amaroid :: diorama |
|||
degener :: reneged |
|||
deifier :: reified |
|||
deliver :: reviled |
|||
dessert :: tressed |
|||
desserts :: stressed |
|||
deviler :: relived |
|||
dioramas :: samaroid |
|||
gateman :: nametag |
|||
leveler :: relevel |
|||
pat-pat :: tap-tap |
|||
redrawer :: rewarder |
|||
reknits :: stinker |
|||
relever :: reveler |
|||
reliver :: reviler |
|||
revotes :: setover |
|||
sallets :: stellas |
|||
Found 17 anadromes |
|||
</pre> |
|||
=={{header|AppleScript}}== |
=={{header|AppleScript}}== |