Anagrams: Difference between revisions

m
→‎{{header|AppleScript}}: Cosmetic makeover.
m (→‎{{header|AppleScript}}: Cosmetic makeover.)
Line 518:
 
<lang applescript>use AppleScript version "2.3.1" -- OS X 10.9 (Mavericks) or later — for these 'use' commands!
-- ThisUses script uses athe customisable AppleScript-coded sort availableshown at <https://macscripter.net/viewtopic.php?pid=194430#p194430>.
-- It's assumed that scripters will know how and where to install it as a library.
use sorter : script "Custom Iterative Ternary Merge Sort"
use scripting additions
 
on anagramsTask()
-- A local "owner" for the long AppleScript lists. Speeds up references to their items and properties.
script o
property wordList : paragraphsmissing of (read (((path to desktop as text) & "unixdict.txt") as «class furl») as «class utf8»)value
property doctoredWords : {}
property longestRanges : {}
property resultListoutput : {}
end script
-- The words in "unixdict.txt" are in alphabetical order, one per line.
(* Since we're matching given words rather than trying to solve anagrams per se, we can simply sort the words' characters lexically and see how many of the results are the same. *)
-- Some contain punctuation characters, so they're best extracted as 'paragraphs' rather than as 'words'.
set wordFile to ((path to desktop as text) & "www.rosettacode.org:unixdict.txt") as «class furl»
set wordCount to (count o's wordList)
set o's wordList to paragraphs of (read wordFile as «class utf8»)
ignoring case -- This is the default, and the words are all the same case anyway, but just in … er … case.
ignoring case
-- Build another list containing doctored versions of the same words with their characters lexically sorted.
set astid to AppleScript's text item delimiters
set AppleScript's text item delimiters to ""
repeat with ithisWord fromin 1o's to wordCountwordList
set theseCharacterstheseChars to characters of item i of othisWord's wordListcharacters
-- A straight ascending in-place sort here.
tell sorter to sort(theseCharacters, 1, -1, {}) -- Straight sort of items 1 thru -1 of theseCharacters.
tell sorter to sort(theseChars, 1, -1, {}) -- Params: (list, start index, end index, customisation spec.).
set end of o's doctoredWords to theseCharacterstheseChars as text
end repeat
set AppleScript's text item delimiters to astid
-- Sort the list of doctored words to group them, rearranging the original -word list too to maintain thein correspondenceparallel.
tell sorter to sort(o's doctoredWords, 1, -1, {slave:{o's wordList}})
-- Find the list range(s) of the longest run(s) of identicalequal texts in the doctored-word wordslist.
set currentDoctoredWord to beginning of o's doctoredWords
set longestRunLength to 1
set i to 1
repeatset withcurrentText jto frombeginning 2of too's wordCountdoctoredWords
repeat with j from set thisDoctoredWord2 to item j of(count o's doctoredWords)
ifset (thisDoctoredWordthisText isto notitem currentDoctoredWord)j thenof o's doctoredWords
if (thisText is not currentText) then
set thisRunLength to j - i
if (thisRunLength > longestRunLength) then
Line 563 ⟶ 564:
set end of o's longestRanges to {i, j - 1}
end if
set currentDoctoredWordcurrentText to thisDoctoredWordthisText
set i to j
end if
end repeat
--set (CompletefinalRunLength theto analysisj of the last run- ini the+ list.)1
setif thisRunLength(finalRunLength to> jlongestRunLength) - i + 1then
if (thisRunLength > longestRunLength) then
set o's longestRanges to {{i, j}}
else if (thisRunLengthfinalRunLength = longestRunLength) then
set end of o's longestRanges to {i, j}
end if
-- Get the originalgroup(s) of words occupying the same range(s) in theirthe original-word list.
-- The stable parallel sort above will have kept each group's words in alphabetical order.
setrepeat {i,with j}thisRange to item i ofin o's longestRanges
set {i, j} to thisRange
set end of o's resultListoutput to items i thru j of o's wordList
end repeat
-- As a final flourish, arrangesort the groupslist inof ordergroups ofby their first wordsitems.
end script byFirstItem
on isGreater(a, b)
return (a's beginning > b's beginning)
end isGreater
end script
tell sorter to sort(o's resultListoutput, 1, -1, {comparer:byFirstItem})
end ignoring
return o's resultListoutput
-- Get the original words occupying the same range(s) in their list.
repeat with i from 1 to (count o's longestRanges)
set {i, j} to item i of o's longestRanges
set end of o's resultList to items i thru j of o's wordList
end repeat
-- The downloaded word list arrived lexically sorted and the stable sorting above has left each group of matching original words still in order internally.
-- As a final flourish, arrange the groups in order of their first words.
script byFirstItem -- Custom comparer for the sort. Compares the first items of lists.
on isGreater(a, b)
return (a's beginning > b's beginning)
end isGreater
end script
tell sorter to sort(o's resultList, 1, -1, {comparer:byFirstItem})
return o's resultList
end anagramsTask
 
Line 597:
 
{{output}}
<prelang 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"}}</prelang>
 
=={{header|AutoHotkey}}==
557

edits