aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Sync

Browse source
This commit is contained in:
Ingy döt Net 2013-10-27 22:24:23 +00:00
parent 6f050a029e
commit 776bba907c
3887 changed files with 59894 additions and 7280 deletions
Download patch file Download diff file Expand all files Collapse all files

175
Task/Anagrams/Component-Pascal/anagrams-1.component Normal file
View file

@ -0,0 +1,175 @@
MODULE BbtAnagrams;
IMPORT StdLog,Files,Strings,Args;
CONST
MAXPOOLSZ = 1024;
TYPE
Node = POINTER TO LIMITED RECORD;
count: INTEGER;
word: Args.String;
desc: Node;
next: Node;
END;
Pool = POINTER TO LIMITED RECORD
capacity,max: INTEGER;
words: POINTER TO ARRAY OF Node;
END;
PROCEDURE NewNode(word: ARRAY OF CHAR): Node;
VAR
n: Node;
BEGIN
NEW(n);n.count := 0;n.word := word$;
n.desc := NIL;n.next := NIL;
RETURN n
END NewNode;
PROCEDURE Index(s: ARRAY OF CHAR;cap: INTEGER): INTEGER;
VAR
i,sum: INTEGER;
BEGIN
sum := 0;
FOR i := 0 TO LEN(s$) DO
INC(sum,ORD(s[i]))
END;
RETURN sum MOD cap
END Index;
PROCEDURE ISort(VAR s: ARRAY OF CHAR);
VAR
i, j: INTEGER;
t: CHAR;
BEGIN
FOR i := 0 TO LEN(s$) - 1 DO
j := i;
t := s[j];
WHILE (j > 0) & (s[j -1] > t) DO
s[j] := s[j - 1];
DEC(j)
END;
s[j] := t
END
END ISort;
PROCEDURE SameLetters(x,y: ARRAY OF CHAR): BOOLEAN;
BEGIN
ISort(x);ISort(y);
RETURN x = y
END SameLetters;
PROCEDURE NewPoolWith(cap: INTEGER): Pool;
VAR
i: INTEGER;
p: Pool;
BEGIN
NEW(p);
p.capacity := cap;
p.max := 0;
NEW(p.words,cap);
i := 0;
WHILE i < p.capacity DO
p.words[i] := NIL;
INC(i);
END;
RETURN p
END NewPoolWith;
PROCEDURE NewPool(): Pool;
BEGIN
RETURN NewPoolWith(MAXPOOLSZ);
END NewPool;
PROCEDURE (p: Pool) Add(w: ARRAY OF CHAR), NEW;
VAR
idx: INTEGER;
iter,n: Node;
BEGIN
idx := Index(w,p.capacity);
iter := p.words[idx];
n := NewNode(w);
WHILE(iter # NIL) DO
IF SameLetters(w,iter.word) THEN
INC(iter.count);
IF iter.count > p.max THEN p.max := iter.count END;
n.desc := iter.desc;
iter.desc := n;
RETURN
END;
iter := iter.next
END;
ASSERT(iter = NIL);
n.next := p.words[idx];p.words[idx] := n
END Add;
PROCEDURE ShowAnagrams(l: Node);
VAR
iter: Node;
BEGIN
iter := l;
WHILE iter # NIL DO
StdLog.String(iter.word);StdLog.String(" ");
iter := iter.desc
END;
StdLog.Ln
END ShowAnagrams;
PROCEDURE (p: Pool) ShowMax(),NEW;
VAR
i: INTEGER;
iter: Node;
BEGIN
FOR i := 0 TO LEN(p.words) - 1 DO
IF p.words[i] # NIL THEN
iter := p.words^[i];
WHILE iter # NIL DO
IF iter.count = p.max THEN
ShowAnagrams(iter);
END;
iter := iter.next
END
END
END
END ShowMax;
PROCEDURE GetLine(rd: Files.Reader; OUT str: ARRAY OF CHAR);
VAR
i: INTEGER;
b: BYTE;
BEGIN
rd.ReadByte(b);i := 0;
WHILE (~rd.eof) & (i < LEN(str)) DO
IF (b = ORD(0DX)) OR (b = ORD(0AX)) THEN str[i] := 0X; RETURN END;
str[i] := CHR(b);
rd.ReadByte(b);INC(i)
END;
str[LEN(str) - 1] := 0X
END GetLine;
PROCEDURE DoProcess*;
VAR
params : Args.Params;
loc: Files.Locator;
fd: Files.File;
rd: Files.Reader;
line: ARRAY 81 OF CHAR;
p: Pool;
BEGIN
Args.Get(params);
IF params.argc = 1 THEN
loc := Files.dir.This("Bbt");
fd := Files.dir.Old(loc,params.args[0]$,FALSE);
StdLog.String("Processing: " + params.args[0]);StdLog.Ln;StdLog.Ln;
rd := fd.NewReader(NIL);
p := NewPool();
REPEAT
GetLine(rd,line);
p.Add(line);
UNTIL rd.eof;
p.ShowMax()
ELSE
StdLog.String("Error: Missing file to process");StdLog.Ln
END;
END DoProcess;
END BbtAnagrams.

9
Task/Anagrams/Component-Pascal/anagrams-2.component Normal file
View file

@ -0,0 +1,9 @@
import std.stdio, std.algorithm, std.range, std.string, std.exception;
void main() {
string[][const ubyte[]] an;
foreach (w; "unixdict.txt".File.byLine(KeepTerminator.no))
an[w.dup.representation.sort().release.assumeUnique] ~= w.idup;
immutable m = an.byValue.map!q{ a.length }.reduce!max;
writefln("%(%s\n%)", an.byValue.filter!(ws => ws.length == m));
}

14
Task/Anagrams/Component-Pascal/anagrams-3.component Normal file
View file

@ -0,0 +1,14 @@
import std.stdio, std.algorithm, std.file, std.string;
void main() {
auto keys = cast(char[])"unixdict.txt".read;
immutable vals = keys.idup;
string[][string] anags;
foreach (w; keys.splitter) {
immutable k = cast(string)w.representation.sort().release;
anags[k] ~= vals[k.ptr-keys.ptr .. k.ptr-keys.ptr + k.length];
}
//immutable m = anags.byValue.max!q{ a.length };
immutable m = anags.byValue.map!q{ a.length }.reduce!max;
writefln("%(%s\n%)", anags.byValue.filter!(ws => ws.length == m));
}

58
Task/Anagrams/Elena/anagrams.elena
View file

@ -1,47 +1,35 @@
#define std'dictionary'*.
#define std'basic'*.
#define std'patterns'*.
#define std'routines'*.
#define std'collections'*.
#define ext'patterns'*.
#define sys'dates'*.
#define io'* = sys'io'*.
#define system.
#define system'collections.
#define extensions'text.
#define extensions'text.
#symbol Str2CharList : aLiteral
= Summing &&var:List &prop:ecloneprop start:Scan::aLiteral.
// --- Normalized ---
#symbol Normalized : aLiteral
= WideStrValue::(Summing::String start:
Scan::(Str2CharList::aLiteral~esort run: aPair = (aPair former < aPair later))).
#symbol Program =
#symbol Normalized = &&:aLiteral
[
#var aStart := Now.
^ Summing new:(String new) foreach:(arrayControl sort:(stringControl toArray:aLiteral)) Literal.
].
#var aDictionary := Dictionary.
// --- Program ---
ReaderScan &&io'path:"unixdict.txt" &:io'AReadOnlyTextFile run: aWord =
#symbol program =
[
#var aDictionary := Dictionary new.
textFileControl forEachLine:"unixdict.txt" &do: &&:aWord
[
#var aKey := Normalized::aWord.
#var anItem := nil.
#if anItem := aDictionary @ aKey
| [
anItem := List.
aDictionary append &dictionary_key:aKey &content:anItem.
#var aKey := Normalized eval:aWord.
#var anItem := aDictionary @ aKey.
nil == anItem ?
[
anItem := List new.
aDictionary setAt:aKey:anItem.
].
anItem += WideStrValue::aWord.
anItem += aWord.
].
aDictionary~esort run: aPair = (aPair former count > aPair later count).
listControl sort:aDictionary &with: &&:aFormer:aLater [ aFormer Value Count > aLater Value Count ].
Scan &&enumerable:aDictionary &length:20 &:EListSubRange run: aList =
[
'program'output << aList << "%n".
].
#var anEnd := Now.
#var aDiff := anEnd - aStart.
'program'output << "%nTime elapsed in msec:" << aDiff milliseconds.
listControl foreach:aDictionary &top:20 &do: &&:aPair [ console writeLine:(ListPresenter new:(aPair Value)) ].
].

30
Task/Anagrams/Java/anagrams-1.java Normal file
View file

@ -0,0 +1,30 @@
import java.net.*;
import java.io.*;
import java.util.*;
public class WordsOfEqChars {
public static void main(String[] args) throws IOException {
URL url = new URL("http://www.puzzlers.org/pub/wordlists/unixdict.txt");
InputStreamReader isr = new InputStreamReader(url.openStream());
BufferedReader reader = new BufferedReader(isr);
Map<String, Collection<String>> anagrams = new HashMap<String, Collection<String>>();
String word;
int count = 0;
while ((word = reader.readLine()) != null) {
char[] chars = word.toCharArray();
Arrays.sort(chars);
String key = new String(chars);
if (!anagrams.containsKey(key))
anagrams.put(key, new ArrayList<String>());
anagrams.get(key).add(word);
count = Math.max(count, anagrams.get(key).size());
}
reader.close();
for (Collection<String> ana : anagrams.values())
if (ana.size() >= count)
System.out.println(ana);
}
}

53
Task/Anagrams/Java/anagrams-2.java Normal file
View file

@ -0,0 +1,53 @@
import java.net.*;
import java.io.*;
import java.util.*;
import java.util.concurrent.*;
import java.util.function.*;
public interface Anagram {
public static <AUTOCLOSEABLE extends AutoCloseable, OUTPUT> Supplier<OUTPUT> tryWithResources(Callable<AUTOCLOSEABLE> callable, Function<AUTOCLOSEABLE, Supplier<OUTPUT>> function, Supplier<OUTPUT> defaultSupplier) {
return () -> {
try (AUTOCLOSEABLE autoCloseable = callable.call()) {
return function.apply(autoCloseable).get();
} catch (Throwable throwable) {
return defaultSupplier.get();
}
};
}
public static <INPUT, OUTPUT> Function<INPUT, OUTPUT> function(Supplier<OUTPUT> supplier) {
return i -> supplier.get();
}
public static void main(String... args) {
Map<String, Collection<String>> anagrams = new ConcurrentSkipListMap<>();
int count = tryWithResources(
() -> new BufferedReader(
new InputStreamReader(
new URL(
"http://www.puzzlers.org/pub/wordlists/unixdict.txt"
).openStream()
)
),
reader -> () -> reader.lines()
.parallel()
.mapToInt(word -> {
char[] chars = word.toCharArray();
Arrays.parallelSort(chars);
String key = Arrays.toString(chars);
Collection<String> collection = anagrams.computeIfAbsent(
key, function(ArrayList::new)
);
collection.add(word);
return collection.size();
})
.max()
.orElse(0),
() -> 0
).get();
anagrams.values().stream()
.filter(ana -> ana.size() >= count)
.forEach(System.out::println)
;
}
}

13
Task/Anagrams/Julia/anagrams.julia Normal file
View file

@ -0,0 +1,13 @@
url = "http://www.puzzlers.org/pub/wordlists/unixdict.txt"
wordlist = map!(chomp,(open(readlines, download(url)))) ;
function anagram(wordlist)
hash = Dict() ; ananum = 0
for word in wordlist
sorted = CharString(sort(collect(word.data)))
hash[sorted] = [ get(hash, sorted, {}), word ]
ananum = max(length(hash[sorted]), ananum)
end
collect(values(filter((x,y)-> length(y) == ananum, hash)))
end

60
Task/Anagrams/NetRexx/anagrams-1.netrexx Normal file
View file

@ -0,0 +1,60 @@
/* NetRexx */
options replace format comments java crossref symbols nobinary
class RAnagramsV01 public
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method runSample(arg) public signals MalformedURLException, IOException
parse arg localFile .
isr = Reader
if localFile = '' then do
durl = URL("http://www.puzzlers.org/pub/wordlists/unixdict.txt")
dictFrom = durl.toString()
isr = InputStreamReader(durl.openStream())
end
else do
dictFrom = localFile
isr = FileReader(localFile)
end
say 'Searching' dictFrom 'for anagrams'
dictionaryReader = BufferedReader(isr)
anagrams = Map HashMap()
aWord = String
count = 0
loop label w_ forever
aWord = dictionaryReader.readLine()
if aWord = null then leave w_
chars = aWord.toCharArray()
Arrays.sort(chars)
key = String(chars)
if (\anagrams.containsKey(key)) then do
anagrams.put(key, ArrayList())
end
(ArrayList anagrams.get(key)).add(Object aWord)
count = Math.max(count, (ArrayList anagrams.get(key)).size())
end w_
dictionaryReader.close
ani = anagrams.values().iterator()
loop label a_ while ani.hasNext()
ana = ani.next()
if (ArrayList ana).size() >= count then do
say ana
end
end a_
return
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method main(args = String[]) public static
arg = Rexx(args)
Do
ra = RAnagramsV01()
ra.runSample(arg)
Catch ex = Exception
ex.printStackTrace()
End
return

57
Task/Anagrams/NetRexx/anagrams-2.netrexx Normal file
View file

@ -0,0 +1,57 @@
/* NetRexx */
options replace format comments java crossref symbols nobinary
runSample(arg)
return
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method findMostAnagrams(arg) public static signals MalformedURLException, IOException
parse arg localFile .
isr = Reader
if localFile = '' then do
durl = URL("http://www.puzzlers.org/pub/wordlists/unixdict.txt")
dictFrom = durl.toString()
isr = InputStreamReader(durl.openStream())
end
else do
dictFrom = localFile
isr = FileReader(localFile)
end
say 'Searching' dictFrom 'for anagrams'
dictionaryReader = BufferedReader(isr)
anagrams = 0
maxWords = 0
loop label w_ forever
aWord = dictionaryReader.readLine()
if aWord = null then leave w_
chars = aWord.toCharArray()
Arrays.sort(chars)
key = Rexx(chars)
parse anagrams[key] count aWords
aWords = (aWords aWord).space()
maxWords = maxWords.max(aWords.words())
anagrams[key] = aWords.words() aWords
end w_
dictionaryReader.close
loop key over anagrams
parse anagrams[key] count aWords
if count >= maxWords then
say aWords
else
anagrams[key] = null -- remove unwanted elements from the indexed string
end key
return
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method runSample(arg) public static
Do
findMostAnagrams(arg)
Catch ex = Exception
ex.printStackTrace()
End
Return

39
Task/Anagrams/Objeck/anagrams.objeck Normal file
View file

@ -0,0 +1,39 @@
use HTTP;
use Collection;
class Anagrams {
function : Main(args : String[]) ~ Nil {
lines := HttpClient->New()->Get("http://www.puzzlers.org/pub/wordlists/unixdict.txt");
if(lines->Size() = 1) {
line := lines->Get(0)->As(String);
words := line->Split("\n");
anagrams := StringMap->New();
words->Size()->PrintLine();
each(i : words) {
word := words[i]->Trim();
key := String->New(word->ToCharArray()->Sort());
list := anagrams->Find(key)->As(Vector);
if(list = Nil) {
list := Vector->New();
anagrams->Insert(key, list);
};
list->AddBack(word);
};
lists := anagrams->GetValues();
each(i : lists) {
list := lists->Get(i)->As(Vector);
if(list->Size() > 1) {
'['->Print();
each(j : list) {
list->Get(j)->As(String)->Print();
if(j + 1 < list->Size()) {
','->Print();
};
};
']'->PrintLine();
};
};
};
}
}

16
Task/Anagrams/Perl-6/anagrams-2.pl6
View file

@ -1,9 +1,7 @@
slurp('unixdict.txt')\
.words\
.classify( *.comb.sort.join )\
.classify( +*.value )\
.sort( -*.key )[0]\
.value\
.values\
».value\
».say
.say for # print each element of the array made this way:
slurp('unixdict.txt')\ # load file in memory
.words\ # extract words
.classify( *.comb.sort.join )\ # group by common anagram
.classify( *.value.elems )\ # group by number of anagrams in a group
.max( :by(*.key) ).value\ # get the group with highest number of anagrams
».value # get all groups of anagrams in the group just selected

30
Task/Anagrams/REXX/anagrams-1.rexx Normal file
View file

@ -0,0 +1,30 @@
/*REXX program finds words with the largest set of anagrams (same size).*/
iFID='unixdict.txt' /*input file identifier, # words.*/
hc=; !.=; #.=0; w=0; words=0; most=0 /*initialize some REXX variables.*/
/* [↓] read entire file by line.*/
do recs=0 while lines(iFID)\==0 /*Got data? Then read a record.*/
x=space(linein(iFID),0) /*pick off a word from the input.*/
L=length(x); if L<3 then iterate /*onesies and twosies can't win. */
if \datatype(x,'M') then iterate /*filter out nonanagramable words*/
words=words+1 /*count of (useable) words. */
z=sortA(x) /*sort the letters in the word. */
!.z=!.z x; #.z=#.z+1 /*append it to !.z, bump the ctr.*/
if #.z>most then do; hc=z; most=#.z; if L>w then w=L; iterate; end
if #.z==most then hc=hc z /*append sorted word─►max anagram*/
end /*recs*/ /*hc◄─list of high count anagrams.*/
say '──────────────────────────────' recs 'words in the dictionary file: ' iFID
say
do m=1 for words(hc); z=subword(hc,m,1) /*high count anagrams*/
say ' ' left(subword(!.z,1,1),w) ' [anagrams: ' subword(!.z,2)"]"
end /*m*/ /* W is the maximum width word. */
say
say '───── Found' words(hc) "words (each of which have" #.z-1 'anagrams).'
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────SORTA subroutine────────────────────*/
sortA: procedure; arg char +1 xx _. /*get 1st letter of arg, _.=null.*/
_.char=char /*no need to concatenate 1st char*/
/*[↓] put letters alphabetically.*/
do length(xx); parse var xx char +1 xx; _.char=_.char||char; end
/*reassemble word, sorted letters*/
return _.a||_.b||_.c||_.d||_.e||_.f||_.g||_.h||_.i||_.j||_.k||_.l||_.m||,
_.n||_.o||_.p||_.q||_.r||_.s||_.t||_.u||_.v||_.w||_.x||_.y||_.z

28
Task/Anagrams/REXX/anagrams-2.rexx Normal file
View file

@ -0,0 +1,28 @@
/*REXX program finds words with the largest set of anagrams (same size).*/
iFID='unixdict.txt' /*input file identifier, # words.*/
hc=; !.=; #.=0; w=0; words=0; most=0 /*initialize some REXX variables.*/
/* [↓] read entire file by line.*/
do recs=0 while lines(iFID)\==0 /*Got data? Then read a record.*/
x=space(linein(iFID),0) /*pick off a word from the input.*/
L=length(x); if L<3 then iterate /*onesies and twosies can't win. */
if \datatype(x,'M') then iterate /*filter out nonanagramable words*/
words=words+1 /*count of (useable) words. */
parse upper var x y +1 u _. /*get uppercase X & nullify "_." */
xx='?'y; _.xx=y /*get 1st letter (special case).*/
/*[↓] put letters alphabetically.*/
do length(u); parse var u y +1 u; xx='?'y; _.xx=_.xx||y; end
/*reassemble word, sorted letters*/
z=_.?a||_.?b||_.?c||_.?d||_.?e||_.?f||_.?g||_.?h||_.?i||_.?j||_.?k||_.?l||_.?m||,
_.?n||_.?o||_.?p||_.?q||_.?r||_.?s||_.?t||_.?u||_.?v||_.?w||_.?x||_.?y||_.?z
!.z=!.z x; #.z=#.z+1 /*append it to !.z, bump the ctr.*/
if #.z>most then do; hc=z; most=#.z; if L>w then w=L; iterate; end
if #.z==most then hc=hc z /*append sorted word─►hc anagrams*/
end /*recs*/ /*hc◄─list of high count anagrams*/
say '──────────────────────────────' recs 'words in the dictionary file: ' iFID
say
do m=1 for words(hc); z=subword(hc,m,1) /*high count anagrams*/
say ' ' left(subword(!.z,1,1),w) ' [anagrams: ' subword(!.z,2)"]"
end /*m*/ /* W is the maximum width word. */
say
say '───── Found' words(hc) "words (each of which have" #.z-1 'anagrams).'
/*stick a fork in it, we're done.*/

28
Task/Anagrams/REXX/anagrams-3.rexx Normal file
View file

@ -0,0 +1,28 @@
/*REXX program finds words with the largest set of anagrams (same size).*/
iFID='unixdict.txt' /*input file identifier, # words.*/
hc=; !.=; #.=0; ww=0; words=0; most=0 /*initialize some REXX variables.*/
/* [↓] read entire file by line.*/
do recs=0 while lines(iFID)\==0 /*Got data? Then read a record.*/
@=space(linein(iFID),0) /*pick off a word from the input.*/
LL=length(@); if LL<3 then iterate /*onesies and twosies can't win. */
if \datatype(@,'M') then iterate /*exclude non-anagramable words. */
words=words+1 /*count of (useable) words. */
parse upper var @ _ +1 xx _. /*get uppercase @ & nullify "_." */
_._=_ /*get 1st letter (special case).*/
/*[↓] put letters alphabetically.*/
do LL-1; parse var xx _ +1 xx; _._=_._||_; end /*rest of word.*/
/*reassemble word, sorted letters*/
zz=_.a||_.b||_.c||_.d||_.e||_.f||_.g||_.h||_.i||_.j||_.k||_.l||_.m||,
_.n||_.o||_.p||_.q||_.r||_.s||_.t||_.u||_.v||_.w||_.x||_.y||_.z
!.zz=!.zz @; #.zz=#.zz+1 /*append it to !.zz, bump the ctr.*/
if #.zz>most then do; hc=zz; most=#.zz; if LL>ww then ww=LL; iterate; end
if #.zz==most then hc=hc zz /*append sorted word─►hc anagrams*/
end /*recs*/ /*this loop can't have 1-letter vars.*/
say '──────────────────────────────' recs 'words in the dictionary file: ' iFID
say
do m=1 for words(hc); z=subword(hc,m,1) /*high count anagrams*/
say ' ' left(subword(!.z,1,1),ww) ' [anagrams: ' subword(!.z,2)"]"
end /*m*/ /* WW is the maximum width word. */
say
say '───── Found' words(hc) "words (each of which have" #.z-1 'anagrams).'
/*stick a fork in it, we're done.*/

23
Task/Anagrams/REXX/anagrams-4.rexx Normal file
View file

@ -0,0 +1,23 @@
u='Halloween' /*the word to be sorted by letter*/
upper u /*fast method to uppercase a var.*/
/*another: u = translate(u) */
/*another: parse upper var u u */
/*another: u = upper(u) */
/*not always available [↑] */
say 'u=' u
_.=
do until u=='' /*keep truckin' until U is null.*/
parse var u y +1 u /*get the next (first) char in U.*/
xx = '?'y /*assign a prefixed char to XX. */
_.xx = _.xx || y /*append it to all the Y chars.*/
end /*until*/ /*U now has the first char gone.*/
/*Note: the var U is destroyed.*/
/* [↓] build sorted letter word. */
z=_.?a||_.?b||_.?c||_.?d||_.?e||_.?f||_.?g||_.?h||_.?i||_.?j||_.?k||_.?l||_.?m||,
_.?n||_.?o||_.?p||_.?q||_.?r||_.?s||_.?t||_.?u||_.?v||_.?w||_.?x||_.?y||_.?z
/*Note: the ? is prefixed to the letter to avoid */
/*collisions with other REXX one-character variables.*/
say 'z=' z

18
Task/Anagrams/REXX/anagrams-5.rexx Normal file
View file

@ -0,0 +1,18 @@
u='Halloween' /*the word to be sorted by letter*/
upper u /*fast method to uppercase a var.*/
L=length(u) /*get the length of the word. */
say 'u=' u
say 'L=' L
_.=
do k=1 for L /*keep truckin' for L chars. */
y = substr(u,k,1) /*get the next character in U. */
xx = '?'y /*assign a prefixed char to XX. */
_.xx = _.xx || y /*append it to all the Y chars.*/
end /*do k*/ /*U now has the first char gone.*/
/* [↓] build sorted letter word. */
z=_.?a||_.?b||_.?c||_.?d||_.?e||_.?f||_.?g||_.?h||_.?i||_.?j||_.?k||_.?l||_.?m||,
_.?n||_.?o||_.?p||_.?q||_.?r||_.?s||_.?t||_.?u||_.?v||_.?w||_.?x||_.?y||_.?z
say 'z=' z

61
Task/Anagrams/REXX/anagrams-6.rexx Normal file
View file

@ -0,0 +1,61 @@
/*REXX program finds words with the largest set of anagrams (same size)
* 07.08.2013 Walter Pachl
* sorta for word compression courtesy Gerard Schildberger,
* modified, however, to obey lowercase
* 10.08.2013 Walter Pachl take care of mixed case dictionary
* following Version 1's method
**********************************************************************/
Parse Value 'A B C D E F G H I J K L M N O P Q R S T U V W X Y Z',
With a b c d e f g h i j k l m n o p q r s t u v w x y z
Call time 'R'
ifid='unixdict.txt' /* input file identifier */
words=0 /* number of usable words */
maxl=0 /* maximum number of anagrams */
wl.='' /* wl.ws words that have ws */
Do ri=1 By 1 While lines(ifid)\==0 /* read each word in file */
word=space(linein(ifid),0) /* pick off a word from the input.*/
If length(word)<3 Then /* onesies and twosies can't win. */
Iterate
If\datatype(word,'M') Then /* not an anagramable word */
Iterate
words=words+1 /* count of (useable) words. */
ws=sorta(word) /* sort the letters in the word. */
wl.ws=wl.ws word /* add word to list of ws */
wln=words(wl.ws) /* number of anagrams with ws */
Select
When wln>maxl Then Do /* a new maximum */
maxl=wln /* use this */
wsl=ws /* list of resulting ws values */
End
When wln=maxl Then /* same as the one found */
wsl=wsl ws /* add ws to the list */
Otherwise /* shorter */
Nop /* not yet of interest */
End
End
Say ' '
Say copies('-',10) ri-1 'words in the dictionary file: ' ifid
Say copies(' ',10) words 'thereof are anagram candidates'
Say ' '
Say 'There are' words(wsl) 'set(s) of anagrams with' maxl,
'elements each:'
Say ' '
Do while wsl<>''
Parse Var wsl ws wsl
Say ' 'wl.ws
End
Say time('E')
Exit
sorta:
/**********************************************************************
* sort the characters in word_p (lowercase translated to uppercase)
* 'chARa' -> 'AACHR'
**********************************************************************/
Parse Upper Arg word_p
c.=''
Do While word_p>''
Parse Var word_p cc +1 word_p
c.cc=c.cc||cc
End
Return c.a||c.b||c.c||c.d||c.e||c.f||c.g||c.h||c.i||c.j||c.k||c.l||,
c.m||c.n||c.o||c.p||c.q||c.r||c.s||c.t||c.u||c.v||c.w||c.x||c.y||c.z