Anadromes: Difference between revisions
SqrtNegInf (talk | contribs) m (→{{header|Perl}}: a little simpler) |
(Add Seed7) |
||
Line 215: | Line 215: | ||
revotes ↔ setover |
revotes ↔ setover |
||
sallets ↔ stellas</pre> |
sallets ↔ stellas</pre> |
||
=={{header|Seed7}}== |
|||
<lang seed7>$ include "seed7_05.s7i"; |
|||
const func boolean: binarySearch (in array string: haystack, in string: needle) is func |
|||
result |
|||
var boolean: result is FALSE; |
|||
local |
|||
var integer: low is 1; |
|||
var integer: high is -1; |
|||
var integer: middle is -1; |
|||
begin |
|||
high := length(haystack); |
|||
while result = FALSE and low <= high do |
|||
middle := low + (high - low) div 2; |
|||
if needle < haystack[middle] then |
|||
high := pred(middle); |
|||
elsif needle > haystack[middle] then |
|||
low := succ(middle); |
|||
else |
|||
result := TRUE; |
|||
end if; |
|||
end while; |
|||
end func; |
|||
const proc: main is func |
|||
local |
|||
var file: dictionary is STD_NULL; |
|||
var string: word is ""; |
|||
var string: reversed is ""; |
|||
var array string: words is (array string).value; |
|||
begin |
|||
dictionary := open("words.txt", "r"); |
|||
while not eof(dictionary) do |
|||
readln(dictionary, word); |
|||
words &:= word; |
|||
end while; |
|||
close(dictionary); |
|||
words := sort(words); |
|||
for word range words do |
|||
reversed := reverse(word); |
|||
if length(word) > 6 and word < reversed and binarySearch(words, reversed) then |
|||
writeln(word <& " <-> " <& reversed); |
|||
end if; |
|||
end for; |
|||
end func;</lang> |
|||
{{out}} |
|||
<pre> |
|||
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 |
|||
</pre> |
|||
=={{header|Wren}}== |
=={{header|Wren}}== |
Revision as of 21:33, 24 June 2022
An anadrome is similar to a palindrome except, rather than spelling the same word or phrase when reversed, it spells a different word or phrase. An anadrome is a special case of an anagram.
Anadrome is a portmanteau of the words anagram and palindrome.
For instance, regal and lager are anadromes.
- Task
Using the words.txt file from https://github.com/dwyl/english-words, find and display all of the anadrome pairs with more than 6 characters.
Each word pair should only show up one time in the list.
Factor
<lang factor>USING: assocs grouping hash-sets io.encodings.ascii io.files kernel math prettyprint sequences sets sets.extras ;
"words.txt" ascii file-lines [ length 6 > ] filter dup >hash-set '[ reverse _ in? ] filter [ reverse ] zip-with [ all-equal? ] reject [ fast-set ] unique-by .</lang>
- Output:
{ { "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" } }
Julia
<lang ruby>function anadromes(minsize, csense = true, fname = "words.txt")
words = Set(filter(w -> length(w) >= minsize, split((csense ? identity : lowercase)(read(fname, String)), r"\s+"))) found = [(w, reverse(w)) for w in words if (r = reverse(w)) in words && w < r] println("Total $(length(found)) case $(csense ? "" : in)sensitive anadrome pairs found.") foreach(a -> println(a[1], " <=> ", a[2]), sort!(found))
end
anadromes(7) anadromes(7, false)
</lang>
- Output:
Total 17 case sensitive anadrome pairs found. 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 Total 32 case insensitive anadrome pairs found. amaroid <=> diorama anacara <=> aracana annabal <=> labanna artamus <=> sumatra colbert <=> trebloc degener <=> reneged deifier <=> reified delbert <=> trebled delevan <=> naveled deliver <=> reviled dessert <=> tressed desserts <=> stressed deviler <=> relived dioramas <=> samaroid eimmart <=> trammie emmeram <=> maremme gateman <=> nametag latimer <=> remital lattimer <=> remittal lessees <=> seessel leveler <=> relevel nicolaus <=> sualocin pat-pat <=> tap-tap redrawer <=> rewarder reknits <=> stinker relever <=> reveler reliver <=> reviler revotes <=> setover rotanev <=> venator roygbiv <=> vibgyor sallets <=> stellas sennits <=> stinnes
Perl
<lang perl>use strict; use warnings;
my(%W,%A); for my $w ( grep { /[A-z\-]{7,}/ } split "\n", do { local( @ARGV, $/ ) = ( 'words.txt' ); <> } ) {
my $r = reverse $w; if ($W{$r}) { $A{$r} = sprintf "%10s ↔ %s\n", $r, $w } else { $W{$w} = $w }
}
print $A{$_} for sort keys %A;</lang>
- Output:
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
Phix
with javascript_semantics integer m = iff(platform()=JS?5:7) sequence words = unique(unix_dict(m,`words.txt`)) function anadrome(string w) return w<reverse(w) and binary_search(reverse(w),words)>0 end function sequence r = sort(filter(words,anadrome)), s = columnize({r,apply(r,reverse)}), t = join(s,"\n",fmt:="%8s <=> %-8s") printf(1,"Found %d anadromes:\n%s\n",{length(r),t})
- Output:
On the desktop:
Found 17 anadromes: 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
Under p2js, aka in a browser, from where it cannot realistically read disk files, unix_dict() ignores the filename parameter and uses the smaller unixdict.txt, as by now quite some time ago converted into a dirty great big Phix sequence constant and then transpiled into a JavaScript Array, for which we also drop the minimum length to 5, and get:
Found 5 anadromes: damon <=> nomad kramer <=> remark lager <=> regal leper <=> repel lever <=> revel
Raku
<lang perl6>my @words = 'words.txt'.IO.slurp.words.grep: *.chars > 6;
my %words = @words.pairs.invert;
put join "\n", @words.map: { %words{$_}:delete and sprintf "%10s ↔ %s", $_, .flip if ($_ ne .flip) && %words{.flip} }</lang>
- Output:
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
Seed7
<lang seed7>$ include "seed7_05.s7i";
const func boolean: binarySearch (in array string: haystack, in string: needle) is func
result var boolean: result is FALSE; local var integer: low is 1; var integer: high is -1; var integer: middle is -1; begin high := length(haystack); while result = FALSE and low <= high do middle := low + (high - low) div 2; if needle < haystack[middle] then high := pred(middle); elsif needle > haystack[middle] then low := succ(middle); else result := TRUE; end if; end while; end func;
const proc: main is func
local var file: dictionary is STD_NULL; var string: word is ""; var string: reversed is ""; var array string: words is (array string).value; begin dictionary := open("words.txt", "r"); while not eof(dictionary) do readln(dictionary, word); words &:= word; end while; close(dictionary); words := sort(words); for word range words do reversed := reverse(word); if length(word) > 6 and word < reversed and binarySearch(words, reversed) then writeln(word <& " <-> " <& reversed); end if; end for; end func;</lang>
- Output:
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
Wren
<lang ecmascript>import "io" for File import "./sort" for Sort, Find import "./fmt" for Fmt
var wordList = "words.txt" // local copy var words = File.read(wordList)
.trimEnd() .split("\n") .where { |word| word.count > 6 } .toList
Sort.quick(words) // need strict lexicographical order to use binary search var anadromes = [] for (word in words) {
var word2 = word[-1..0] if (word != word2 && !anadromes.contains(word2) && Find.first(words, word2) >= 0) { anadromes.add(word) }
} System.print("The anadrome pairs with more than 6 letters are:") for (ana in anadromes) Fmt.print("$8s <-> $8s", ana, ana[-1..0])</lang>
- Output:
The anadrome pairs with more than 6 letters are: 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