Rosetta Code

Anagrams: Difference between revisions

Page Discussion

Anagrams (view source)

Revision as of 17:19, 11 April 2024

75 bytes added ,  1 month ago
m
Replace deprecated function
m (Replace deprecated function)
(17 intermediate revisions by 9 users not shown)
Line 866:
alger|glare|lager|large|regal
caret|carte|cater|crate|trace
</pre>
 
=={{header|Amazing Hopper}}==
<syntaxhighlight lang="c">
#include <basico.h>
 
#define MAX_LINE 30
 
algoritmo
fd=0, filas=0
word={}, 2da columna={}
old_word="",new_word=""
dimensionar (1,2) matriz de cadenas 'result'
pos=0
token.separador'""'
 
abrir para leer("basica/unixdict.txt",fd)
 
iterar mientras ' no es fin de archivo (fd) '
usando 'MAX_LINE', leer línea desde(fd),
---copiar en 'old_word'---, separar para 'word '
word, ---retener--- ordenar esto,
encadenar en 'new_word'
 
matriz.buscar en tabla (1,new_word,result)
copiar en 'pos'
si ' es negativo? '
new_word,old_word, pegar fila en 'result'
sino
#( result[pos,2] = cat(result[pos,2],cat(",",old_word) ) )
fin si
 
reiterar
 
cerrar archivo(fd)
guardar 'filas de (result)' en 'filas'
#( 2da columna = result[2:filas, 2] )
fijar separador '","'
tomar '2da columna'
contar tokens en '2da columna' ---retener resultado,
obtener máximo valor,es mayor o igual?, replicar esto
compactar esto
 
fijar separador 'NL', luego imprime todo
terminar
</syntaxhighlight>
{{out}}
<pre>
abel,able,bale,bela,elba
alger,glare,lager,large,regal
angel,angle,galen,glean,lange
caret,carte,cater,crate,trace
elan,lane,lean,lena,neal
evil,levi,live,veil,vile
</pre>
 
Line 916 ⟶ 974:
 
=={{header|AppleScript}}==
<syntaxhighlight lang="applescript">use AppleScript version "2.3.1" -- OS X 10.9 (Mavericks) or later.
 
use sorter : script ¬
<syntaxhighlight lang="applescript">use AppleScript version "2.3.1" -- OS X 10.9 (Mavericks) or later — for these 'use' commands!
"Custom Iterative Ternary Merge Sort" -- <www.macscripter.net/t/timsort-and-nigsort/71383/3>
-- Uses the customisable AppleScript-coded sort shown at <https://macscripter.net/viewtopic.php?pid=194430#p194430>.
-- It's assumed scripters will know how and where to install it as a library.
use sorter : script "Custom Iterative Ternary Merge Sort"
use scripting additions
 
on join(lst, delim)
set astid to AppleScript's text item delimiters
set AppleScript's text item delimiters to delim
set txt to lst as text
set AppleScript's text item delimiters to astid
return txt
end join
 
on largestAnagramGroups(listOfWords)
script o
property wordList : listOfWords
property doctoredWordsgroupingTexts : {}wordList's items
property longestRangeslargestGroupSize : {}0
property outputlargestGroupRanges : {}
on judgeGroup(i, j)
set groupSize to j - i + 1
if (groupSize < largestGroupSize) then -- Most likely.
else if (groupSize = largestGroupSize) then -- Next most likely.
set end of largestGroupRanges to {i, j}
else -- Largest group so far.
set largestGroupRanges to {{i, j}}
set largestGroupSize to groupSize
end if
end judgeGroup
on isGreater(a, b)
return a's beginning > b's beginning
end isGreater
end script
set wordCount to (count o's wordList)
ignoring case
-- BuildReplace anotherthe listwords containing doctored versions ofin the inputgroupingTexts wordslist with theirsorted-character characters lexically sortedversions.
setrepeat astidwith toi AppleScript'sfrom text1 itemto delimiterswordCount
set AppleScriptchrs to o's textgroupingTexts's item delimiters toi's ""characters
tell sorter to sort(chrs, 1, -1, {})
repeat with thisWord in o's wordList
set theseCharso's to thisWordgroupingTexts's charactersitem i to join(chrs, "")
-- A straight ascending in-place sort here.
tell sorter to sort(theseChars, 1, -1, {}) -- Params: (list, start index, end index, customisation spec.).
set end of o's doctoredWords to theseChars as text
end repeat
-- Sort the list to group its contents and echo the moves in the original word list.
set AppleScript's text item delimiters to astid
tell sorter to sort(o's groupingTexts, 1, wordCount, {slave:{o's wordList}})
-- Sort the list of doctored words to group them, rearranging the original-word list in parallel.
tell sorter to sort(o's doctoredWords, 1, -1, {slave:{o's wordList}})
-- Find the list range(s) of the longest run(s) of equal grouping texts in the doctored-word list.
set longestRunLength to 1
set i to 1
set currentText to beginning of o's doctoredWordsgroupingTexts
repeat with j from 2 to (count o's doctoredWords)wordCount
set thisText to item j of o's doctoredWordsgroupingTexts's item j
if (thisText is not currentText) then
settell thisRunLengtho to judgeGroup(i, j - i1)
if (thisRunLength > longestRunLength) then
set o's longestRanges to {{i, j - 1}}
set longestRunLength to thisRunLength
else if (thisRunLength = longestRunLength) then
set end of o's longestRanges to {i, j - 1}
end if
set currentText to thisText
set i to j
end if
end repeat
set finalRunLength toif (j -> i) +then 1tell o to judgeGroup(i, j)
if (finalRunLength > longestRunLength) then
set o's longestRanges to {{i, j}}
else if (finalRunLength = longestRunLength) then
set end of o's longestRanges to {i, j}
end if
-- GetExtract the group(s) of words occupying the same range(s) in the original- word list.
set output to {}
-- The stable parallel sort above will have kept each group's words in the same order with respect to each other.
repeat with thisRange in o's longestRangeslargestGroupRanges
set {i, j} to thisRange
set-- endAdd ofthis o's outputgroup to itemsthe i thru j of o's wordListoutput.
set thisGroup to o's wordList's items i thru j
tell sorter to sort(thisGroup, 1, -1, {}) -- Not necessary with unixdict.txt. But hey.
set end of output to thisGroup
end repeat
-- As a final flourish, sort the list of groups byon their first items.
tell sorter to sort(output, 1, -1, {comparer:o})
script byFirstItem
on isGreater(a, b)
return (a's beginning > b's beginning)
end isGreater
end script
tell sorter to sort(o's output, 1, -1, {comparer:byFirstItem})
end ignoring
return o's output
end largestAnagramGroups
 
-- The closing values of AppleScript 'run handler' variables not explicity declared local are
-- saved back to the script file afterwards — and "unixdict.txt" contains 25,104 words!
local wordFile, wordList
set wordFile to ((path to desktop as text) & "www.rosettacode.org:unixdict.txt") as «class furl»
-- The words in "unixdict.txt" are arranged one per line in alphabetical order.
-- Some contain punctuation characters, so they're best extracted as 'paragraphs' rather than as 'words'.
set wordFile to ((path to desktop as text) & "unixdict.txt") as «class furl»
set wordList to paragraphs of (read wordFile as «class utf8»)
return largestAnagramGroups(wordList)</syntaxhighlight>
Line 1,001 ⟶ 1,058:
{{output}}
<syntaxhighlight lang="applescript">{{"abel", "able", "bale", "bela", "elba"}, {"alger", "glare", "lager", "large", "regal"}, {"angel", "angle", "galen", "glean", "lange"}, {"caret", "carte", "cater", "crate", "trace"}, {"elan", "lane", "lean", "lena", "neal"}, {"evil", "levi", "live", "veil", "vile"}}</syntaxhighlight>
 
=={{header|ARM Assembly}}==
{{works with|as|Raspberry Pi <br> or android 32 bits with application Termux}}
Line 1,492 ⟶ 1,550:
}</syntaxhighlight>
 
=={{header|BaConBASIC}}==
==={{header|BaCon}}===
<syntaxhighlight lang="freebasic">OPTION COLLAPSE TRUE
 
Line 1,525 ⟶ 1,584:
</pre>
 
==={{header|BBC BASIC}}===
{{works with|BBC BASIC for Windows}}
<syntaxhighlight lang="bbcbasic"> INSTALL @lib$+"SORTLIB"
Line 3,146 ⟶ 3,205:
 
=={{header|Elena}}==
ELENA 56.0x:
<syntaxhighlight lang="elena">import system'routines;
import system'calendar;
Line 3,154 ⟶ 3,213:
import extensions'routines;
import extensions'text;
import algorithms;
 
extension op
Line 3,167 ⟶ 3,227:
auto dictionary := new Map<string,object>();
 
File.assign("unixdict.txt").forEachLine::(word)
{
var key := word.normalized();
Line 3,177 ⟶ 3,237:
};
item.append:(word)
};
 
dictionary.Values
.sortquickSort::(former,later => former.Item2.Length > later.Item2.Length )
.top:(20)
.forEach::(pair){ console.printLine(pair.Item2) };
var end := now;
Line 3,195 ⟶ 3,255:
{{out}}
<pre>
alger,glare,lager,large,regal
angel,angle,galen,glean,lange
abel,able,bale,bela,elba
alger,glare,lager,large,regal
caret,carte,cater,crate,trace
evil,levi,live,veil,vile
elan,lane,lean,lena,neal
caret,carte,cater,crate,trace
angel,angle,galen,glean,lange
are,ear,era,rae
dare,dear,erda,read
diet,edit,tide,tied
cereus,recuse,rescue,secure
ames,mesa,same,seam
emit,item,mite,time
amen,mane,mean,name
enol,leon,lone,noel
esprit,priest,sprite,stripe
beard,bread,debar,debra
hare,hear,hera,rhea
apt,pat,pta,tap
aden,dane,dean,edna
aires,aries,arise,raise
keats,skate,stake,steak
are,ear,era,rae
lament,mantel,mantle,mental
beard,bread,debar,debra
lascar,rascal,sacral,scalar
cereus,recuse,rescue,secure
latus,sault,talus,tulsa
diet,edit,tide,tied
leap,pale,peal,plea
resin,rinse,risen,siren
</pre>
 
Line 3,993 ⟶ 4,053:
 
=={{header|FutureBasic}}==
Applications in the latest versions of Macintosh OS X 10.x are sandboxed and require setting special permissions to link to internet files. For illustration purposes here, this code uses the internal Unix dictionary file available isin all versions of OS X.
 
This first example is a hybrid using FB's native dynamic global array combined with Core Foundation functions:
<syntaxhighlight lang="futurebasic">
include "NSLog.incl"
Line 4,070 ⟶ 4,129:
</pre>
 
This version fulfils the task description.
This second example is pure Core Foundation:
<pre>
include "ConsoleWindow"
include "Tlbx CFBag.incl"
 
<syntaxhighlight lang="futurebasic">
local fn Dictionary as CFArrayRef
'~'1
dim as CFURLRef      url
dim as CFStringRef   string
dim as Handle        h
dim as long          fileLen
 
begin globals
dim as CFArrayRef sDictionary// static
end globals
 
include "NSLog.incl"
if ( sDictionary == NULL )
url = fn CFURLCreateWithFileSystemPath( _kCFAllocatorDefault, @"/usr/share/dict/words", _kCFURLPOSIXPathStyle, _false )
open "i", 2, url
fileLen = lof(2,1)
h = fn NewHandleClear( fileLen )
if ( h )
read file 2, [h], fileLen
string = fn CFStringCreateWithBytes( _kCFAllocatorDefault, #[h], fn GetHandleSize(h), _kCFStringEncodingMacRoman, _false )
if ( string )
sDictionary = fn CFStringCreateArrayBySeparatingStrings( _kCFAllocatorDefault, string, @"\n" )
CFRelease( string )
end if
fn DisposeH( h )
end if
close #2
CFRelease( url )
end if
end fn = sDictionary
 
#plist NSAppTransportSecurity @{NSAllowsArbitraryLoads:YES}
local fn IsAnagram( wd1 as CFStringRef, wd2 as CFStringRef ) as Boolean
'~'1
dim as CFMutableBagRef   bag1, bag2
dim as CFStringRef       chr1, chr2
dim as CFIndex           length1, length2, i
dim as Boolean           result : result = _false
 
local fn Dictionary as CFArrayRef
length1 = fn CFStringGetLength( wd1 )
CFURLRef url = fn URLWithString( @"http://wiki.puzzlers.org/pub/wordlists/unixdict.txt" )
length2 = fn CFStringGetLength( wd2 )
CFStringRef string = fn StringWithContentsOfURL( url, NSUTF8StringEncoding, NULL )
if ( length1 == length2 )
end fn = fn StringComponentsSeparatedByCharactersInSet( string, fn CharacterSetNewlineSet )
bag1 = fn CFBagCreateMutable( _kCFAllocatorDefault, 0, @kCFCopyStringBagCallBacks )
bag2 = fn CFBagCreateMutable( _kCFAllocatorDefault, 0, @kCFCopyStringBagCallBacks )
 
local fn TestIndexes( array as CFArrayRef, obj as CFTypeRef, index as NSUInteger, stp as ^BOOL, userData as ptr ) as BOOL
for i = 0 to length1 - 1
end fn = fn StringIsEqual( obj, userData )
chr1 = fn CFStringCreateWithSubstring( _kCFAllocatorDefault, wd1, fn CFRangeMake(i,1) )
chr2 = fn CFStringCreateWithSubstring( _kCFAllocatorDefault, wd2, fn CFRangeMake(i,1) )
CFBagAddValue( bag1, chr1 )
CFBagAddValue( bag2, chr2 )
CFRelease( chr1 )
CFRelease( chr2 )
next
 
void local fn IndexSetEnumerator( set as IndexSetRef, index as NSUInteger, stp as ^BOOL, userData as ptr )
result = fn CFEqual( bag1, bag2 )
NSLog(@"\t%@\b",fn ArrayObjectAtIndex( userData, index ))
CFRelease( bag1 )
end fn
CFRelease( bag2 )
end if
end fn = result
 
void local fn FindAnagrams( wd as CFStringRef )DoIt
CFArrayRef words
'~'1
dim as CFMutableArrayRef    words sortedWords, letters
CFStringRef string, sortedString
dim as CFMutableStringRef   wdUC
IndexSetRef indexes
dim as CFLocaleRef          locale
long i, j, count, indexCount, maxCount = 0, length
dim as CFStringRef          string
CFMutableDictionaryRef anagrams
dim as CFIndex              count, index
CFTimeInterval ti
dim as CFArrayRef           dict
ti = fn CACurrentMediaTime
NSLog(@"Searching...")
// create another word list with sorted letters
words = fn Dictionary
count = len(words)
sortedWords = fn MutableArrayWithCapacity(count)
for string in words
length = len(string)
letters = fn MutableArrayWithCapacity(length)
for i = 0 to length - 1
MutableArrayAddObject( letters, mid(string,i,1) )
next
MutableArraySortUsingSelector( letters, @"compare:" )
sortedString = fn ArrayComponentsJoinedByString( letters, @"" )
MutableArrayAddObject( sortedWords, sortedString )
next
// search for identical sorted words
anagrams = fn MutableDictionaryWithCapacity(0)
for i = 0 to count - 2
j = i + 1
indexes = fn ArrayIndexesOfObjectsAtIndexesPassingTest( sortedWords, fn IndexSetWithIndexesInRange( fn CFRangeMake(j,count-j) ), NSEnumerationConcurrent, @fn TestIndexes, (ptr)sortedWords[i] )
indexCount = len(indexes)
if ( indexCount > maxCount )
maxCount = indexCount
MutableDictionaryRemoveAllObjects( anagrams )
end if
if ( indexCount == maxCount )
MutableDictionarySetValueForKey( anagrams, indexes, words[i] )
end if
next
// show results
NSLogClear
for string in anagrams
NSLog(@"%@\b",string)
indexes = anagrams[string]
IndexSetEnumerateIndexes( indexes, @fn IndexSetEnumerator, (ptr)words )
NSLog(@"")
next
NSLog(@"\nCalculated in %0.6fs",fn CACurrentMediaTime - ti)
end fn
 
dispatchglobal
words = fn CFArrayCreateMutable( _kCFAllocatorDefault, 0, @kCFTypeArrayCallBacks )
fn DoIt
dispatchend
 
HandleEvents
wdUC = fn CFStringCreateMutableCopy( _kCFAllocatorDefault, 0, wd )
</syntaxhighlight>
locale = fn CFLocaleCopyCurrent()
CFStringUppercase( wdUC, locale )
CFRelease( locale )
 
{{out}}
string = fn CFStringCreateWithFormat( _kCFAllocatorDefault, NULL, @"Anagrams for %@:", wdUC )
CFRelease( wdUC )
fn ConsolePrintCFString( string )
CFRelease( string )
 
dict = fn Dictionary()
count = fn CFArrayGetCount( dict )
for index = 0 to count - 1
string = fn CFArrayGetValueAtIndex( dict, index )
if ( fn IsAnagram( wd, string ) )
CFArrayAppendValue( words, string )
end if
next
 
string = fn CFStringCreateByCombiningStrings( _kCFAllocatorDefault, words, @", " )
CFRelease( words )
fn ConsolePrintCFString( string )
CFRelease( string )
 
fn ConsolePrintCFString( @"" )
end fn
 
fn FindAnagrams( @"bade" )
fn FindAnagrams( @"abet" )
fn FindAnagrams( @"beast" )
fn FindAnagrams( @"tuba" )
fn FindAnagrams( @"mace" )
fn FindAnagrams( @"scare" )
fn FindAnagrams( @"marine" )
fn FindAnagrams( @"antler")
fn FindAnagrams( @"spare" )
fn FindAnagrams( @"leading" )
fn FindAnagrams( @"alerted" )
fn FindAnagrams( @"allergy" )
fn FindAnagrams( @"research")
fn FindAnagrams( @"hustle" )
fn FindAnagrams( @"oriental")
fn FindAnagrams( @"creationism" )
fn FindAnagrams( @"resistance" )
fn FindAnagrams( @"mountaineer" )
</pre>
Output:
<pre>
alger glare lager large regal
Anagrams for BADE:
caret carte cater crate trace
abed, bade, bead
elan lane lean lena neal
 
abel able bale bela elba
Anagrams for ABET:
evil levi live veil vile
abet, bate, beat, beta
angel angle galen glean lange
 
Anagrams for BEAST:
baste, beast, tabes
 
Anagrams for TUBA:
abut, tabu, tuba
 
Anagrams for MACE:
acme, came, mace
 
Anagrams for SCARE:
carse, caser, ceras, scare, scrae
 
Anagrams for MARINE:
marine, remain
 
Anagrams for ANTLER:
altern, antler, learnt, rental, ternal
 
Anagrams for SPARE:
asper, parse, prase, spaer, spare, spear
 
Anagrams for LEADING:
adeling, dealing, leading
 
Anagrams for ALERTED:
delater, related, treadle
 
Anagrams for ALLERGY:
allergy, gallery, largely, regally
 
Anagrams for RESEARCH:
rechaser, research, searcher
 
Anagrams for HUSTLE:
hustle, sleuth
 
Anagrams for ORIENTAL:
oriental, relation
 
Anagrams for CREATIONISM:
anisometric, creationism, miscreation, ramisection, reactionism
 
Anagrams for RESISTANCE:
resistance, senatrices
 
Calculated in 2.409008s
Anagrams for MOUNTAINEER:
enumeration, mountaineer
</pre>
 
Line 5,361 ⟶ 5,338:
["caret", "carte", "cater", "crate", "trace"],
["abel", "able", "bale", "bela", "elba"]] */</syntaxhighlight>
 
=={{header|MiniScript}}==
This implementation is for use with the [http://miniscript.org/MiniMicro Mini Micro] version of MiniScript. The command-line version does not include a HTTP library. The script can be modified to use the file class to read a local copy of the word list.
<syntaxhighlight lang="miniscript">
wordList = http.get("http://wiki.puzzlers.org/pub/wordlists/unixdict.txt").split(char(10))
 
makeKey = function(word)
return word.split("").sort.join("")
end function
 
wordSets = {}
for word in wordList
k = makeKey(word)
if not wordSets.hasIndex(k) then
wordSets[k] = [word]
else
wordSets[k].push(word)
end if
end for
 
counts = []
 
for wordSet in wordSets.values
counts.push([wordSet.len, wordSet])
end for
counts.sort(0, false)
 
maxCount = counts[0][0]
for count in counts
if count[0] == maxCount then print count[1]
end for
</syntaxhighlight>
{{out}}
<pre>
["abel", "able", "bale", "bela", "elba"]
["alger", "glare", "lager", "large", "regal"]
["angel", "angle", "galen", "glean", "lange"]
["caret", "carte", "cater", "crate", "trace"]
["elan", "lane", "lean", "lena", "neal"]
["evil", "levi", "live", "veil", "vile"]</pre>
 
=={{header|MUMPS}}==
Line 8,151 ⟶ 8,169:
var integer: maxLength is 0;
begin
dictFile := openStrifileopenStriFile(getHttp("wiki.puzzlers.org/pub/wordlists/unixdict.txt"));
while hasNext(dictFile) do
readln(dictFile, word);
Line 8,762 ⟶ 8,780:
 
=={{header|Transd}}==
Works with Transd v0.43.
 
<syntaxhighlight lang="scheme">#lang transd
Line 8,769 ⟶ 8,786:
_start: (λ
(with fs FileStream() words String()
(open-r fs "/mnt/proj/tmp/unixdict.txt")
(textin fs words)
( -|
Line 9,320 ⟶ 9,337:
</PRE>
 
=={{header|V (Vlang)}}==
{{trans|Wren}}
<syntaxhighlight lang="v (vlang)">import os
 
fn main(){
Line 9,361 ⟶ 9,378:
=={{header|Wren}}==
{{libheader|Wren-sort}}
<syntaxhighlight lang="ecmascriptwren">import "io" for File
import "./sort" for Sort
 
var words = File.read("unixdict.txt").split("\n").map { |w| w.trim() }
Thomas mertes
29

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/330396...363466"