Semordnilap: Difference between revisions
Keithpinson (talk | contribs) |
→{{header|Uiua}}: Improved algorithm |
||
(189 intermediate revisions by 75 users not shown) | |||
Line 1: | Line 1: | ||
{{task |
{{task}} |
||
A [http://en.wikipedia.org/wiki/Semordnilap#Semordnilaps semordnilap], is a word (or phrase) that spells a different word (or phrase) backward. "Semordnilap" is a word that itself is a semordnilap. |
|||
A [https://en.wiktionary.org/wiki/semordnilap#Noun semordnilap] is a word (or phrase) that spells a different word (or phrase) backward. "Semordnilap" is a word that itself is a semordnilap. |
|||
Example: <code>''lager'' and ''regal''</code> |
|||
Example: ''lager'' and ''regal'' |
|||
Using only words from the [http://www.puzzlers.org/pub/wordlists/unixdict.txt unixdict], report the total number of unique semordnilap pairs, and print 5 examples. (Note that lager/regal and regal/lager should be counted as one unique pair.) |
|||
<br><br> |
|||
;Task |
|||
This task does not consider semordnilap phrases, only single words. |
|||
Using only words from <u>[http://wiki.puzzlers.org/pub/wordlists/unixdict.txt this list]</u>, report the total number of unique semordnilap pairs, and print 5 examples. |
|||
Two matching semordnilaps, such as ''lager'' and ''regal'', should be counted as one unique pair. |
|||
(Note that the word "semordnilap" is not in the above dictionary.) |
|||
{{Template:Strings}} |
|||
<br><br> |
|||
=={{header|11l}}== |
|||
{{trans|Python}} |
|||
<syntaxhighlight lang="11l">V wordset = Set(File(‘unixdict.txt’).read().split("\n")) |
|||
V revlist = wordset.map(word -> reversed(word)) |
|||
V pairs = Set(zip(wordset, revlist).filter((wrd, rev) -> wrd < rev & rev C :wordset)) |
|||
print(pairs.len) |
|||
print(sorted(Array(pairs), key' p -> (p[0].len, p))[(len)-5..])</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
158 |
|||
[(damon, nomad), (lager, regal), (leper, repel), (lever, revel), (kramer, remark)] |
|||
</pre> |
|||
=={{header|8th}}== |
|||
We're using a map to keep track of what's been seen, and an array to store the results. We load the "unixdict.txt" as an "asset", meaning a file stored alongside the program code: |
|||
<syntaxhighlight lang="forth"> |
|||
[] var, results |
|||
: processline \ m s -- |
|||
clone nip |
|||
tuck s:rev |
|||
m:exists? if |
|||
results @ rot a:push drop |
|||
else |
|||
swap true m:! |
|||
then ; |
|||
{} "unixdict.txt" app:asset >s |
|||
' processline s:eachline |
|||
results @ dup a:len . " pairs" . cr |
|||
a:shuffle |
|||
( a:shift dup . " is the reverse of " . s:rev . cr ) 5 times bye |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
158 pairs |
|||
trap is the reverse of part |
|||
nab is the reverse of ban |
|||
la is the reverse of al |
|||
ta is the reverse of at |
|||
tin is the reverse of nit |
|||
</pre> |
|||
;Cf. |
|||
* [[Palindrome_detection|Palindrome detection]] |
|||
=={{header|Ada}}== |
=={{header|Ada}}== |
||
Before tackling the real problem, we specify a package String_Vectors and a class String_Vectors.Vec, to store the list of words in the dictionary: |
Before tackling the real problem, we specify a package String_Vectors and a class String_Vectors.Vec, to store the list of words in the dictionary: |
||
< |
<syntaxhighlight lang="ada">with Ada.Containers.Indefinite_Vectors, Ada.Text_IO; |
||
package String_Vectors is |
package String_Vectors is |
||
Line 30: | Line 85: | ||
-- checks if Word is in List(Start .. Stop); |
-- checks if Word is in List(Start .. Stop); |
||
-- requirement: the words in List are sorted alphabetically |
-- requirement: the words in List are sorted alphabetically |
||
end String_Vectors;</ |
end String_Vectors;</syntaxhighlight> |
||
The specified class String_Vectors.Vec has been derived from Ada.Containers.Indefinite_Vectors.Vector and provides two additional primitive operations Read and Is_In. Here is the implementation: |
The specified class String_Vectors.Vec has been derived from Ada.Containers.Indefinite_Vectors.Vector and provides two additional primitive operations Read and Is_In. Here is the implementation: |
||
< |
<syntaxhighlight lang="ada">package body String_Vectors is |
||
function Is_In(List: Vec; |
function Is_In(List: Vec; |
||
Line 68: | Line 123: | ||
end Read; |
end Read; |
||
end String_Vectors;</ |
end String_Vectors;</syntaxhighlight> |
||
This is the main program: |
This is the main program: |
||
< |
<syntaxhighlight lang="ada">with String_Vectors, Ada.Text_IO, Ada.Command_Line; |
||
procedure Semordnilap is |
procedure Semordnilap is |
||
Line 101: | Line 156: | ||
Ada.Text_IO.New_Line; |
Ada.Text_IO.New_Line; |
||
Ada.Text_IO.Put("pairs found:" & Integer'Image(Semi_Counter)); |
Ada.Text_IO.Put("pairs found:" & Integer'Image(Semi_Counter)); |
||
end Semordnilap;</ |
end Semordnilap;</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre>>./semordnilap unixdict.txt |
<pre>>./semordnilap unixdict.txt |
||
ca - ac |
ca - ac |
||
Line 115: | Line 169: | ||
=={{header|Aime}}== |
=={{header|Aime}}== |
||
<syntaxhighlight lang="aime">integer p, z; |
|||
<lang aime>text |
|||
record r; |
|||
reverse(text s) |
|||
file f; |
|||
{ |
|||
text s, t; |
|||
data b; |
|||
integer i; |
|||
f.affix("unixdict.txt"); |
|||
i = length(s); |
|||
while (i) { |
|||
i -= 1; |
|||
b_insert(b, -1, character(s, i)); |
|||
} |
|||
p = 0; |
|||
return b_string(b); |
|||
} |
|||
while (f.line(s) != -1) { |
|||
integer |
|||
if (r_o_integer(z, r, t = b_reverse(s))) { |
|||
main(void) |
|||
p += 1; |
|||
{ |
|||
if (p <= 5) { |
|||
o_(s, " ", t, "\n"); |
|||
record r; |
|||
} |
|||
text s; |
|||
f_affix(f, "unixdict.txt"); |
|||
while (f_line(f, s) != -1) { |
|||
r_p_integer(r, s, 0); |
|||
} |
} |
||
r[s] = 0; |
|||
} |
|||
p = 0; |
|||
if (r_first(r, s)) { |
|||
do { |
|||
text t; |
|||
o_form("Semordnilap pairs: ~\n", p);</syntaxhighlight> |
|||
t = reverse(s); |
|||
if (compare(s, t) > 0) { |
|||
if (r_key(r, t)) { |
|||
p += 1; |
|||
if (c < 5) { |
|||
c += 1; |
|||
o_text(s); |
|||
o_byte(' '); |
|||
o_text(t); |
|||
o_byte('\n'); |
|||
} |
|||
} |
|||
} |
|||
} while (r_greater(r, s, s)); |
|||
} |
|||
o_text("Semordnilap pairs: "); |
|||
o_integer(p); |
|||
o_text("\n"); |
|||
return 0; |
|||
}</lang> |
|||
{{out}} |
{{out}} |
||
<pre>ca ac |
<pre>ca ac |
||
Line 180: | Line 197: | ||
drab bard |
drab bard |
||
Semordnilap pairs: 158</pre> |
Semordnilap pairs: 158</pre> |
||
=={{header|ALGOL 68}}== |
|||
{{works with|ALGOL 68G|Any - tested with release 2.8.3.win32}} |
|||
The Algol 68 G "read" PRAGMA is used to include the associative array code from Associative_array/Iteration. |
|||
<syntaxhighlight lang="algol68"># find the semordnilaps in a list of words # |
|||
# use the associative array in the Associate array/iteration task # |
|||
PR read "aArray.a68" PR |
|||
# returns text with the characters reversed # |
|||
OP REVERSE = ( STRING text )STRING: |
|||
BEGIN |
|||
STRING reversed := text; |
|||
INT start pos := LWB text; |
|||
FOR end pos FROM UPB reversed BY -1 TO LWB reversed |
|||
DO |
|||
reversed[ end pos ] := text[ start pos ]; |
|||
start pos +:= 1 |
|||
OD; |
|||
reversed |
|||
END # REVERSE # ; |
|||
# read the list of words and store the words in an associative array # |
|||
# check for semordnilaps # |
|||
IF FILE input file; |
|||
STRING file name = "unixdict.txt"; |
|||
open( input file, file name, stand in channel ) /= 0 |
|||
THEN |
|||
# failed to open the file # |
|||
print( ( "Unable to open """ + file name + """", newline ) ) |
|||
ELSE |
|||
# file opened OK # |
|||
BOOL at eof := FALSE; |
|||
# set the EOF handler for the file # |
|||
on logical file end( input file, ( REF FILE f )BOOL: |
|||
BEGIN |
|||
# note that we reached EOF on the # |
|||
# latest read # |
|||
at eof := TRUE; |
|||
# return TRUE so processing can continue # |
|||
TRUE |
|||
END |
|||
); |
|||
REF AARRAY words := INIT LOC AARRAY; |
|||
STRING word; |
|||
INT semordnilap count := 0; |
|||
WHILE NOT at eof |
|||
DO |
|||
STRING word; |
|||
get( input file, ( word, newline ) ); |
|||
STRING reversed word = REVERSE word; |
|||
IF ( words // reversed word ) = "" |
|||
THEN |
|||
# the reversed word isn't in the array # |
|||
words // word := reversed word |
|||
ELSE |
|||
# we already have this reversed - we have a semordnilap # |
|||
semordnilap count +:= 1; |
|||
IF semordnilap count <= 5 |
|||
THEN |
|||
print( ( reversed word, " & ", word, newline ) ) |
|||
FI |
|||
FI |
|||
OD; |
|||
close( input file ); |
|||
print( ( whole( semordnilap count, 0 ), " semordnilaps found", newline ) ) |
|||
FI</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
ac & ca |
|||
bad & dab |
|||
avid & diva |
|||
and & dna |
|||
bard & drab |
|||
158 semordnilaps found |
|||
</pre> |
|||
=={{header|Arturo}}== |
|||
<syntaxhighlight lang="rebol">words: read.lines "http://wiki.puzzlers.org/pub/wordlists/unixdict.txt" |
|||
pairs: [] |
|||
loop words 'wrd [ |
|||
if and? contains? words reverse wrd |
|||
wrd <> reverse wrd [ |
|||
'pairs ++ @[@[wrd reverse wrd]] |
|||
print [wrd "-" reverse wrd] |
|||
] |
|||
] |
|||
unique 'pairs |
|||
print map 1..5 => [sample pairs]</syntaxhighlight> |
|||
=={{header|AutoHotkey}}== |
|||
{{works with|AutoHotkey_L}} |
|||
<syntaxhighlight lang="autohotkey">S := [], M := [] |
|||
FileRead, dict, unixdict.txt |
|||
Loop, Parse, dict, `n, `r`n |
|||
{ |
|||
r := Reverse(A_LoopField) |
|||
if (S[r]) |
|||
M.Insert(r " / " A_LoopField) |
|||
else |
|||
S[A_LoopField] := 1 |
|||
} |
|||
Loop, 5 |
|||
Out .= "`t" M[A_Index] "`n" |
|||
MsgBox, % "5 Examples:`n" Out "`nTotal Pairs:`n`t" M.MaxIndex() |
|||
Reverse(s) { |
|||
Loop, Parse, s |
|||
r := A_LoopField . r |
|||
return r |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre>5 Examples: |
|||
ac / ca |
|||
bad / dab |
|||
avid / diva |
|||
and / dna |
|||
bard / drab |
|||
Total Pairs: |
|||
158</pre> |
|||
=={{header|AWK}}== |
=={{header|AWK}}== |
||
<syntaxhighlight lang="awk"> |
|||
<lang AWK> |
|||
# syntax: GAWK -f SEMORDNILAP.AWK unixdict.txt |
# syntax: GAWK -f SEMORDNILAP.AWK unixdict.txt |
||
{ arr[$0]++ } |
{ arr[$0]++ } |
||
Line 203: | Line 345: | ||
exit(0) |
exit(0) |
||
} |
} |
||
</syntaxhighlight> |
|||
</lang> |
|||
{{out}} |
|||
<p>output:</p> |
|||
<pre> |
<pre> |
||
able elba |
able elba |
||
Line 216: | Line 358: | ||
=={{header|BBC BASIC}}== |
=={{header|BBC BASIC}}== |
||
{{works with|BBC BASIC for Windows}} |
{{works with|BBC BASIC for Windows}} |
||
< |
<syntaxhighlight lang="bbcbasic"> INSTALL @lib$+"SORTLIB" |
||
Sort% = FN_sortinit(0,0) |
Sort% = FN_sortinit(0,0) |
||
Line 265: | Line 407: | ||
SWAP P%?I%, L%?(P%-I%) |
SWAP P%?I%, L%?(P%-I%) |
||
NEXT |
NEXT |
||
= A$</ |
= A$</syntaxhighlight> |
||
{{out}} |
|||
Output: |
|||
<pre> |
<pre> |
||
damon nomad |
damon nomad |
||
Line 277: | Line 419: | ||
=={{header|Bracmat}}== |
=={{header|Bracmat}}== |
||
< |
<syntaxhighlight lang="bracmat">( get'("unixdict.txt",STR):?dict |
||
& new$hash:?H |
& new$hash:?H |
||
& 0:?p |
& 0:?p |
||
Line 300: | Line 442: | ||
& out$(semordnilap !N dnuoF) |
& out$(semordnilap !N dnuoF) |
||
) |
) |
||
);</ |
);</syntaxhighlight> |
||
{{out}} |
|||
Output: |
|||
<pre>tv vt |
<pre>tv vt |
||
ir ri |
ir ri |
||
Line 311: | Line 453: | ||
=={{header|C}}== |
=={{header|C}}== |
||
< |
<syntaxhighlight lang="c">#include <stdio.h> |
||
#include <stdlib.h> |
#include <stdlib.h> |
||
#include <alloca.h> /* stdlib.h might not have obliged. */ |
#include <alloca.h> /* stdlib.h might not have obliged. */ |
||
Line 376: | Line 518: | ||
printf("Semordnilap pairs: %d\n", sem); |
printf("Semordnilap pairs: %d\n", sem); |
||
return 0; |
return 0; |
||
}</ |
}</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre>ca ac |
<pre>ca ac |
||
dab bad |
dab bad |
||
Line 386: | Line 527: | ||
drab bard |
drab bard |
||
Semordnilap pairs: 158</pre> |
Semordnilap pairs: 158</pre> |
||
=={{header|C sharp}}== |
|||
<syntaxhighlight lang="csharp">using System; |
|||
using System.Net; |
|||
using System.Collections.Generic; |
|||
using System.Linq; |
|||
using System.IO; |
|||
public class Semordnilap |
|||
{ |
|||
public static void Main() { |
|||
var results = FindSemordnilaps("http://www.puzzlers.org/pub/wordlists/unixdict.txt").ToList(); |
|||
Console.WriteLine(results.Count); |
|||
var random = new Random(); |
|||
Console.WriteLine("5 random results:"); |
|||
foreach (string s in results.OrderBy(_ => random.Next()).Distinct().Take(5)) Console.WriteLine(s + " " + Reversed(s)); |
|||
} |
|||
private static IEnumerable<string> FindSemordnilaps(string url) { |
|||
var found = new HashSet<string>(); |
|||
foreach (string line in GetLines(url)) { |
|||
string reversed = Reversed(line); |
|||
//Not taking advantage of the fact the input file is sorted |
|||
if (line.CompareTo(reversed) != 0) { |
|||
if (found.Remove(reversed)) yield return reversed; |
|||
else found.Add(line); |
|||
} |
|||
} |
|||
} |
|||
private static IEnumerable<string> GetLines(string url) { |
|||
WebRequest request = WebRequest.Create(url); |
|||
using (var reader = new StreamReader(request.GetResponse().GetResponseStream(), true)) { |
|||
while (!reader.EndOfStream) { |
|||
yield return reader.ReadLine(); |
|||
} |
|||
} |
|||
} |
|||
private static string Reversed(string value) => new string(value.Reverse().ToArray()); |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
158 |
|||
5 random results: |
|||
keep peek |
|||
lever revel |
|||
ix xi |
|||
avid diva |
|||
gar rag</pre> |
|||
=={{header|C++}}== |
=={{header|C++}}== |
||
< |
<syntaxhighlight lang="cpp">#include <fstream> |
||
#include <iostream> |
#include <iostream> |
||
#include <set> |
#include <set> |
||
#include <string> |
#include <string> |
||
int main() |
int main() { |
||
{ |
|||
std::ifstream input("unixdict.txt"); |
std::ifstream input("unixdict.txt"); |
||
if ( |
if (input) { |
||
std::set<std::string> words; // previous words |
|||
std::string word; // current word |
|||
} |
|||
size_t count = 0; // pair count |
|||
while (input >> word) { |
|||
std::set<std::string> words; // previous words |
|||
std::string word; // |
std::string drow(word.rbegin(), word.rend()); // reverse |
||
if (words.find(drow) == words.end()) { |
|||
size_t count = 0; // pair count |
|||
// pair not found |
|||
words.insert(word); |
|||
} else { |
|||
std::string drow(word.rbegin(), word.rend()); // reverse |
|||
// pair found |
|||
if (count++ < 5) |
|||
std::cout << word << ' ' << drow << '\n'; |
|||
} else { // pair found |
|||
if (count < 5) { |
|||
std::cout << word << ' ' << drow << '\n'; |
|||
} |
} |
||
++count; |
|||
} |
} |
||
std::cout << "\nSemordnilap pairs: " << count << '\n'; |
|||
} |
|||
return 0; |
|||
std::cout << "\nSemordnilap pairs: " << count << '\n'; |
|||
} else |
|||
}</lang> |
|||
return 1; // couldn't open input file |
|||
}</syntaxhighlight> |
|||
{{out}} |
{{out}} |
||
<pre> |
<pre> |
||
Line 429: | Line 619: | ||
=={{header|Clojure}}== |
=={{header|Clojure}}== |
||
<lang |
<syntaxhighlight lang="clojure">(ns rosettacode.semordnilaps |
||
(require |
(:require [clojure.string :as str]) |
||
[clojure.java.io :as io ])) |
|||
(def dict-file |
(def dict-file |
||
(or (first *command-line-args*) "unixdict.txt")) |
|||
(def dict ( |
(def dict (-> dict-file io/reader line-seq set)) |
||
(defn semordnilap? [word] |
(defn semordnilap? [word] |
||
(let [rev ( |
(let [rev (str/reverse word)] |
||
(and (not |
(and (not= word rev) (dict rev)))) |
||
(def semordnilaps |
(def semordnilaps |
||
(->> dict |
|||
(filter (fn [[x y]] (<= (compare x y) 0)) |
|||
(filter semordnilap?) |
|||
(map (fn [word] [word (string/reverse word)]) |
|||
( |
(map #([% (str/reverse %)])) |
||
(filter (fn [[x y]] (<= (compare x y) 0))))) |
|||
(printf "There are %d semordnilaps in %s. Here are 5:\n" |
(printf "There are %d semordnilaps in %s. Here are 5:\n" |
||
Line 449: | Line 642: | ||
dict-file) |
dict-file) |
||
(dorun ( |
(dorun (->> semordnilaps shuffle (take 5) sort (map println)))</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
Line 458: | Line 651: | ||
[los sol] |
[los sol] |
||
[mot tom]</pre> |
[mot tom]</pre> |
||
=={{header|Common Lisp}}== |
|||
<syntaxhighlight lang="lisp">(defun semordnilaps (word-list) |
|||
(let ((word-map (make-hash-table :test 'equal))) |
|||
(loop for word in word-list do |
|||
(setf (gethash word word-map) t)) |
|||
(loop for word in word-list |
|||
for rword = (reverse word) |
|||
when (and (string< word rword) (gethash rword word-map)) |
|||
collect (cons word rword)))) |
|||
(defun main () |
|||
(let ((words |
|||
(semordnilaps |
|||
(with-open-file (s "unixdict.txt") |
|||
(loop for line = (read-line s nil nil) |
|||
until (null line) |
|||
collect (string-right-trim #(#\space #\return #\newline) line)))))) |
|||
(format t "Found pairs: ~D" (length words)) |
|||
(loop for x from 1 to 5 |
|||
for word in words |
|||
do (print word))) |
|||
(values))</syntaxhighlight> |
|||
{{out}} |
|||
<pre>* (main) |
|||
Found pairs: 158 |
|||
("able" . "elba") |
|||
("abut" . "tuba") |
|||
("ac" . "ca") |
|||
("ah" . "ha") |
|||
("al" . "la")</pre> |
|||
=={{header|Crystal}}== |
|||
<syntaxhighlight lang="ruby">require "set" |
|||
UNIXDICT = File.read("unixdict.txt").lines |
|||
def word?(word : String) |
|||
UNIXDICT.includes?(word) |
|||
end |
|||
# is it a word and is it a word backwards? |
|||
semordnilap = UNIXDICT.select { |word| word?(word) && word?(word.reverse) } |
|||
# consolidate pairs like [bad, dab] == [dab, bad] |
|||
final_results = semordnilap.map { |word| [word, word.reverse].to_set }.uniq |
|||
# sets of N=1 mean the word is identical backwards |
|||
# print out the size, and 5 random pairs |
|||
puts final_results.size, final_results.sample(5) |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
246 |
|||
[Set{"s's"}, Set{"eire", "erie"}, Set{"bag", "gab"}, Set{"mat", "tam"}, Set{"gel", "leg"}] |
|||
</pre> |
|||
=={{header|D}}== |
=={{header|D}}== |
||
===Simple Imperative Version=== |
|||
<lang d>import std.stdio, std.file, std.string, std.algorithm; |
|||
<syntaxhighlight lang="d">void main() { |
|||
import std.stdio, std.file, std.string, std.algorithm; |
|||
void main() { |
|||
bool[string] seenWords; |
bool[string] seenWords; |
||
size_t pairCount = 0; |
size_t pairCount = 0; |
||
foreach (word; |
foreach (const word; "unixdict.txt".readText.toLower.splitter) { |
||
//const drow = word.dup.reverse(); |
|||
auto drow = word.dup; |
|||
drow.reverse(); |
|||
if (drow in seenWords) { |
if (drow in seenWords) { |
||
if (pairCount++ < 5) |
if (pairCount++ < 5) |
||
Line 476: | Line 729: | ||
writeln("\nSemordnilap pairs: ", pairCount); |
writeln("\nSemordnilap pairs: ", pairCount); |
||
}</ |
}</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre>ca ac |
<pre>ca ac |
||
Line 485: | Line 738: | ||
Semordnilap pairs: 158</pre> |
Semordnilap pairs: 158</pre> |
||
===A More Functional Version=== |
|||
<syntaxhighlight lang="d">void main() { |
|||
import std.stdio, std.file, std.algorithm, std.string, std.range; |
|||
auto words = "unixdict.txt".readText.split.zip(0.repeat).assocArray; |
|||
auto pairs = zip(words.byKey, words.byKey.map!(w => w.dup.reverse)) |
|||
.filter!(wr => wr[0] < wr[1] && wr[1] in words) |
|||
.zip(0.repeat).assocArray; |
|||
writeln(pairs.length, "\n", pairs.byKey.take(5)); |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre>158 |
|||
[Tuple!(string, char[])("bag", "gab"), Tuple!(string, char[])("pat", "tap"), Tuple!(string, char[])("avis", "siva"), Tuple!(string, char[])("haw", "wah"), Tuple!(string, char[])("rot", "tor")]</pre> |
|||
=={{header|Delphi}}== |
|||
{{libheader| System.SysUtils}} |
|||
{{libheader| System.Classes}} |
|||
{{libheader| System.StrUtils}} |
|||
{{libheader| System.Diagnostics}} |
|||
<syntaxhighlight lang="delphi"> |
|||
program Semordnilap; |
|||
{$APPTYPE CONSOLE} |
|||
{$R *.res} |
|||
uses |
|||
System.SysUtils, |
|||
System.Classes, |
|||
System.StrUtils, |
|||
System.Diagnostics; |
|||
function Sort(s: string): string; |
|||
var |
|||
c: Char; |
|||
i, j, aLength: Integer; |
|||
begin |
|||
aLength := s.Length; |
|||
if aLength = 0 then |
|||
exit(''); |
|||
Result := s; |
|||
for i := 1 to aLength - 1 do |
|||
for j := i + 1 to aLength do |
|||
if result[i] > result[j] then |
|||
begin |
|||
c := result[i]; |
|||
result[i] := result[j]; |
|||
result[j] := c; |
|||
end; |
|||
end; |
|||
function IsAnagram(s1, s2: string): Boolean; |
|||
begin |
|||
if s1.Length <> s2.Length then |
|||
exit(False); |
|||
Result := Sort(s1) = Sort(s2); |
|||
end; |
|||
function CompareLength(List: TStringList; Index1, Index2: Integer): Integer; |
|||
begin |
|||
result := List[Index1].Length - List[Index2].Length; |
|||
if Result = 0 then |
|||
Result := CompareText(Sort(List[Index2]), Sort(List[Index1])); |
|||
end; |
|||
function IsSemordnilap(word1, word2: string): Boolean; |
|||
begin |
|||
Result := SameText(word1, ReverseString(word2)); |
|||
end; |
|||
var |
|||
SemordnilapDict, Dict: TStringList; |
|||
Count, Index, i, j: Integer; |
|||
words: string; |
|||
StopWatch: TStopwatch; |
|||
begin |
|||
Randomize; |
|||
StopWatch := TStopwatch.Create; |
|||
StopWatch.Start; |
|||
Dict := TStringList.Create(); |
|||
Dict.LoadFromFile('unixdict.txt'); |
|||
SemordnilapDict := TStringList.Create; |
|||
Dict.CustomSort(CompareLength); |
|||
Index := Dict.Count - 1; |
|||
words := ''; |
|||
Count := 1; |
|||
while Index - Count >= 0 do |
|||
begin |
|||
if IsAnagram(Dict[Index], Dict[Index - Count]) then |
|||
begin |
|||
if IsSemordnilap(Dict[Index], Dict[Index - Count]) then |
|||
begin |
|||
words := Dict[Index] + ' - ' + Dict[Index - Count]; |
|||
SemordnilapDict.Add(words); |
|||
end; |
|||
Inc(Count); |
|||
end |
|||
else |
|||
begin |
|||
if Count > 2 then |
|||
for i := 1 to Count - 2 do |
|||
for j := i + 1 to Count - 1 do |
|||
begin |
|||
if IsSemordnilap(Dict[Index - i], Dict[Index - j]) then |
|||
begin |
|||
words := Dict[Index - i] + ' - ' + Dict[Index - j]; |
|||
SemordnilapDict.Add(words); |
|||
end; |
|||
end; |
|||
Dec(Index, Count); |
|||
Count := 1; |
|||
end; |
|||
end; |
|||
StopWatch.Stop; |
|||
Writeln(Format('Time pass: %d ms [i7-4500U Windows 7]', [StopWatch.ElapsedMilliseconds])); |
|||
writeln(#10'Semordnilap found: ', SemordnilapDict.Count); |
|||
writeln(#10'Five random samples:'#10); |
|||
for Index := 0 to 4 do |
|||
writeln(' ', SemordnilapDict[Random(SemordnilapDict.Count)]); |
|||
SemordnilapDict.SaveToFile('Semordnilap.txt'); |
|||
SemordnilapDict.Free; |
|||
Dict.Free; |
|||
Readln; |
|||
end. |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
Time pass: 558 ms [i7-4500U Windows 7] |
|||
Semordnilap found: 158 |
|||
Five random samples: |
|||
on - no |
|||
me - em |
|||
peek - keep |
|||
ton - not |
|||
viva - aviv |
|||
</pre> |
|||
=={{header|EchoLisp}}== |
|||
We use the '''words''' library, and the french dictionary delivered with EchoLisp. |
|||
<syntaxhighlight lang="scheme"> |
|||
(lib 'struct) |
|||
(lib 'sql) |
|||
(lib 'words) |
|||
(lib 'dico.fr.no-accent) ;; load dictionary |
|||
(string-delimiter "") |
|||
;; check reverse r of w is a word |
|||
;; take only one pair : r < w |
|||
(define (semordnilap? w) |
|||
(define r (list->string (reverse (string->list w)))) |
|||
(and (word? r) (string<? r w))) |
|||
;; to get longest first |
|||
(define (string-sort a b) (> (string-length a) (string-length b))) |
|||
(define (task) |
|||
;; select unique words into the list 'mots' |
|||
(define mots (make-set (words-select #:any null 999999))) |
|||
(define semordnilap |
|||
(list-sort string-sort (for/list ((w mots)) |
|||
#:when (semordnilap? w) |
|||
w ))) |
|||
(writeln 'pairs '→ (length semordnilap)) |
|||
(writeln 'longest '→ (take semordnilap 5))) |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
(task) |
|||
pairs → 345 |
|||
longest → (rengager tresser strasse reveler retrace) |
|||
</pre> |
|||
=={{header|Eiffel}}== |
|||
First the programm reads the wordlist into an array. |
|||
Then it mirrors each word and searchs for it across the array using binary search. |
|||
<syntaxhighlight lang="eiffel"> |
|||
class |
|||
SEMORDNILAP |
|||
create |
|||
make |
|||
feature |
|||
make |
|||
--Semordnilaps in 'solution'. |
|||
local |
|||
count, i, middle, upper, lower: INTEGER |
|||
reverse: STRING |
|||
do |
|||
read_wordlist |
|||
create solution.make_empty |
|||
from |
|||
i := 1 |
|||
until |
|||
i > word_array.count |
|||
loop |
|||
word_array [i].mirror |
|||
reverse := word_array [i] |
|||
from |
|||
lower := i + 1 |
|||
upper := word_array.count |
|||
until |
|||
lower >= upper |
|||
loop |
|||
middle := (upper - lower) // 2 + lower |
|||
if reverse.same_string (word_array [middle]) then |
|||
count := count + 1 |
|||
upper := 0 |
|||
lower := 1 |
|||
solution.force (word_array [i], count) |
|||
elseif reverse.is_less (word_array [middle]) then |
|||
upper := middle - 1 |
|||
else |
|||
lower := middle + 1 |
|||
end |
|||
end |
|||
if lower < word_array.count and then reverse.same_string (word_array [lower]) then |
|||
count := count + 1 |
|||
upper := 0 |
|||
lower := 1 |
|||
solution.force (word_array [i], count) |
|||
end |
|||
i := i + 1 |
|||
end |
|||
end |
|||
solution: ARRAY [STRING] |
|||
original_list: STRING = "unixdict.txt" |
|||
feature {NONE} |
|||
read_wordlist |
|||
-- Preprocessed word_array for finding Semordnilaps. |
|||
local |
|||
l_file: PLAIN_TEXT_FILE |
|||
wordlist: LIST [STRING] |
|||
do |
|||
create l_file.make_open_read_write (original_list) |
|||
l_file.read_stream (l_file.count) |
|||
wordlist := l_file.last_string.split ('%N') |
|||
l_file.close |
|||
create word_array.make_empty |
|||
across |
|||
1 |..| wordlist.count as i |
|||
loop |
|||
word_array.force (wordlist.at (i.item), i.item) |
|||
end |
|||
end |
|||
word_array: ARRAY [STRING] |
|||
end |
|||
</syntaxhighlight> |
|||
Test: |
|||
<syntaxhighlight lang="eiffel"> |
|||
class |
|||
APPLICATION |
|||
create |
|||
make |
|||
feature |
|||
make |
|||
local |
|||
test: ARRAY [STRING] |
|||
s: STRING |
|||
do |
|||
create se.make |
|||
test := se.solution |
|||
create sort.sort (test) |
|||
across |
|||
test.subarray (1, 5) as t |
|||
loop |
|||
s := t.item |
|||
io.put_string (t.item + "%T") |
|||
s.mirror |
|||
io.put_string (s) |
|||
io.new_line |
|||
end |
|||
io.put_string ("Total number of semordnilaps: ") |
|||
io.put_integer (test.count) |
|||
end |
|||
se: SEMORDNILAP |
|||
sort: MERGE_SORT [STRING] |
|||
end |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
ca ac |
|||
dab bad |
|||
diva avid |
|||
dna and |
|||
drab bard |
|||
Total number of semordnilaps: 158 |
|||
</pre> |
|||
=={{header|Elixir}}== |
|||
<syntaxhighlight lang="elixir">words = File.stream!("unixdict.txt") |
|||
|> Enum.map(&String.strip/1) |
|||
|> Enum.group_by(&min(&1, String.reverse &1)) |
|||
|> Map.values |
|||
|> Enum.filter(&(length &1) == 2) |
|||
IO.puts "Semordnilap pair: #{length(words)}" |
|||
IO.inspect Enum.take(words,5)</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
Semordnilap pair: 158 |
|||
[["dab", "bad"], ["drib", "bird"], ["marc", "cram"], ["soma", "amos"], |
|||
["tab", "bat"]] |
|||
</pre> |
|||
=={{header|Erlang}}== |
|||
{{trans|Clojure}} |
|||
<syntaxhighlight lang="erlang">#!/usr/bin/env escript |
|||
main([]) -> main(["unixdict.txt"]); |
|||
main([DictFile]) -> |
|||
Dict = sets:from_list(read_lines(DictFile)), |
|||
Semordnilaps = |
|||
lists:filter(fun([W,R]) -> W < R end, |
|||
lists:map(fun(W) -> [W, lists:reverse(W)] end, |
|||
semordnilaps(Dict))), |
|||
io:fwrite("There are ~b semordnilaps in ~s~n", |
|||
[length(Semordnilaps), DictFile]), |
|||
lists:map(fun([W,R]) -> io:fwrite("~s/~s~n", [W, R]) end, |
|||
lists:sort(lists:sublist(shuffle(Semordnilaps),1,5))). |
|||
read_lines(Filename) when is_list(Filename) -> |
|||
{ ok, File } = file:open(Filename, [read]), |
|||
read_lines(File); |
|||
read_lines(File) when is_pid(File) -> |
|||
case file:read_line(File) of |
|||
{ok, Data} -> [chop(Data) | read_lines(File)]; |
|||
eof -> [] |
|||
end. |
|||
is_semordnilap(Word, Dict) -> |
|||
Rev = lists:reverse(Word), |
|||
sets:is_element(Word, Dict) and sets:is_element(Rev, Dict). |
|||
semordnilaps(Dict) -> |
|||
lists:filter(fun(W) -> is_semordnilap(W, Dict) end, sets:to_list(Dict)). |
|||
shuffle(List) -> |
|||
[X||{_,X} <- lists:sort([ {random:uniform(), N} || N <- List])]. |
|||
chop(L) -> [_|T] = lists:reverse(L), lists:reverse(T).</syntaxhighlight> |
|||
{{out}} |
|||
<pre>There are 158 semordnilaps in unixdict.txt |
|||
aryl/lyra |
|||
caw/wac |
|||
cram/marc |
|||
dine/enid |
|||
dual/laud</pre> |
|||
=={{header|F_Sharp|F#}}== |
|||
Using a mutable dictionary. |
|||
<syntaxhighlight lang="fsharp">open System |
|||
let seen = new System.Collections.Generic.Dictionary<string,bool>() |
|||
let lines = System.IO.File.ReadLines("unixdict.txt") |
|||
let sems = seq { |
|||
for word in lines do |
|||
let drow = new String(Array.rev(word.ToCharArray())) |
|||
if fst(seen.TryGetValue(drow)) then yield (drow, word) |
|||
seen.[drow] <- true |
|||
seen.[word] <- true |
|||
} |
|||
let s = Seq.toList sems |
|||
printfn "%d" s.Length |
|||
for i in 0 .. 4 do printfn "%A" s.[i]</syntaxhighlight> |
|||
{{out}} |
|||
<pre>158 |
|||
("ac", "ca") |
|||
("bad", "dab") |
|||
("avid", "diva") |
|||
("and", "dna") |
|||
("bard", "drab")</pre> |
|||
=={{header|Factor}}== |
|||
<syntaxhighlight lang="factor">USING: assocs combinators.short-circuit formatting |
|||
io.encodings.utf8 io.files kernel literals locals make |
|||
prettyprint random sequences ; |
|||
IN: rosetta-code.semordnilap |
|||
CONSTANT: words $[ "unixdict.txt" utf8 file-lines ] |
|||
: semordnilap? ( str1 str2 -- ? ) |
|||
{ [ = not ] [ nip words member? ] } 2&& ; |
|||
[ |
|||
[let |
|||
V{ } clone :> seen words |
|||
[ |
|||
dup reverse 2dup |
|||
{ [ semordnilap? ] [ drop seen member? not ] } 2&& |
|||
[ 2dup [ seen push ] bi@ ,, ] [ 2drop ] if |
|||
] each |
|||
] |
|||
] H{ } make >alist |
|||
[ length "%d semordnilap pairs.\n" printf ] [ 5 sample . ] bi</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
158 semordnilap pairs. |
|||
{ |
|||
{ "pan" "nap" } |
|||
{ "lac" "cal" } |
|||
{ "tang" "gnat" } |
|||
{ "wolf" "flow" } |
|||
{ "mac" "cam" } |
|||
} |
|||
</pre> |
|||
=={{header|Forth}}== |
|||
This code uses a Forth wordlist to contain the dictionary, and uses the Forth-2012 TRAVERSE-WORDLIST to walk through it (a simpler way would be to check for the presence of the reversed word when putting the word into the wordlist). |
|||
One interesting issue is how I get each pair only once and exclude |
|||
palindromes: I accept only pairs where nt<nt2. A type checking bigot |
|||
will likely argue that nts should not be compared with <, because they |
|||
are opaque data types. But their implementation does not matter for |
|||
this check: Whatever bit patterns these two nts get, either it's the |
|||
same nt, then nt<nt2 will return false, as desired; and if they are |
|||
different, exactly one of nt<nt2 and nt2<nt will return true. |
|||
The code uses two Gforth-specific words: EXECUTE-PARSING (implementable in standard Forth, but not easy) for allowing to provide the name of the defined word on the stack; and FIND-NAME-IN to look up the reversed word (could be replaced with a use of the standard SEARCH-WORDLIST, but the code would become a little more complicated). |
|||
<syntaxhighlight lang="forth"> |
|||
wordlist constant dict |
|||
: load-dict ( c-addr u -- ) |
|||
r/o open-file throw >r |
|||
begin |
|||
pad 1024 r@ read-line throw while |
|||
pad swap ['] create execute-parsing |
|||
repeat |
|||
drop r> close-file throw ; |
|||
: xreverse {: c-addr u -- c-addr2 u :} |
|||
u allocate throw u + c-addr swap over u + >r begin ( from to r:end) |
|||
over r@ u< while |
|||
over r@ over - x-size dup >r - 2dup r@ cmove |
|||
swap r> + swap repeat |
|||
r> drop nip u ; |
|||
: .example ( c-addr u u1 -- ) |
|||
5 < if |
|||
cr 2dup type space 2dup xreverse 2dup type drop free throw then |
|||
2drop ; |
|||
: nt-semicheck ( u1 nt -- u2 f ) |
|||
dup >r name>string xreverse 2dup dict find-name-in dup if ( u1 c-addr u nt2) |
|||
r@ < if ( u1 c-addr u ) \ count pairs only once and not palindromes |
|||
2dup 4 pick .example |
|||
rot 1+ -rot then |
|||
else |
|||
drop then |
|||
drop free throw r> drop true ; |
|||
get-current dict set-current s" unixdict.txt" load-dict set-current |
|||
0 ' nt-semicheck dict traverse-wordlist cr . |
|||
cr bye |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
suez zeus |
|||
paz zap |
|||
way yaw |
|||
pay yap |
|||
may yam |
|||
158 |
|||
</pre> |
|||
=={{header|Fortran}}== |
|||
Please read the comments at the beginning of the f90 source to see the compilation instructions and output of 5 random words from a run. |
|||
Note that program Semordnilap opens the file unixdict.txt . |
|||
It does not read from stdin, hence the command line redirection from unixdict.txt is irrelevant. I haven't bothered to change it. |
|||
<syntaxhighlight lang="fortran"> |
|||
!-*- mode: compilation; default-directory: "/tmp/" -*- |
|||
!Compilation started at Sun May 19 21:50:08 |
|||
! |
|||
!a=./F && make $a && $a < unixdict.txt |
|||
!f95 -Wall -ffree-form F.F -o F |
|||
! 5 of 158 semordnilaps |
|||
!yaw |
|||
!room |
|||
!xi |
|||
!tim |
|||
!nova |
|||
! |
|||
! |
|||
!Compilation finished at Sun May 19 21:50:08 |
|||
! |
|||
! |
|||
! |
|||
! |
|||
! unixdict.txt information |
|||
! wc -l unixdict.txt #--> 25104 25 thousand entries |
|||
! gawk 'length(a)<length($0){a=$0}END{print a}' unixdict.txt #--> electroencephalography longest word has 22 characters |
|||
! gawk '/[A-Z]/{++a}END{print a}' unixdict.txt #--> <empty> the dictionary is lower case |
|||
! sort unixdict.txt | cmp - unixdict.txt #--> - unixdict.txt differ: byte 45, line 12 |
|||
! the dictionary is unsorted |
|||
! mmmmm the dictionary is sorted, according to subroutine bs. There's something about the ampersands within unixdict.txt I misunderstand. |
|||
program Semordnilap |
|||
implicit none |
|||
integer :: i, ios, words, swords |
|||
character(len=24), dimension(32768) :: dictionary, backword |
|||
real, dimension(5) :: harvest |
|||
! read the dictionary |
|||
open(7,file='unixdict.txt') |
|||
do words = 1, 32768 |
|||
read(7, '(a)', iostat = ios) dictionary(words) |
|||
if (ios .ne. 0) exit |
|||
enddo |
|||
close(7) |
|||
if (iachar(dictionary(words)(1:1)) .eq. 0) words = words-1 |
|||
! sort the dictionary |
|||
call bs(dictionary, words) |
|||
!do i = 1, words |
|||
! write(6,*) dictionary(i)(1:len_trim(dictionary(i))) ! with which we determine the dictionary was ordered |
|||
!enddo |
|||
swords = 0 |
|||
do i = 1, words |
|||
call reverse(dictionary(i), backword(swords+1)) |
|||
if ((binary_search(dictionary, words, backword(swords+1))) & ! the reversed word is in the dictionary |
|||
.and. (.not. binary_search(backword, swords, dictionary(i))) & ! and it's new |
|||
.and. (dictionary(i) .ne. backword(swords+1))) then ! and it's not a palindrome |
|||
swords = swords + 1 |
|||
call bs(backword, swords) |
|||
endif |
|||
enddo |
|||
call random_number(harvest) |
|||
call reverse('spalindromes', backword(swords+1)) |
|||
write(6, *) '5 of ', swords, backword(swords+1) |
|||
write(6,'(5(a/))') (backword(1+int(harvest(i)*(swords-2))), i=1,5) |
|||
contains |
|||
subroutine reverse(inp, outp) |
|||
character(len=*), intent(in) :: inp |
|||
character(len=*), intent(inout) :: outp |
|||
integer :: k, L |
|||
L = len_trim(inp) |
|||
do k = 1, L |
|||
outp(L+1-k:L+1-k) = inp(k:k) |
|||
enddo |
|||
do k = L+1, len(outp) |
|||
outp(k:k) = ' ' |
|||
enddo |
|||
end subroutine reverse |
|||
subroutine bs(a, n) ! ok, despite having claimed that bubble sort should be unceremoniously buried, I'll use it anyway because I expect the dictionary is nearly ordered. It's also not a terrible sort for less than 5 items. |
|||
! Please note, I tested bs using unixdict.txt randomized with sort --random . |
|||
character(len=*),dimension(*),intent(inout) :: a |
|||
integer, intent(in) :: n |
|||
integer :: i, j, k |
|||
logical :: done |
|||
character(len=1) :: t |
|||
do i=n-1, 1, -1 |
|||
done = .true. |
|||
do j=1, i |
|||
if (a(j+1) .lt. a(j)) then |
|||
done = .false. |
|||
do k = 1, max(len_trim(a(j+1)), len_trim(a(j))) |
|||
t = a(j+1)(k:k) |
|||
a(j+1)(k:k) = a(j)(k:k) |
|||
a(j)(k:k) = t(1:1) |
|||
enddo |
|||
endif |
|||
enddo |
|||
if (done) return |
|||
enddo |
|||
end subroutine bs |
|||
logical function binary_search(source, n, target) |
|||
character(len=*),dimension(*),intent(in) :: source |
|||
character(len=*),intent(in) :: target |
|||
integer, intent(in) :: n |
|||
integer :: a,m,z |
|||
a = 1 |
|||
z = n |
|||
do while (a .lt. z) |
|||
m = a + (z - a) / 2 |
|||
if (target .lt. source(m)) then |
|||
z = m-1 |
|||
else |
|||
if (m .eq. a) exit |
|||
a = m |
|||
endif |
|||
enddo |
|||
binary_search = (target .eq. source(a)) .or. (target .eq. source(z)) |
|||
end function binary_search |
|||
end program Semordnilap |
|||
</syntaxhighlight> |
|||
=={{header|FreeBASIC}}== |
|||
<syntaxhighlight lang="freebasic">' version 20-06-2015 |
|||
' compile with: fbc -s console |
|||
Function reverse(norm As String) As String |
|||
Dim As String rev |
|||
Dim As Integer i, l = Len(norm) -1 |
|||
rev = norm |
|||
For i = 0 To l |
|||
rev[l-i] = norm[i] |
|||
Next |
|||
Return rev |
|||
End Function |
|||
' ------=< MAIN >=------ |
|||
Dim As Integer i, j, count, amount, ff = FreeFile |
|||
Dim As String in_str, rev, big = " " ' big needs to start with a space |
|||
Dim As String norm(27000), result(270, 2) |
|||
Print |
|||
Print "Start reading unixdict.txt"; |
|||
Open "unixdict.txt" For Input As #ff |
|||
While Not Eof(ff) ' read to end of file |
|||
Line Input #ff, in_str ' get line = word |
|||
in_str = Trim(in_str) ' we don't want spaces |
|||
If Len(in_str) > 1 Then ' if length > 1 then reverse |
|||
rev = reverse(in_str) |
|||
If in_str <> rev Then ' if in_str is not a palingdrome |
|||
count = count + 1 ' increase counter |
|||
norm(count) = in_str ' store in the array |
|||
big = big + rev + " " ' create big string with reversed words |
|||
End If |
|||
End If |
|||
Wend |
|||
Close #ff |
|||
Print " ... Done" |
|||
Print : Print "Start looking for semordnilap" |
|||
For i = 1 To count |
|||
For j = 1 To amount ' check to avoid the double |
|||
If result(j, 2) = norm(i) Then Continue For, For |
|||
Next |
|||
j = InStr(big, " " + norm(i) + " ") |
|||
If j <> 0 Then ' found one |
|||
amount = amount + 1 ' increase counter |
|||
result(amount,1) = norm(i) ' store normal word |
|||
result(amount,2) = reverse(norm(i)) ' store reverse word |
|||
End If |
|||
Next |
|||
Print : Print "Found"; amount; " unique semordnilap pairs" |
|||
Print : Print "Display 5 semordnilap pairs" |
|||
Print |
|||
count = 0 |
|||
For i = 1 To amount |
|||
If Len(result(i,1)) >= 5 Then |
|||
count = count + 1 |
|||
Print result(i, 1), result(i, 2) |
|||
If count >= 5 Then Exit For |
|||
EndIf |
|||
Next |
|||
Print |
|||
' empty keyboard buffer |
|||
While InKey <> "" : Wend |
|||
Print : Print "Hit any key to end program" |
|||
Sleep |
|||
End</syntaxhighlight> |
|||
{{out}} |
|||
<pre>Start reading unixdict.txt ... Done |
|||
Start looking for semordnilap |
|||
Found 158 unique semordnilap pairs |
|||
Display 5 semordnilap pairs |
|||
damon nomad |
|||
kramer remark |
|||
lager regal |
|||
leper repel |
|||
lever revel</pre> |
|||
=={{header|Go}}== |
=={{header|Go}}== |
||
< |
<syntaxhighlight lang="go">package main |
||
import ( |
import ( |
||
Line 544: | Line 1,530: | ||
fmt.Println(" ", e) |
fmt.Println(" ", e) |
||
} |
} |
||
}</ |
}</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre> |
<pre> |
||
Line 557: | Line 1,543: | ||
=={{header|Groovy}}== |
=={{header|Groovy}}== |
||
< |
<syntaxhighlight lang="groovy">def semordnilapWords(source) { |
||
def words = [] as Set |
def words = [] as Set |
||
def semordnilaps = [] |
def semordnilaps = [] |
||
Line 565: | Line 1,551: | ||
} |
} |
||
semordnilaps |
semordnilaps |
||
}</ |
}</syntaxhighlight> |
||
Test Code |
Test Code |
||
< |
<syntaxhighlight lang="groovy">def semordnilaps = semordnilapWords(new URL('http://www.puzzlers.org/pub/wordlists/unixdict.txt')) |
||
println "Found ${semordnilaps.size()} semordnilap words" |
println "Found ${semordnilaps.size()} semordnilap words" |
||
semordnilaps[0..<5].each { println "$it -> ${it.reverse()}" } </ |
semordnilaps[0..<5].each { println "$it -> ${it.reverse()}" } </syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre>Found 158 semordnilap words |
<pre>Found 158 semordnilap words |
||
Line 579: | Line 1,565: | ||
=={{header|Haskell}}== |
=={{header|Haskell}}== |
||
< |
<syntaxhighlight lang="haskell">import qualified Data.Set as S |
||
semordnilaps |
semordnilaps |
||
:: (Ord a, Foldable t) |
|||
f (s,w) x | S.member (reverse x) s = (s, x:w) |
|||
=> t [a] -> [[a]] |
|||
| otherwise = (S.insert x s, w) |
|||
semordnilaps = |
|||
let f x (s, w) |
|||
| S.member (reverse x) s = (s, x : w) |
|||
| otherwise = (S.insert x s, w) |
|||
in snd . foldr f (S.empty, []) |
|||
main :: IO () |
|||
main=do s <- readFile "unixdict.txt" |
|||
main = do |
|||
let l = semordnilaps (lines s) |
|||
s <- readFile "unixdict.txt" |
|||
print $ length l |
|||
let l = semordnilaps (lines s) |
|||
mapM_ print $ map (\x->(x, reverse x)) $ take 5 l</lang> |
|||
print $ length l |
|||
mapM_ (print . ((,) <*> reverse)) $ take 5 (filter ((4 <) . length) l)</syntaxhighlight> |
|||
{{out}} |
{{out}} |
||
<pre>158 |
|||
("damon","nomad") |
|||
("kramer","remark") |
|||
("lager","regal") |
|||
("leper","repel") |
|||
("lever","revel")</pre> |
|||
=={{header|Icon}} and {{header|Unicon}}== |
|||
The following solution works in both Icon and Unicon: |
|||
<syntaxhighlight lang="unicon">procedure main(a) |
|||
words := set() |
|||
found := 0 |
|||
every word := map(!&input) do { |
|||
if member(words, reverse(word)) then { |
|||
if (found +:= 1) <= 5 then write("\t",reverse(word),"/",word) |
|||
} |
|||
else insert(words, word) |
|||
} |
|||
write("\nFound ",found," semordnilap words") |
|||
end |
|||
</syntaxhighlight> |
|||
Sample run with unixdict: |
|||
<pre> |
<pre> |
||
->smp <unixdict.txt |
|||
158 |
|||
ac/ca |
|||
("zeus","suez") |
|||
bad/dab |
|||
("zap","paz") |
|||
avid/diva |
|||
("yaw","way") |
|||
and/dna |
|||
("yap","pay") |
|||
bard/drab |
|||
("yam","may") |
|||
Found 158 semordnilap words |
|||
-> |
|||
</pre> |
</pre> |
||
Line 603: | Line 1,623: | ||
We find all semordnilaps by filtering only words which, when reversed, are a member of the set of dictionary words and are not palindromes. We then find only unique semordnilaps by pairing them with their reversed instance, sorting each pair, and eliminating duplicates pairs: |
We find all semordnilaps by filtering only words which, when reversed, are a member of the set of dictionary words and are not palindromes. We then find only unique semordnilaps by pairing them with their reversed instance, sorting each pair, and eliminating duplicates pairs: |
||
< |
<syntaxhighlight lang="j"> isSemordnilap=: |.&.> (~: *. e.) ] |
||
unixdict=: <;._2 freads 'unixdict.txt' |
unixdict=: <;._2 freads 'unixdict.txt' |
||
#semordnilaps=: ~. /:~"1 (,. |.&.>) (#~ isSemordnilap) unixdict |
#semordnilaps=: ~. /:~"1 (,. |.&.>) (#~ isSemordnilap) unixdict |
||
158</ |
158</syntaxhighlight> |
||
We see that there are 158 semordnilaps. |
We see that there are 158 semordnilaps. |
||
Line 612: | Line 1,632: | ||
Here's 5 of them, picked arbitrarily: |
Here's 5 of them, picked arbitrarily: |
||
<lang> (5?.158) { semordnilaps |
<syntaxhighlight lang="text"> (5?.158) { semordnilaps |
||
┌────┬────┐ |
┌────┬────┐ |
||
│kay │yak │ |
│kay │yak │ |
||
Line 623: | Line 1,643: | ||
├────┼────┤ |
├────┼────┤ |
||
│caw │wac │ |
│caw │wac │ |
||
└────┴────┘</ |
└────┴────┘</syntaxhighlight> |
||
=={{header|Java}}== |
=={{header|Java}}== |
||
{{trans|D}} |
{{trans|D}} |
||
{{works with|Java|7+}} |
{{works with|Java|7+}} |
||
< |
<syntaxhighlight lang="java5">import java.nio.file.*; |
||
import java.util.*; |
import java.util.*; |
||
public class |
public class Semordnilap { |
||
public static void main(String[] args) throws |
public static void main(String[] args) throws Exception { |
||
List<String> lst = |
List<String> lst = Files.readAllLines(Paths.get("unixdict.txt")); |
||
Set<String> seen = new HashSet<>(); |
Set<String> seen = new HashSet<>(); |
||
int count = 0; |
int count = 0; |
||
for (String w : lst) { |
for (String w : lst) { |
||
w = w.toLowerCase(); |
|||
String r = new StringBuilder(w).reverse().toString(); |
String r = new StringBuilder(w).reverse().toString(); |
||
if (seen.contains(r)) { |
if (seen.contains(r)) { |
||
Line 646: | Line 1,667: | ||
System.out.println("\nSemordnilap pairs found: " + count); |
System.out.println("\nSemordnilap pairs found: " + count); |
||
} |
} |
||
}</syntaxhighlight> |
|||
private static List<String> readLines(String fn) throws IOException { |
|||
List<String> lines; |
|||
try (BufferedReader br = new BufferedReader(new FileReader(fn))) { |
|||
lines = new ArrayList<>(); |
|||
String line; |
|||
while ((line = br.readLine()) != null) |
|||
lines.add(line.trim().toLowerCase()); |
|||
} |
|||
return lines; |
|||
} |
|||
}</lang> |
|||
<pre>ca ac |
<pre>ca ac |
||
dab bad |
dab bad |
||
Line 665: | Line 1,675: | ||
Semordnilap pairs found: 158</pre> |
Semordnilap pairs found: 158</pre> |
||
=={{header|JavaScript}}== |
|||
===Node.js=== |
|||
{{trans|Clojure}} |
|||
<syntaxhighlight lang="javascript">#!/usr/bin/env node |
|||
var fs = require('fs'); |
|||
var sys = require('sys'); |
|||
var dictFile = process.argv[2] || "unixdict.txt"; |
|||
var dict = {}; |
|||
fs.readFileSync(dictFile) |
|||
.toString() |
|||
.split('\n') |
|||
.forEach(function(word) { |
|||
dict[word] = word.split("").reverse().join(""); |
|||
}); |
|||
function isSemordnilap(word) { return dict[dict[word]]; }; |
|||
var semordnilaps = [] |
|||
for (var key in dict) { |
|||
if (isSemordnilap(key)) { |
|||
var rev = dict[key]; |
|||
if (key < rev) { |
|||
semordnilaps.push([key,rev]) ; |
|||
} |
|||
} |
|||
} |
|||
var count = semordnilaps.length; |
|||
sys.puts("There are " + count + " semordnilaps in " + |
|||
dictFile + ". Here are 5:" ); |
|||
var indices=[] |
|||
for (var i=0; i<count; ++i) { |
|||
if (Math.random() < 1/Math.ceil(i/5.0)) { |
|||
indices[i%5] = i |
|||
} |
|||
} |
|||
indices.sort() |
|||
for (var i=0; i<5; ++i) { |
|||
sys.puts(semordnilaps[indices[i]]); |
|||
}</syntaxhighlight> |
|||
===Rhino=== |
|||
{{works with|Rhino|1.7}} |
|||
<syntaxhighlight lang="javascript">#!/usr/bin/env rhino |
|||
importPackage (java.io) |
|||
var dictFile = arguments[0] || "unixdict.txt"; |
|||
var reader = new BufferedReader(new FileReader(dictFile)); |
|||
var dict = {}; |
|||
var word; |
|||
while (word = reader.readLine()) { |
|||
dict[word] = word.split("").reverse().join(""); |
|||
} |
|||
function isSemordnilap(word) { return dict[dict[word]]; }; |
|||
var semordnilaps = [] |
|||
for (var key in dict) { |
|||
if (isSemordnilap(key)) { |
|||
var rev = dict[key]; |
|||
if (key < rev) { |
|||
semordnilaps.push([key,rev]) ; |
|||
} |
|||
} |
|||
} |
|||
var count = semordnilaps.length; |
|||
print("There are " + count + " semordnilaps in " + |
|||
dictFile + ". Here are 5:" ); |
|||
var indices=[] |
|||
for (var i=0; i<count; ++i) { |
|||
if (Math.random() < 1/Math.ceil(i/5.0)) { |
|||
indices[i%5] = i |
|||
} |
|||
} |
|||
indices.sort() |
|||
for (var i=0; i<5; ++i) { |
|||
print(semordnilaps[indices[i]]); |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre>There are 158 semordnilaps in unixdict.txt. Here are 5: |
|||
loot,tool |
|||
ah,ha |
|||
dial,laid |
|||
dine,enid |
|||
haw,wah</pre> |
|||
===macOS JavaScript for Automation=== |
|||
{{Trans|Python}} |
|||
<syntaxhighlight lang="javascript">(() => { |
|||
'use strict'; |
|||
// semordnilap :: [String] -> String |
|||
const semordnilap = xs => { |
|||
const go = ([s, ws], w) => |
|||
s.has(w.split('').reverse().join('')) ? ( |
|||
[s, [w].concat(ws)] |
|||
) : [s.add(w), ws]; |
|||
return xs.reduce(go, [new Set(), []])[1]; |
|||
}; |
|||
const main = () => { |
|||
// xs :: [String] |
|||
const xs = semordnilap( |
|||
lines(readFile('unixdict.txt')) |
|||
); |
|||
console.log(xs.length); |
|||
xs.filter(x => 4 < x.length).forEach( |
|||
x => showLog(...[x, x.split('').reverse().join('')]) |
|||
) |
|||
}; |
|||
// GENERIC FUNCTIONS ---------------------------- |
|||
// lines :: String -> [String] |
|||
const lines = s => s.split(/[\r\n]/); |
|||
// readFile :: FilePath -> IO String |
|||
const readFile = fp => { |
|||
const |
|||
e = $(), |
|||
uw = ObjC.unwrap, |
|||
s = uw( |
|||
$.NSString.stringWithContentsOfFileEncodingError( |
|||
$(fp) |
|||
.stringByStandardizingPath, |
|||
$.NSUTF8StringEncoding, |
|||
e |
|||
) |
|||
); |
|||
return undefined !== s ? ( |
|||
s |
|||
) : uw(e.localizedDescription); |
|||
}; |
|||
// showLog :: a -> IO () |
|||
const showLog = (...args) => |
|||
console.log( |
|||
args |
|||
.map(JSON.stringify) |
|||
.join(' -> ') |
|||
); |
|||
// MAIN --- |
|||
return main(); |
|||
})();</syntaxhighlight> |
|||
{{Out}} |
|||
<pre>158 |
|||
"revel" -> "lever" |
|||
"repel" -> "leper" |
|||
"remark" -> "kramer" |
|||
"regal" -> "lager" |
|||
"nomad" -> "damon"</pre> |
|||
=={{header|jq}}== |
|||
{{Works with|jq|1.4}} |
|||
The following program illustrates several points about jq: |
|||
* jq can be used to process text, as well as JSON; |
|||
* for text-processing tasks for which awk is well-suited, jq may be slightly slower; |
|||
* jq objects (i.e. JSON objects) can be used to define time-efficient mappings from strings. |
|||
Here are some running times on the same machine: |
|||
* awk program: |
|||
user 0m0.134s; sys 0m0.012s |
|||
* time /usr/local/bin/jq -M -s -R -r -f semordnilap.jq unixdict.txt |
|||
user 0m0.440s; sys 0m0.010s |
|||
<syntaxhighlight lang="jq"> |
|||
# Produce a stream |
|||
def report: |
|||
split("\n") as $list |
|||
# construct the dictionary: |
|||
| (reduce $list[] as $entry ({}; . + {($entry): 1})) as $dict |
|||
# construct the list of semordnilaps: |
|||
| $list[] |
|||
| select( (explode|reverse|implode) as $rev |
|||
| (. < $rev and $dict[$rev]) ); |
|||
[report] | (.[0:5][], "length = \(length)")</syntaxhighlight> |
|||
{{Out}} |
|||
able |
|||
abut |
|||
ac |
|||
ah |
|||
al |
|||
length = 158 |
|||
=={{header|Julia}}== |
=={{header|Julia}}== |
||
< |
<syntaxhighlight lang="julia">raw = readdlm("unixdict.txt",String)[:] |
||
inter = intersect(raw,map(reverse,raw)) #find the matching strings/revstrings |
inter = intersect(raw,map(reverse,raw)) #find the matching strings/revstrings |
||
res = String[b == 1 && a != reverse(a) && a < reverse(a) ? a : reverse(a) for a in inter, b in 1:2] #create pairs |
res = String[b == 1 && a != reverse(a) && a < reverse(a) ? a : reverse(a) for a in inter, b in 1:2] #create pairs |
||
res = res[res[:,1] .!= res[:,2],:] #get rid of duplicates, palindromes</ |
res = res[res[:,1] .!= res[:,2],:] #get rid of duplicates, palindromes</syntaxhighlight> |
||
<pre>julia> length(res[:,1]) |
<pre>julia> length(res[:,1]) |
||
158 |
158 |
||
Line 681: | Line 1,888: | ||
"ah" "ha" |
"ah" "ha" |
||
"al" "la" </pre> |
"al" "la" </pre> |
||
=={{header|Kotlin}}== |
|||
{{trans|D}} |
|||
<syntaxhighlight lang="scala">// version 1.2.0 |
|||
import java.io.File |
|||
fun main(args: Array<String>) { |
|||
val words = File("unixdict.txt").readLines().toSet() |
|||
val pairs = words.map { Pair(it, it.reversed()) } |
|||
.filter { it.first < it.second && it.second in words } // avoid dupes+palindromes, find matches |
|||
println("Found ${pairs.size} semordnilap pairs") |
|||
println(pairs.take(5)) |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
Found 158 semordnilap pairs |
|||
[(able, elba), (abut, tuba), (ac, ca), (ah, ha), (al, la)] |
|||
</pre> |
|||
=={{header|Ksh}}== |
|||
<syntaxhighlight lang="ksh"> |
|||
#!/bin/ksh |
|||
# Semordnilap |
|||
# # Variables: |
|||
# |
|||
integer MIN_WORD_LEN=1 TRUE=1 FALSE=0 |
|||
dict='/home/ostrande/prj/roscode/unixdict.txt' |
|||
integer i j=0 k=0 |
|||
typeset -A word |
|||
# # Functions: |
|||
# |
|||
# # Function _flipit(string) - return flipped string |
|||
# |
|||
function _flipit { |
|||
typeset _buf ; _buf="$1" |
|||
typeset _tmp ; unset _tmp |
|||
for (( _i=$(( ${#_buf}-1 )); _i>=0; _i-- )); do |
|||
_tmp="${_tmp}${_buf:${_i}:1}" |
|||
done |
|||
echo "${_tmp}" |
|||
} |
|||
# # Function _isword(word, wordlist) - return 1 if word in wordlist |
|||
# |
|||
function _isword { |
|||
typeset _word ; _word="$1" |
|||
typeset _wordlist ; nameref _wordlist="$2" |
|||
[[ ${_word} == @(${_wordlist}) ]] && return $TRUE |
|||
return $FALSE |
|||
} |
|||
###### |
|||
# main # |
|||
###### |
|||
# # Due to the large number of words in unixdist.txt subgroup by 1st letter and length |
|||
# # only accept words containing alpha chars and > 1 chars |
|||
# |
|||
while read; do |
|||
[[ $REPLY != *+(\W)* ]] && [[ $REPLY != *+(\d)* ]] && \ |
|||
(( ${#REPLY} > MIN_WORD_LEN )) && word[${REPLY:0:1}][${#REPLY}]+=( $REPLY ) |
|||
done < ${dict} |
|||
print Examples: |
|||
for fl in ${!word[*]}; do # Over $fl first letter |
|||
for len in ${!word[${fl}][*]}; do # Over $len word length |
|||
for ((i=0; i<${#word[${fl}][${len}][*]}; i++)); do |
|||
Word=${word[${fl}][${len}][i]} # dummy |
|||
Try=$(_flipit ${Word}) |
|||
if [[ ${Try} != ${Word} ]]; then # no palindromes |
|||
unset words |
|||
oldIFS="$IFS" ; IFS='|' ; words=${word[${Try:0:1}][${#Try}][*]} ; IFS="${oldIFS}" |
|||
_isword "${Try}" words |
|||
if (( $? )); then |
|||
if [[ ${Try} != @(${uniq%\|*}) ]]; then |
|||
((++j)) |
|||
(( ${#Word} >= 5 )) && (( k<=5 )) && print $((++k)). ${Word} ${Try} |
|||
uniq+="${Try}|${Word}|" |
|||
fi |
|||
fi |
|||
fi |
|||
done |
|||
done |
|||
done |
|||
echo ; print ${j} pairs found.</syntaxhighlight> |
|||
{{out}}<pre> |
|||
Examples: |
|||
1. damon nomad |
|||
2. kramer remark |
|||
3. lager regal |
|||
4. leper repel |
|||
5. lever revel |
|||
158 pairs found.</pre> |
|||
=={{header|Lasso}}== |
|||
<syntaxhighlight lang="lasso">local( |
|||
words = string(include_url('http://www.puzzlers.org/pub/wordlists/unixdict.txt')) -> split('\n'), |
|||
semordnilaps = array, |
|||
found_size, |
|||
example, |
|||
haveexamples = false, |
|||
examples = array |
|||
) |
|||
#words -> removeall('') |
|||
with word in #words do { |
|||
local(reversed = string(#word) -> reverse&) |
|||
if(not(#word == #reversed) and not(#semordnilaps >> #word) and not(#semordnilaps >> #reversed) and #words >> #reversed) => { |
|||
#semordnilaps -> insert(#word = #reversed) |
|||
} |
|||
} |
|||
#found_size = #semordnilaps -> size |
|||
while(not(#haveexamples)) => { |
|||
#example = #semordnilaps -> get(integer_random(#found_size, 1)) |
|||
not(#examples >> #example -> name) ? #examples -> insert(#example) |
|||
#examples -> size >= 5 ? #haveexamples = true |
|||
} |
|||
'Total found: ' |
|||
#found_size |
|||
'<br />' |
|||
#examples</syntaxhighlight> |
|||
{{out}} |
|||
<pre>Total found: 158 |
|||
array((dew = wed), (are = era), (den = ned), (oat = tao), (eel = lee))</pre> |
|||
=={{header|Liberty BASIC}}== |
=={{header|Liberty BASIC}}== |
||
<syntaxhighlight lang="lb"> |
|||
<lang lb> |
|||
print "Loading dictionary." |
print "Loading dictionary." |
||
open "unixdict.txt" for input as #1 |
open "unixdict.txt" for input as #1 |
||
Line 728: | Line 2,072: | ||
Next i |
Next i |
||
End Function |
End Function |
||
</syntaxhighlight> |
|||
</lang> |
|||
{{out}} |
|||
Output: |
|||
<pre> |
<pre> |
||
able / elba |
able / elba |
||
Line 740: | Line 2,084: | ||
</pre> |
</pre> |
||
=={{header| |
=={{header|Lua}}== |
||
<syntaxhighlight lang="lua">#!/usr/bin/env lua |
|||
<lang Mathematica>data = Import["http://www.puzzlers.org/pub/wordlists/unixdict.txt", "List"]; |
|||
-- allow dictionary file and sample size to be specified on command line |
|||
result = DeleteDuplicates[ Select[data, MemberQ[data, StringReverse[#]] && # =!= StringReverse[#] &], (# ===StringReverse[#2]) &]; |
|||
local dictfile = arg[1] or "unixdict.txt" |
|||
Print[Length[result], Take[result, 5]]</lang> |
|||
local sample_size = arg[2] or 5; |
|||
-- read dictionary |
|||
local f = assert(io.open(dictfile, "r")) |
|||
local dict = {} |
|||
for line in f:lines() do |
|||
dict[line] = line:reverse() |
|||
end |
|||
f:close() |
|||
-- find the semordnilaps |
|||
local semordnilaps = {} |
|||
for fwd, rev in pairs(dict) do |
|||
if dict[rev] and fwd < rev then |
|||
table.insert(semordnilaps, {fwd,rev}) |
|||
end |
|||
end |
|||
-- print the report |
|||
print("There are " .. #semordnilaps .. " semordnilaps in " .. dictfile .. ". Here are " .. sample_size .. ":") |
|||
math.randomseed( os.time() ) |
|||
for i = 1, sample_size do |
|||
local j |
|||
repeat |
|||
j = math.random(1,#semordnilaps) |
|||
until semordnilaps[j] |
|||
local f, r = unpack(semordnilaps[j]) |
|||
semordnilaps[j] = nil |
|||
print(f .. " -> " .. r) |
|||
end</syntaxhighlight> |
|||
{{out}} |
|||
<pre>There are 158 semordnilaps in unixdict.txt. Here are 5: |
|||
deer -> reed |
|||
rat -> tar |
|||
pus -> sup |
|||
meet -> teem |
|||
bat -> tab</pre> |
|||
=={{header|M2000 Interpreter}}== |
|||
<syntaxhighlight lang="m2000 interpreter"> |
|||
Module semordnilaps { |
|||
Document d$ |
|||
Load.Doc d$, "unixdict.txt" |
|||
Inventory MyDict, Result |
|||
Function s$(a$) { |
|||
m$=a$:k=Len(a$):for i=1 to k {insert i, 1 m$=mid$(a$, k, 1):k--} : =m$ |
|||
} |
|||
L=Doc.Par(d$) |
|||
m=Paragraph(d$, 0) |
|||
If not Forward(d$,m) then exit |
|||
i=1 |
|||
While m { |
|||
word$=Paragraph$(d$,(m)) |
|||
Print Over $(0, 10), str$(i/L,"##0.00%"), Len(Result) : i++ |
|||
If Exist(MyDict, word$) then { if Exist(Result, word$) Then exit |
|||
Append Result, word$ |
|||
} Else.if len(word$)>1 Then p$=s$(word$):if p$<>word$ Then Append MyDict, p$ |
|||
} |
|||
Print |
|||
Print "Semordnilap pairs: ";Len(Result) |
|||
For i=0 to len(Result)-1 step len(Result) div 5 { |
|||
p$=Eval$(Result, i) |
|||
Print s$(p$);"/";p$ |
|||
} |
|||
} |
|||
semordnilaps |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre style="height:30ex;overflow:scroll"> |
|||
Semordnilap pairs: 158 |
|||
ac/ca |
|||
nap/pan |
|||
cos/soc |
|||
loot/tool |
|||
way/yaw |
|||
</pre > |
|||
=={{header|Mathematica}}/{{header|Wolfram Language}}== |
|||
<syntaxhighlight lang="mathematica">data = Import["http://www.puzzlers.org/pub/wordlists/unixdict.txt", "List"]; |
|||
result = DeleteDuplicates[ Select[data, MemberQ[data, StringReverse[#]] |
|||
&& # =!= StringReverse[#] &], (# ===StringReverse[#2]) &]; |
|||
Print[Length[result], Take[result, 5]]</syntaxhighlight> |
|||
{{out}} |
{{out}} |
||
<pre>158 {able,abut,ac,ah,al}</pre> |
<pre>158 {able,abut,ac,ah,al}</pre> |
||
=={{header|Nanoquery}}== |
|||
{{trans|Java}} |
|||
<syntaxhighlight lang="nanoquery">import Nanoquery.IO |
|||
def reverse_str(string) |
|||
ret = "" |
|||
for char in list(string).reverse() |
|||
ret += char |
|||
end |
|||
return ret |
|||
end |
|||
lst = split(new(File).open("rosetta-code/unixdict.txt").readAll(), "\n") |
|||
seen = list() |
|||
count = 0 |
|||
for w in lst |
|||
w = lower(w) |
|||
r = reverse_str(w) |
|||
if r in seen |
|||
count += 1 |
|||
if count <= 5 |
|||
print format("%-10s %-10s\n", w, r) |
|||
end |
|||
else |
|||
seen.append(w) |
|||
end |
|||
end |
|||
println "\nSemordnilap pairs found: " + count</syntaxhighlight> |
|||
{{out}} |
|||
<pre>ca ac |
|||
dab bad |
|||
diva avid |
|||
dna and |
|||
drab bard |
|||
Semordnilap pairs found: 158</pre> |
|||
=={{header|NetRexx}}== |
=={{header|NetRexx}}== |
||
{{Trans|REXX}} |
{{Trans|REXX}} |
||
< |
<syntaxhighlight lang="netrexx">/* NetRexx */ |
||
options replace format comments java crossref symbols nobinary |
options replace format comments java crossref symbols nobinary |
||
Line 779: | Line 2,246: | ||
Say pi 'words in' fid 'have a palindrome' /* total number found */ |
Say pi 'words in' fid 'have a palindrome' /* total number found */ |
||
return |
return |
||
</syntaxhighlight> |
|||
</lang> |
|||
{{out}} |
|||
'''Output:''' |
|||
<pre> |
<pre> |
||
ac ca |
ac ca |
||
Line 790: | Line 2,257: | ||
</pre> |
</pre> |
||
=={{header| |
=={{header|NewLisp}}== |
||
<syntaxhighlight lang="newlisp"> |
|||
;;; Get the words as a list, splitting at newline |
|||
(setq data |
|||
(parse (get-url "http://wiki.puzzlers.org/pub/wordlists/unixdict.txt") |
|||
"\n")) |
|||
; |
|||
;;; destructive reverse wrapped into a function |
|||
(define (get-reverse x) (reverse x)) |
|||
; |
|||
;;; stack of the results |
|||
(setq res '()) |
|||
; |
|||
;;; Find the semordlinap and put them on the stack |
|||
(dolist (x data) |
|||
(let (y (get-reverse x)) |
|||
(if (and |
|||
(member y data) ; reverse is a dictionary word |
|||
(!= x y) ; but not a palindrome |
|||
(not (member y res))) ; not already stacked |
|||
(push x res -1)))) |
|||
; |
|||
;;; Count results |
|||
(println "Found " (length res) " pairs.") |
|||
(println) |
|||
;;; Show the longest ones |
|||
(dolist (x res) |
|||
(if (> (length x) 4) (println x " -- " (get-reverse x)))) |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
Found 158 pairs. |
|||
damon -- nomad |
|||
<lang ocaml>module StrSet = Set.Make(String) |
|||
kramer -- remark |
|||
lager -- regal |
|||
leper -- repel |
|||
lever -- revel |
|||
</pre> |
|||
=={{header|Nim}}== |
|||
<syntaxhighlight lang="nim">import strutils, sequtils, sets, algorithm |
|||
proc reversed(s: string): string = |
|||
result = newString(s.len) |
|||
for i, c in s: |
|||
result[s.high - i] = c |
|||
let |
|||
words = readFile("unixdict.txt").strip().splitLines() |
|||
wordset = words.toHashSet |
|||
revs = words.map(reversed) |
|||
var pairs = zip(words, revs).filterIt(it[0] < it[1] and it[1] in wordset) |
|||
echo "Total number of semordnilaps: ", pairs.len |
|||
pairs = pairs.sortedByIt(it[0].len) |
|||
echo pairs[^5..^1]</syntaxhighlight> |
|||
{{out}} |
|||
<pre>Total number of semordnilaps: 158 |
|||
@[(a: damon, b: nomad), (a: lager, b: regal), (a: leper, b: repel), (a: lever, b: revel), (a: kramer, b: remark)]</pre> |
|||
=={{header|OCaml}}== |
|||
<syntaxhighlight lang="ocaml">module StrSet = Set.Make(String) |
|||
let str_rev s = |
let str_rev s = |
||
let len = String.length s in |
let len = String.length s in |
||
let r = |
let r = Bytes.create len in |
||
for i = 0 to len - 1 do |
for i = 0 to len - 1 do |
||
Bytes.set r i s.[len - 1 - i] |
|||
done; |
done; |
||
Bytes.to_string r |
|||
(r) |
|||
let input_line_opt ic = |
let input_line_opt ic = |
||
Line 825: | Line 2,353: | ||
let (word, rev) = List.nth pairs (Random.int len) in |
let (word, rev) = List.nth pairs (Random.int len) in |
||
Printf.printf " %s %s\n" word rev |
Printf.printf " %s %s\n" word rev |
||
done</ |
done</syntaxhighlight> |
||
{{out}} |
|||
<pre> |
|||
Semordnilap pairs: 158 |
|||
tar rat |
|||
sera ares |
|||
sub bus |
|||
tic cit |
|||
mid dim |
|||
</pre> |
|||
=={{header|Octave}}== |
|||
<syntaxhighlight lang="octave">a = strsplit(fileread("unixdict.txt"), "\n"); |
|||
a = intersect(a, cellfun(@fliplr, a, "UniformOutput", false)); |
|||
a = a(arrayfun(@(i) ismember(fliplr(a{i}), a(i+1:length(a))), 1:length(a))); |
|||
length(a) |
|||
arrayfun(@(i) printf("%s %s\n", a{i}, fliplr(a{i})), 1:5)</syntaxhighlight> |
|||
'''Output:''' |
|||
<pre>ans = 158 |
|||
able elba |
|||
abut tuba |
|||
ac ca |
|||
ah ha |
|||
al la</pre> |
|||
=={{header|Oforth}}== |
|||
<syntaxhighlight lang="oforth">: semordnilap |
|||
| w wr wrds | |
|||
ListBuffer new ->wrds |
|||
ListBuffer new |
|||
File new("unixdict.txt") forEach: w [ |
|||
wrds include(w reverse dup ->wr) ifTrue: [ [wr, w] over add ] |
|||
w wr < ifTrue: [ wrds add(w) ] |
|||
] ;</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
>semordnilap dup size println left(5) println |
|||
158 |
|||
[[ac, ca], [bad, dab], [avid, diva], [and, dna], [bard, drab]] |
|||
</pre> |
|||
=={{header|Perl}}== |
=={{header|Perl}}== |
||
< |
<syntaxhighlight lang="perl">while (<>) { |
||
chomp; |
chomp; |
||
my $r = reverse; |
my $r = reverse; |
||
Line 834: | Line 2,407: | ||
} |
} |
||
print "$c\n"</ |
print "$c\n"</syntaxhighlight> |
||
=={{header| |
=={{header|Phix}}== |
||
<!--<syntaxhighlight lang="phix">(phixonline)--> |
|||
{{works with|niecza|2012-09-07}} |
|||
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span> |
|||
This is written in the "sigilless" style in order to fool people into thinking that Perl 6 is elegant. <tt>:-)</tt> |
|||
<span style="color: #004080;">sequence</span> <span style="color: #000000;">words</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">unix_dict</span><span style="color: #0000FF;">(),</span> <span style="color: #000000;">semordnilap</span><span style="color: #0000FF;">={}</span> |
|||
<lang perl6>my \words = set slurp("unixdict.txt").lines; |
|||
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">words</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span> |
|||
<span style="color: #004080;">string</span> <span style="color: #000000;">word</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">words</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> |
|||
<span style="color: #008080;">if</span> <span style="color: #7060A8;">rfind</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">reverse</span><span style="color: #0000FF;">(</span><span style="color: #000000;">word</span><span style="color: #0000FF;">),</span><span style="color: #000000;">words</span><span style="color: #0000FF;">,</span><span style="color: #000000;">i</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span> |
|||
<span style="color: #000000;">semordnilap</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">semordnilap</span><span style="color: #0000FF;">,</span><span style="color: #000000;">word</span><span style="color: #0000FF;">)</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span> |
|||
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%d semordnilap found, the first five are:\n"</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">semordnilap</span><span style="color: #0000FF;">))</span> |
|||
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">5</span> <span style="color: #008080;">do</span> |
|||
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%s - %s\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">semordnilap</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">],</span><span style="color: #7060A8;">reverse</span><span style="color: #0000FF;">(</span><span style="color: #000000;">semordnilap</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">])})</span> |
|||
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span> |
|||
<!--</syntaxhighlight>--> |
|||
{{out}} |
|||
<pre> |
|||
158 semordnilap found, the first five are: |
|||
ca - ac |
|||
dab - bad |
|||
diva - avid |
|||
dna - and |
|||
drab - bard |
|||
</pre> |
|||
=={{header|Phixmonti}}== |
|||
my \sems = gather for words.list -> \word { |
|||
<syntaxhighlight lang="Phixmonti">include ..\Utilitys.pmt |
|||
my \drow = word.flip; |
|||
take [word,drow] if drow ∈ words and drow lt word; |
|||
} |
|||
( ) ( ) |
|||
.say for +sems, sems.pick(5);</lang> |
|||
"unixdict.txt" "r" fopen var f |
|||
true while |
|||
f fgets |
|||
dup -1 == if |
|||
drop |
|||
f fclose |
|||
false |
|||
else |
|||
-1 del |
|||
0 put |
|||
true |
|||
endif |
|||
endwhile |
|||
len while |
|||
len 1 > if |
|||
pop swap reverse find dup |
|||
if |
|||
extract rot swap 0 put swap |
|||
else |
|||
drop |
|||
endif |
|||
true |
|||
else |
|||
drop false |
|||
endif |
|||
endwhile |
|||
( 50 54 ) for get dup reverse print " -> " print ? endfor nl |
|||
len print " pairs" ?</syntaxhighlight> |
|||
{{out}} |
{{out}} |
||
<pre> |
<pre>dew -> wed |
||
dial -> laid |
|||
golf flog |
|||
dim -> mid |
|||
repel leper |
|||
dine -> enid |
|||
top pot |
|||
dog -> god |
|||
live evil |
|||
yap pay</pre> |
|||
158 pairs |
|||
We will not comment on the hilarity of some of these... |
|||
=== Press any key to exit ===</pre> |
|||
=={{header|PHP}}== |
=={{header|PHP}}== |
||
{{trans| |
{{trans|Raku}} |
||
< |
<syntaxhighlight lang="php"><?php |
||
// Read dictionary into array |
// Read dictionary into array |
||
$dictionary = array_fill_keys(file( |
$dictionary = array_fill_keys(file( |
||
Line 872: | Line 2,497: | ||
// array_rand() returns keys, not values |
// array_rand() returns keys, not values |
||
foreach (array_rand($words, 5) as $word) |
foreach (array_rand($words, 5) as $word) |
||
echo "$word $words[$word]\n";</ |
echo "$word $words[$word]\n";</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre>158 |
<pre>158 |
||
Line 880: | Line 2,505: | ||
tram mart |
tram mart |
||
un nu</pre> |
un nu</pre> |
||
=={{header|PicoLisp}}== |
|||
<syntaxhighlight lang="picolisp">(let Semordnilap |
|||
(mapcon |
|||
'((Lst) |
|||
(when (member (reverse (car Lst)) (cdr Lst)) |
|||
(cons (pack (car Lst))) ) ) |
|||
(make (in "unixdict.txt" (while (line) (link @)))) ) |
|||
(println (length Semordnilap) (head 5 Semordnilap)) )</syntaxhighlight> |
|||
{{out}} |
|||
<pre>158 ("able" "abut" "ac" "ah" "al")</pre> |
|||
=={{header|PL/I}}== |
=={{header|PL/I}}== |
||
<syntaxhighlight lang="pl/i"> |
|||
<lang PL/I> |
|||
find: procedure options (main); /* 20/1/2013 */ |
find: procedure options (main); /* 20/1/2013 */ |
||
declare word character (20) varying controlled; |
declare word character (20) varying controlled; |
||
Line 923: | Line 2,560: | ||
end; |
end; |
||
end find; |
end find; |
||
</syntaxhighlight> |
|||
</lang> |
|||
<pre> |
<pre> |
||
There are 158 pairs. |
There are 158 pairs. |
||
Line 935: | Line 2,572: | ||
won now |
won now |
||
</pre> |
</pre> |
||
=={{header|PowerShell}}== |
|||
<syntaxhighlight lang="powershell"> |
|||
function Reverse-String ([string]$String) |
|||
{ |
|||
[char[]]$output = $String.ToCharArray() |
|||
[Array]::Reverse($output) |
|||
$output -join "" |
|||
} |
|||
[string]$url = "http://www.puzzlers.org/pub/wordlists/unixdict.txt" |
|||
[string]$out = ".\unixdict.txt" |
|||
(New-Object System.Net.WebClient).DownloadFile($url, $out) |
|||
[string[]]$file = Get-Content -Path $out |
|||
[hashtable]$unixDict = @{} |
|||
[hashtable]$semordnilap = @{} |
|||
foreach ($line in $file) |
|||
{ |
|||
if ($line.Length -gt 1) |
|||
{ |
|||
$unixDict.Add($line,"") |
|||
} |
|||
[string]$reverseLine = Reverse-String $line |
|||
if ($reverseLine -notmatch $line -and $unixDict.ContainsKey($reverseLine)) |
|||
{ |
|||
$semordnilap.Add($line,$reverseLine) |
|||
} |
|||
} |
|||
$semordnilap |
|||
"`nSemordnilap count: {0}" -f ($semordnilap.GetEnumerator() | Measure-Object).Count |
|||
</syntaxhighlight> |
|||
{{Out}} |
|||
<pre> |
|||
Name Value |
|||
---- ----- |
|||
nil lin |
|||
regal lager |
|||
tom mot |
|||
. |
|||
. |
|||
. |
|||
peek keep |
|||
soma amos |
|||
nob bon |
|||
Semordnilap count: 158 |
|||
</pre> |
|||
=={{header|PureBasic}}== |
|||
<syntaxhighlight lang="purebasic">If OpenConsole("")=0 : End 1 : EndIf |
|||
If ReadFile(0,"./Data/unixdict.txt")=0 : End 2 : EndIf |
|||
NewList dict$() |
|||
While Eof(0)=0 : AddElement(dict$()) : dict$()=Trim(ReadString(0)) : Wend : CloseFile(0) |
|||
While FirstElement(dict$()) |
|||
buf$=dict$() : DeleteElement(dict$()) |
|||
If buf$="" : Continue : EndIf |
|||
xbuf$=ReverseString(buf$) |
|||
ForEach dict$() |
|||
If xbuf$=dict$() |
|||
res$+buf$+" / "+xbuf$+#LF$ |
|||
Break |
|||
EndIf |
|||
Next |
|||
Wend |
|||
PrintN("Semordnilap pairs found: "+Str(CountString(res$,#LF$))) |
|||
For k=1 To 5 |
|||
If k=1 : PrintN(~"\nFirst 5 pairs: "+StringField(res$,k,#LF$)) : Continue : EndIf |
|||
PrintN(Space(15)+StringField(res$,k,#LF$)) |
|||
Next |
|||
Input()</syntaxhighlight> |
|||
{{out}} |
|||
<pre>Semordnilap pairs found: 158 |
|||
First 5 pairs: able / elba |
|||
abut / tuba |
|||
ac / ca |
|||
ah / ha |
|||
al / la</pre> |
|||
=={{header|Python}}== |
=={{header|Python}}== |
||
===Idiomatic=== |
===Idiomatic=== |
||
< |
<syntaxhighlight lang="python">>>> with open('unixdict.txt') as f: |
||
wordset = set(f.read().strip().split()) |
wordset = set(f.read().strip().split()) |
||
>>> revlist = (''.join(word[::-1]) for word in wordset) |
>>> revlist = (''.join(word[::-1]) for word in wordset) |
||
>>> pairs = set(( |
>>> pairs = set((word, rev) for word, rev in zip(wordset, revlist) |
||
if |
if word < rev and rev in wordset) |
||
>>> len(pairs) |
>>> len(pairs) |
||
158 |
158 |
||
>>> sorted(pairs, key=lambda p: (len(p[0]), p))[-5:] |
>>> sorted(pairs, key=lambda p: (len(p[0]), p))[-5:] |
||
[('damon', 'nomad'), ('lager', 'regal'), ('leper', 'repel'), ('lever', 'revel'), ('kramer', 'remark')] |
[('damon', 'nomad'), ('lager', 'regal'), ('leper', 'repel'), ('lever', 'revel'), ('kramer', 'remark')] |
||
>>> </ |
>>> </syntaxhighlight> |
||
===As a fold, using reduce=== |
|||
{{trans|Perl 6}} |
|||
{{Works with|Python|3.7}} |
|||
<lang python>import os |
|||
<syntaxhighlight lang="python">'''Dictionary words paired by equivalence under reversal''' |
|||
from functools import (reduce) |
|||
from itertools import (chain) |
|||
import urllib.request |
|||
# semordnilaps :: [String] -> [String] |
|||
def semordnilaps(xs): |
|||
'''The subset of words in a list which |
|||
are paired (by equivalence under reversal) |
|||
with other words in that list. |
|||
''' |
|||
def go(tpl, w): |
|||
(s, ws) = tpl |
|||
if w[::-1] in s: |
|||
return (s, ws + [w]) |
|||
else: |
|||
s.add(w) |
|||
return (s, ws) |
|||
return reduce(go, xs, (set(), []))[1] |
|||
# TEST ---------------------------------------------------- |
|||
def main(): |
|||
'''Test''' |
|||
url = 'http://wiki.puzzlers.org/pub/wordlists/unixdict.txt' |
|||
ws = semordnilaps( |
|||
urllib.request.urlopen( |
|||
url |
|||
).read().splitlines() |
|||
) |
|||
print( |
|||
fTable( |
|||
__doc__ + ':\n\n(longest of ' + |
|||
str(len(ws)) + ' in ' + url + ')\n' |
|||
)(snd)(fst)(identity)( |
|||
sorted( |
|||
concatMap( |
|||
lambda x: ( |
|||
lambda s=x.decode('utf8'): [ |
|||
(s, s[::-1]) |
|||
] if 4 < len(x) else [] |
|||
)() |
|||
)(ws), |
|||
key=compose(len)(fst), |
|||
reverse=True |
|||
) |
|||
) |
|||
) |
|||
# GENERIC ------------------------------------------------- |
|||
# compose (<<<) :: (b -> c) -> (a -> b) -> a -> c |
|||
def compose(g): |
|||
'''Right to left function composition.''' |
|||
return lambda f: lambda x: g(f(x)) |
|||
# concatMap :: (a -> [b]) -> [a] -> [b] |
|||
def concatMap(f): |
|||
'''A concatenated list over which a function has been mapped. |
|||
The list monad can be derived by using a function f which |
|||
wraps its output in a list, |
|||
(using an empty list to represent computational failure).''' |
|||
return lambda xs: list( |
|||
chain.from_iterable(map(f, xs)) |
|||
) |
|||
# FORMATTING ---------------------------------------------- |
|||
# fTable :: String -> (a -> String) -> |
|||
# (b -> String) -> (a -> b) -> [a] -> String |
|||
def fTable(s): |
|||
'''Heading -> x display function -> fx display function -> |
|||
f -> xs -> tabular string. |
|||
''' |
|||
def go(xShow, fxShow, f, xs): |
|||
ys = [xShow(x) for x in xs] |
|||
w = max(map(len, ys)) |
|||
return s + '\n' + '\n'.join(map( |
|||
lambda x, y: y.rjust(w, ' ') + ' -> ' + fxShow(f(x)), |
|||
xs, ys |
|||
)) |
|||
return lambda xShow: lambda fxShow: lambda f: lambda xs: go( |
|||
xShow, fxShow, f, xs |
|||
) |
|||
# fst :: (a, b) -> a |
|||
def fst(tpl): |
|||
'''First member of a pair.''' |
|||
return tpl[0] |
|||
# identity :: a -> a |
|||
def identity(x): |
|||
'''The identity function.''' |
|||
return x |
|||
# snd :: (a, b) -> b |
|||
def snd(tpl): |
|||
'''Second member of a pair.''' |
|||
return tpl[1] |
|||
if __name__ == '__main__': |
|||
main()</syntaxhighlight> |
|||
{{Out}} |
|||
<pre>Dictionary words paired by equivalence under reversal: |
|||
(longest of 158 in http://wiki.puzzlers.org/pub/wordlists/unixdict.txt) |
|||
kramer -> remark |
|||
damon -> nomad |
|||
lager -> regal |
|||
leper -> repel |
|||
lever -> revel</pre> |
|||
===Lazy generator=== |
|||
Requires the <code>requests</code> library. |
|||
<syntaxhighlight lang="python">import sys |
|||
import random |
import random |
||
import requests |
|||
# Load file and put it to dictionary as set |
|||
dictionary = {word.rstrip(os.linesep) for word in open('unixdict.txt')} |
|||
URL = 'http://wiki.puzzlers.org/pub/wordlists/unixdict.txt' |
|||
def find_semordnilaps(word_generator): |
|||
# Keys in this dict are the words seen so far, reversed. |
|||
# Values are booleans determining whether we have seen (and yielded) |
|||
# the key, so that we don't yield the same word twice. |
|||
seen = {} |
|||
for word in word_generator: |
|||
if word not in seen: |
|||
reversed_word = word[::-1] |
|||
seen[reversed_word] = False # not yielded yet |
|||
else: |
|||
yielded_already = seen[word] |
|||
if not yielded_already: |
|||
yield word |
|||
seen[word] = True # the word has been yielded |
|||
def url_lines(url): |
|||
with requests.get(url, stream=True) as req: |
|||
yield from req.iter_lines(decode_unicode=True) |
|||
def main(url=URL, num_of_examples=5): |
|||
semordnilaps_generator = find_semordnilaps(url_lines(url)) |
|||
semordnilaps = list(semordnilaps_generator) |
|||
example_words = random.choices(semordnilaps, k=int(num_of_examples)) |
|||
example_pairs = ((word, word[::-1]) for word in example_words) |
|||
print( |
|||
f'found {len(semordnilaps)} semordnilap words:', |
|||
* ['%s %s' % p for p in example_pairs]+['...'], |
|||
sep='\n' |
|||
) |
|||
return semordnilaps |
|||
if __name__ == '__main__': |
|||
main(*sys.argv[1:]) |
|||
</syntaxhighlight> |
|||
{{Out}} |
|||
# List of results |
|||
<pre> |
|||
results = [] |
|||
found 158 semordnilap words: |
|||
for word in dictionary: |
|||
mug gum |
|||
# [::-1] reverses string |
|||
revel lever |
|||
reversed_word = word[::-1] |
|||
gab bag |
|||
if reversed_word in dictionary and word > reversed_word: |
|||
lime emil |
|||
results.append((word, reversed_word)) |
|||
lag gal |
|||
... |
|||
</pre> |
|||
=={{header|Quackery}}== |
|||
<syntaxhighlight lang="quackery"> [] |
|||
$ "rosetta/unixdict.txt" sharefile drop |
|||
nest$ |
|||
[ behead reverse swap |
|||
2dup find over found iff |
|||
[ dip [ nested join ] ] |
|||
else nip |
|||
dup [] = until ] |
|||
drop |
|||
say "Number of semordnilaps: " |
|||
dup size echo cr |
|||
sortwith [ size swap size > ] |
|||
5 split drop |
|||
say "Five longest: " |
|||
witheach |
|||
[ dup echo$ say "<->" |
|||
reverse echo$ sp ]</syntaxhighlight> |
|||
print(len(results)) |
|||
for words in random.sample(results, 5): |
|||
print(' '.join(words))</lang> |
|||
{{out}} |
{{out}} |
||
<pre>158 |
|||
<pre>Number of semordnilaps: 158 |
|||
nob bon |
|||
Five longest: remark<->kramer nomad<->damon regal<->lager repel<->leper revel<->lever |
|||
mac cam |
|||
</pre> |
|||
dub bud |
|||
viva aviv |
|||
nomad damon</pre> |
|||
=={{header|Racket}}== |
|||
<syntaxhighlight lang="racket"> |
|||
#lang racket |
|||
(define seen (make-hash)) |
|||
(define semordnilaps '()) |
|||
(call-with-input-file "/usr/share/dict/words" |
|||
(λ(i) (for ([l (in-lines i)]) |
|||
(define r (list->string (reverse (string->list l)))) |
|||
(unless (equal? r l) |
|||
(hash-set! seen l #t) |
|||
(when (hash-ref seen r #f) |
|||
(set! semordnilaps (cons (list r l) semordnilaps))))))) |
|||
(printf "Total semordnilaps found: ~s\n" (length semordnilaps)) |
|||
(printf "The five longest ones:\n") |
|||
(for ([s (take (sort semordnilaps > #:key (compose1 string-length car)) 5)]) |
|||
(apply printf " ~s ~s\n" s)) |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
Total semordnilaps found: 1961 |
|||
The five longest ones: |
|||
"desserts" "stressed" |
|||
"dioramas" "samaroid" |
|||
"redrawer" "rewarder" |
|||
"dessert" "tressed" |
|||
"pat-pat" "tap-tap" |
|||
</pre> |
|||
=={{header|Raku}}== |
|||
(formerly Perl 6) |
|||
{{works with|rakudo|2015-10-26}} |
|||
<syntaxhighlight lang="raku" line>my $words = set slurp("unixdict.txt").lines; |
|||
my @sems = gather for $words.flat -> $word { |
|||
my $drow = $word.key.flip; |
|||
take $drow if $drow ∈ $words and $drow lt $word; |
|||
} |
|||
say $_ ~ ' ' ~ $_.flip for @sems.pick(5);</syntaxhighlight> |
|||
{{out}} |
|||
<pre>abut tuba |
|||
avid diva |
|||
bard drab |
|||
loot tool |
|||
part trap</pre> |
|||
=={{header|REXX}}== |
=={{header|REXX}}== |
||
===version 1=== |
===version 1=== |
||
< |
<syntaxhighlight lang="rexx">/* REXX *************************************************************** |
||
* 07.09.2012 Walter Pachl |
* 07.09.2012 Walter Pachl |
||
**********************************************************************/ |
**********************************************************************/ |
||
Line 995: | Line 2,963: | ||
End |
End |
||
End |
End |
||
Say pi 'words in' fid 'have a palindrome' /* total number found */</ |
Say pi 'words in' fid 'have a palindrome' /* total number found */</syntaxhighlight> |
||
{{out}} |
|||
Output: |
|||
<pre> |
<pre> |
||
ac ca |
ac ca |
||
Line 1,008: | Line 2,976: | ||
===version 2=== |
===version 2=== |
||
This REXX version makes use of sparse (stemmed) arrays. |
This REXX version makes use of sparse (stemmed) arrays. |
||
<br><br>The dictionary file wasn't assumed to be in any particular case (upper/lower/mixed). |
|||
<br>For instance, '''DNA''' & '''and''' would be considered palindromes. |
|||
<br>The UNIXDICT dictionary specified to be used ''is'' all lowercase, however, but the REXX |
|||
<br>program assumes that the words may be in any case. |
|||
<br><br>The order of the words in the dictionary isn't important. |
|||
<br>Any blank lines or ''duplicate words'' in the dictionary are ignored (as duplicate words wouldn't make them unique). |
|||
<br>Any leading or trailing blanks are also ignored (as well as tab characters or other whitespace). |
|||
<br>The palindrome pairs are shown with a comma delimiter in case there're phrases (words with imbedded blanks like Sing Sing). |
|||
<br>The (first five) palindrome pairs are shown as they are specified (respective to case) in the dictionary. |
|||
<lang rexx>/*REXX program finds palindrome pairs using a dictionary (UNIXDICT.TXT)*/ |
|||
#=0 /*number of palindromes (so far).*/ |
|||
parse arg iFID .; if iFID=='' then iFID='UNIXDICT.TXT' /*use default?*/ |
|||
@.= /*caseless non-duplicated words. */ |
|||
do while lines(ifid)\==0; _=linein(iFID); u=translate(space(_,0)) |
|||
if length(u)<2 | @.u\=='' then iterate /*can't be a unique pal.*/ |
|||
r=reverse(u) |
|||
if @.r\=='' then do; #=#+1 /*found palindrome pair.*/ |
|||
if #<6 then say @.r',' _ /*only list first 5 pals*/ |
|||
end |
|||
@.u=_ |
|||
end /*while*/ |
|||
say /*a unique palindrome pair = a semordnilap*/ |
|||
say "There're" # 'unique palindrome pairs in the dictionary file:' iFID |
|||
/*stick a fork in it, we're done.*/</lang> |
|||
'''output''' when using the default dictionary as the input |
|||
<pre style="overflow:scroll"> |
|||
ac, ca |
|||
bad, dab |
|||
avid, diva |
|||
and, dna |
|||
bard, drab |
|||
The dictionary file wasn't assumed to be in any particular case (upper/lower/mixed). |
|||
There're 158 unique palindrome pairs in the dictionary file: UNIXDICT.TXT |
|||
For instance, '''DNA''' <big> & </big> '''and''' would be considered semordnilaps, even though their ''case'' is different. |
|||
The UNIXDICT dictionary specified to be used ''is'' all lowercase, however, but the REXX program assumes that the |
|||
<br>words may be in any ''case'' (lowercase/uppercase/mixedcased). |
|||
The order of the words in the dictionary isn't important. |
|||
Any blank lines or ''duplicate words'' in the dictionary are ignored (as duplicate words wouldn't make them unique). |
|||
Any leading, trailing, or imbedded blanks are also ignored (as well as tab characters or other whitespace). |
|||
The semordnilap word pairs are shown with a comma delimiter in case there are phrases (words with imbedded |
|||
<br>blanks like ''Sing Sing''). |
|||
The (first five) semordnilap pairs are shown as they are specified/defined (respective to case) in the dictionary. |
|||
<syntaxhighlight lang="rexx">/*REXX program finds N semordnilap pairs using a specified dictionary (UNIXDICT.TXT).*/ |
|||
parse arg n iFID . /*obtain optional argument from the CL.*/ |
|||
if n=='' | n=="," then n= 5 /*Not specified? Then use the default.*/ |
|||
if iFID=='' | iFID=="," then iFID='UNIXDICT.TXT' /* " " " " " " */ |
|||
#= 0 /*number of semordnilaps (so far). */ |
|||
@.= /*caseless non─duplicated dict. words. */ |
|||
do while lines(iFID)\==0; _= linein(iFID); u= space(_, 0); upper u /*get a word.*/ |
|||
if length(u)<2 | @.u\=='' then iterate /*word can't be a unique semordnilap. */ |
|||
r= reverse(u) /*obtain reverse of the dictionary word*/ |
|||
if @.r\=='' then do; #= # + 1 /*found a semordnilap word; bump count.*/ |
|||
if #<=n then say right(@.r, max(32, length(@.r) ) )',' u |
|||
end |
|||
@.u= _ /*define reverse of the dictionary word*/ |
|||
end /*while*/ /*stick a fork in it, we're all done. */ |
|||
say |
|||
say "There're " # ' unique semordnilap pairs in the dictionary file: ' iFID</syntaxhighlight> |
|||
{{out|output|text= when using the default inputs:}} |
|||
<pre> |
|||
ac, ca |
|||
bad, dab |
|||
avid, diva |
|||
and, dna |
|||
bard, drab |
|||
There're 158 unique semordnilap pairs in the dictionary file: UNIXDICT.TXT |
|||
</pre> |
|||
=={{header|Ring}}== |
|||
<syntaxhighlight lang="ring"> |
|||
# Project : Semordnilap |
|||
load "stdlib.ring" |
|||
nr = 0 |
|||
num = 0 |
|||
aList = file2list("C:\Ring\CalmoSoft\unixdict.txt") |
|||
for n = 1 to len(aList) |
|||
bool = semordnilap(aList[n]) |
|||
if (bool > 0 and nr > n) |
|||
num = num + 1 |
|||
if num % 31 = 0 |
|||
see aList[n] + " " + aList[nr] + nl |
|||
ok |
|||
ok |
|||
next |
|||
see "Total number of unique pairs = " + num + nl |
|||
func semordnilap(aString) |
|||
bString = "" |
|||
for i=len(aString) to 1 step -1 |
|||
bString = bString + aString[i] |
|||
next |
|||
nr = find(aList,bString) |
|||
return nr |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
brag garb |
|||
edit tide |
|||
it ti |
|||
mit tim |
|||
suez zeus |
|||
Total number of unique pairs = 158 |
|||
</pre> |
</pre> |
||
=={{header|Ruby}}== |
=={{header|Ruby}}== |
||
Note: An alternative (old fashioned) method of solving this task (not using a Set as done by other solutions) is to produce 2 sorted files and walk through them. This can be done entirly on disk if required, when done in memory it is faster than a set for large samples.--[[User:Nigel Galloway|Nigel Galloway]] 11:12, 17 September 2012 (UTC) |
Note: An alternative (old fashioned) method of solving this task (not using a Set as done by other solutions) is to produce 2 sorted files and walk through them. This can be done entirly on disk if required, when done in memory it is faster than a set for large samples.--[[User:Nigel Galloway|Nigel Galloway]] 11:12, 17 September 2012 (UTC) |
||
<lang |
<syntaxhighlight lang="ruby">dict = File.readlines("unixdict.txt").collect(&:strip) |
||
res=[] |
|||
i = 0 |
i = 0 |
||
res = dict.collect(&:reverse).sort.select do |z| |
|||
i+=1 while z > |
i += 1 while z > dict[i] and i < dict.length-1 |
||
z == dict[i] and z < z.reverse |
|||
end |
|||
} |
|||
puts "There are #{res.length} semordnilaps, of which the following are 5:" |
puts "There are #{res.length} semordnilaps, of which the following are 5:" |
||
res. |
res.take(5).each {|z| puts "#{z} #{z.reverse}"}</syntaxhighlight> |
||
{{out}} |
|||
</lang> |
|||
Produces (the five examples should change with each invocation): |
|||
<pre> |
<pre> |
||
There are 158 semordnilaps, of which the following are 5: |
There are 158 semordnilaps, of which the following are 5: |
||
able elba |
|||
abut tuba |
|||
ac ca |
|||
ah ha |
|||
al la |
|||
</pre> |
</pre> |
||
Another way |
|||
<syntaxhighlight lang="ruby">words = File.readlines("unixdict.txt") |
|||
.group_by{|x| [x.strip!, x.reverse].min} |
|||
.values |
|||
.select{|v| v.size==2} |
|||
puts "There are #{words.size} semordnilaps, of which the following are 5:" |
|||
words.take(5).each {|a,b| puts "#{a} #{b}"}</syntaxhighlight> |
|||
output is the same above. |
|||
=={{header|Rust}}== |
|||
{{trans|Java}} |
|||
<syntaxhighlight lang="rust">use std::collections::HashSet; |
|||
use std::fs::File; |
|||
use std::io::{self, BufRead}; |
|||
use std::iter::FromIterator; |
|||
fn semordnilap(filename: &str) -> std::io::Result<()> { |
|||
let file = File::open(filename)?; |
|||
let mut seen = HashSet::new(); |
|||
let mut count = 0; |
|||
for line in io::BufReader::new(file).lines() { |
|||
let mut word = line?; |
|||
word.make_ascii_lowercase(); |
|||
let rev = String::from_iter(word.chars().rev()); |
|||
if seen.contains(&rev) { |
|||
if count < 5 { |
|||
println!("{}\t{}", word, rev); |
|||
} |
|||
count += 1; |
|||
} else { |
|||
seen.insert(word); |
|||
} |
|||
} |
|||
println!("\nSemordnilap pairs found: {}", count); |
|||
Ok(()) |
|||
} |
|||
fn main() { |
|||
match semordnilap("unixdict.txt") { |
|||
Ok(()) => {} |
|||
Err(error) => eprintln!("{}", error), |
|||
} |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
ca ac |
|||
dab bad |
|||
diva avid |
|||
dna and |
|||
drab bard |
|||
Semordnilap pairs found: 158 |
|||
</pre> |
|||
===A Shortened Version=== |
|||
<syntaxhighlight lang="rust">use std::{collections::HashSet, fs}; |
|||
fn reverse(x: &str) -> String { |
|||
x.chars().rev().collect::<String>() |
|||
} |
|||
fn main() { |
|||
let content = fs::read_to_string("unixdict.txt").expect("No file found!"); |
|||
let work: HashSet<&str> = content.lines().collect(); |
|||
let mut candidats: Vec<&str> = work.clone().into_iter().collect(); |
|||
candidats.retain(|&x| work.contains(&reverse(x).as_str()) && x < reverse(x).as_str()); |
|||
println!("Numbers of pairs found: {}", candidats.len()); |
|||
for ind in 0..5 { |
|||
println!("{}, {}", candidats[ind], reverse(candidats[ind])); |
|||
} |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre>Numbers of pairs found: 158 |
|||
mn, nm |
|||
map, pam |
|||
saw, was |
|||
deep, peed |
|||
door, rood</pre> |
|||
=={{header|Scala}}== |
=={{header|Scala}}== |
||
<syntaxhighlight lang="scala">val wordsAll = |
|||
<lang scala>val wordsAll = scala.io.Source.fromURL("http://www.puzzlers.org/pub/wordlists/unixdict.txt").getLines.map(_.toLowerCase).to[IndexedSeq] |
|||
scala.io.Source. |
|||
fromURL("http://wiki.puzzlers.org/pub/wordlists/unixdict.txt"). |
|||
getLines().map(_.toLowerCase).toIndexedSeq |
|||
/** |
/** |
||
Line 1,073: | Line 3,171: | ||
* words are different. |
* words are different. |
||
*/ |
*/ |
||
def semordnilap( words: |
def semordnilap( words:IndexedSeq[String] ) : IndexedSeq[(String,String)] = { |
||
words. |
|||
zipWithIndex. // index will be needed to eliminate duplicate |
zipWithIndex. // index will be needed to eliminate duplicate |
||
filter { |
filter { |
||
case (w,i) => |
case (w,i) => |
||
val j = words.indexOf(w.reverse) // eg. (able,62) and (elba,7519) |
val j = words.indexOf(w.reverse) // eg. (able,62) and (elba,7519) |
||
i < j && w != w.reverse // save the matches which are not palindromes |
i < j && w != w.reverse // save the matches which are not palindromes |
||
}. |
|||
map { |
|||
case (w,_) => (w,w.reverse) // drop the index |
|||
} |
} |
||
). |
|||
map { |
|||
case (w,i) => (w,w.reverse) // drop the index |
|||
} |
|||
} |
} |
||
Line 1,091: | Line 3,188: | ||
{ |
{ |
||
println( ss.size |
println( s"${ss.size} matches, including: \n" ) |
||
println( ss.take(5).mkString( "\n" ) ) |
println( ss.take(5).mkString( "\n" ) ) |
||
}</ |
}</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre>158 matches, including: |
<pre>158 matches, including: |
||
Line 1,103: | Line 3,200: | ||
(al,la) |
(al,la) |
||
</pre> |
</pre> |
||
=={{header|Seed7}}== |
=={{header|Seed7}}== |
||
Note that the Seed7 program downloads unixdict.txt from the net. |
|||
<lang seed7>$ include "seed7_05.s7i"; |
|||
<syntaxhighlight lang="seed7">$ include "seed7_05.s7i"; |
|||
include "gethttp.s7i"; |
include "gethttp.s7i"; |
||
const func string: reverse (in string: word) is func |
|||
result |
|||
var string: drow is ""; |
|||
local |
|||
var integer: index is 0; |
|||
begin |
|||
for index range length(word) downto 1 do |
|||
drow &:= word[index]; |
|||
end for; |
|||
end func; |
|||
const proc: main is func |
const proc: main is func |
||
Line 1,126: | Line 3,214: | ||
var integer: count is 0; |
var integer: count is 0; |
||
begin |
begin |
||
wordList := split(lower(getHttp(" |
wordList := split(lower(getHttp("wiki.puzzlers.org/pub/wordlists/unixdict.txt")), "\n"); |
||
for word range wordList do |
for word range wordList do |
||
drow := reverse(word); |
drow := reverse(word); |
||
Line 1,140: | Line 3,228: | ||
writeln; |
writeln; |
||
writeln("Semordnilap pairs: " <& count); |
writeln("Semordnilap pairs: " <& count); |
||
end func;</ |
end func;</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
Line 1,152: | Line 3,240: | ||
Semordnilap pairs: 158 |
Semordnilap pairs: 158 |
||
</pre> |
</pre> |
||
=={{header|Sidef}}== |
|||
{{trans|Perl}} |
|||
<syntaxhighlight lang="ruby">var c = 0 |
|||
var seen = Hash() |
|||
ARGF.each { |line| |
|||
line.chomp! |
|||
var r = line.reverse |
|||
((seen{r} := 0 ++) && (c++ < 5) && say "#{line} #{r}") -> |
|||
|| (seen{line} := 0 ++) |
|||
} |
|||
say c</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
$ sidef semordnilap.sf < unixdict.txt |
|||
ca ac |
|||
dab bad |
|||
diva avid |
|||
dna and |
|||
drab bard |
|||
158 |
|||
</pre> |
|||
=={{header|SNOBOL4}}== |
|||
{{works with|SNOBOL4, SPITBOL for Linux}} |
|||
<syntaxhighlight lang="snobol4"> |
|||
* Program: semordnilap.sbl |
|||
* To run: sbl semordnilap.sbl < unixdict.txt |
|||
* Description: A semordnilap is a word (or phrase) that spells |
|||
* a different word (or phrase) backward. "Semordnilap" |
|||
* is a word that itself is a semordnilap. |
|||
* Example: lager and regal |
|||
* Reads file unixdict.txt |
|||
* Comment: Tested using the Spitbol for Linux version of SNOBOL4 |
|||
output = "Some Semordnilap Pairs from File unixdict.txt" |
|||
atable = table(25200,,-1) |
|||
ntable = table(25200,,-2) |
|||
* Read dictionary file into memory |
|||
in1 |
|||
word = input :f(p1) |
|||
count = count + 1 |
|||
atable[word] = word |
|||
ntable[count] = word |
|||
:(in1) |
|||
* Process dictionary to find unique semordnilaps |
|||
p1 |
|||
i = lt(i,count) i + 1 :f(p2) |
|||
newword = atable[reverse(ntable[i])] |
|||
leq(newword,-1) :s(p1) |
|||
ident(ntable[i],newword) :s(p1) |
|||
output = lt(outcount,5) ntable[i] ', ' newword |
|||
atable[ntable[i]] = atable[newword] = -1 |
|||
outcount = outcount + 1 |
|||
:(p1) |
|||
p2 |
|||
output = 'The number of semordnilap pairs is: ' outcount |
|||
END |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
Some Semordnilap Pairs from File unixdict.txt |
|||
able, elba |
|||
abut, tuba |
|||
ac, ca |
|||
ah, ha |
|||
al, la |
|||
The number of semordnilap pairs is: 158 |
|||
</pre> |
|||
=={{header|Stata}}== |
|||
<syntaxhighlight lang="stata">set seed 17760704 |
|||
import delimited http://www.puzzlers.org/pub/wordlists/unixdict.txt, clear |
|||
save temp, replace |
|||
replace v1=strreverse(v1) |
|||
merge 1:1 v1 using temp, nogen keep(3) |
|||
drop if v1>=strreverse(v1) |
|||
count |
|||
158 |
|||
sample 5, count |
|||
gen v2=strreverse(v1) |
|||
list, noheader noobs |
|||
+-------------+ |
|||
| evil live | |
|||
| pat tap | |
|||
| at ta | |
|||
| nit tin | |
|||
| ku uk | |
|||
+-------------+</syntaxhighlight> |
|||
=={{header|SuperCollider }}== |
|||
{{works with|SuperCollider|3.13.0}} |
|||
Submitted to Rosetta Code 2024-06-07 by: MusicCoder. |
|||
<syntaxhighlight lang="SuperCollider"> |
|||
// ========================================================================== |
|||
// START-SuperCollider solution to Rosetta Code TASK: Semordnilap ## BY: MusicCoder : 2024-06-07 ## |
|||
// ========================================================================== |
|||
( |
|||
/* |
|||
https://rosettacode.org/wiki/Semordnilap |
|||
A semordnilap is a word (or phrase) that spells a **different word** (or phrase) backward. |
|||
"Semordnilap" is a word that itself is a semordnilap, i.e. palindromes. Example: lager and regal |
|||
This task does not consider semordnilap phrases, only single words. |
|||
Using only words from this list: unixdict.txt, |
|||
report the total number of unique semordnilap pairs, and print 5 examples. |
|||
Two matching semordnilaps, such as lager and regal, should be counted as ***one unique pair***. |
|||
*/ |
|||
var text, words, revs, candidates, pairs, selection; |
|||
// open file and read all contents into a single string variable called text |
|||
File.use("~/rosetta/data/unixdict.txt".standardizePath, "r", { |f| text = f.readAllString }); |
|||
// to get words - split on new-line, to get distinct convert to SET |
|||
words = text.split(Char.nl).as(Set); |
|||
// reverse order of all characters then split & convert as above |
|||
revs = text.reverse.split(Char.nl).as(Set); |
|||
// get the intersection of the two sets: forward and reversed words |
|||
candidates = (words & revs).as(Array); |
|||
// use a list comprehension to build the pairs AND to drop any palindromes & revs |
|||
pairs = all {: [word, rev], word <- candidates, var rev = word.reverse, word < rev }; |
|||
"There are % semordnilas in unixdict.txt\n".postf(pairs.size); |
|||
"For example those, with more than 3 characters:".postln; |
|||
// SELECT only those pairs where the word length is >= 4 |
|||
// SCRAMBLE the resulting array and KEEP only 5 pairs |
|||
selection = pairs.select { |each| each[0].size >= 4 }.scramble.keep(5); |
|||
// PRINT each example on a new line |
|||
selection.do { |each| each.postln; };"\n"; |
|||
) |
|||
// ========================================================================== |
|||
// **END-SuperCollider solution to Rosetta Code TASK: Semordnilap ## BY: MusicCoder : 2024-06-07 ## |
|||
// ========================================================================== |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
There are 158 semordnilas in unixdict.txt |
|||
For example those, with more than 3 characters: |
|||
[ gnaw, wang ] |
|||
[ part, trap ] |
|||
[ hoop, pooh ] |
|||
[ leper, repel ] |
|||
[ aryl, lyra ] |
|||
</pre> |
|||
=={{header|Swift}}== |
|||
<syntaxhighlight lang="swift">guard let data = try? String(contentsOfFile: "unixdict.txt") else { |
|||
fatalError() |
|||
} |
|||
let words = Set(data.components(separatedBy: "\n")) |
|||
let pairs = words |
|||
.map({ ($0, String($0.reversed())) }) |
|||
.filter({ $0.0 < $0.1 && words.contains($0.1) }) |
|||
print("Found \(pairs.count) pairs") |
|||
print("Five examples: \(pairs.prefix(5))")</syntaxhighlight> |
|||
{{out}} |
|||
<pre>Found 158 pairs |
|||
Five examples: [("dial", "laid"), ("emil", "lime"), ("burg", "grub"), ("den", "ned"), ("enol", "lone")]</pre> |
|||
=={{header|Tcl}}== |
=={{header|Tcl}}== |
||
< |
<syntaxhighlight lang="tcl">package require Tcl 8.5 |
||
package require http |
package require http |
||
Line 1,183: | Line 3,439: | ||
puts "Example: $pair" |
puts "Example: $pair" |
||
if {[incr i]>=5} break |
if {[incr i]>=5} break |
||
}</ |
}</syntaxhighlight> |
||
{{out}} |
{{out}} |
||
<pre> |
<pre> |
||
Line 1,193: | Line 3,449: | ||
Example: bard/drab |
Example: bard/drab |
||
</pre> |
</pre> |
||
=={{header|Transd}}== |
|||
<syntaxhighlight lang="scheme">#lang transd |
|||
MainModule: { |
|||
_start: (λ (with fs FileStream() |
|||
(open-r fs "/mnt/vault/tmp/unixdict.txt") ) |
|||
(with v ( -| |
|||
(read-text fs) |
|||
(split) |
|||
(group-by (λ s String() -> String() |
|||
(ret (min s (reverse (cp s)))))) |
|||
(values) |
|||
(filter where: (λ v Vector<String>() (ret (== (size v) 2)))) |
|||
(shuffle)) |
|||
(lout "Total number of semordnilaps: " (size v)) |
|||
(lout "Random five: " Range(in: v 0 5)))) |
|||
) |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
Total number of semordnilaps: 158 |
|||
Random five: [[deer, reed], [nip, pin], [eire, erie], [am, ma], [gem, meg]] |
|||
</pre> |
|||
=={{header|TUSCRIPT}}== |
=={{header|TUSCRIPT}}== |
||
< |
<syntaxhighlight lang="tuscript"> |
||
$$ MODE TUSCRIPT,{} |
$$ MODE TUSCRIPT,{} |
||
requestdata = REQUEST ("http://www.puzzlers.org/pub/wordlists/unixdict.txt") |
requestdata = REQUEST ("http://www.puzzlers.org/pub/wordlists/unixdict.txt") |
||
Line 1,218: | Line 3,500: | ||
ENDLOOP |
ENDLOOP |
||
ENDCOMPILE |
ENDCOMPILE |
||
</syntaxhighlight> |
|||
</lang> |
|||
{{out}} |
|||
Output: |
|||
<pre> |
<pre> |
||
unixdict.txt contains 158 palindromes |
unixdict.txt contains 158 palindromes |
||
Line 1,228: | Line 3,510: | ||
4. ah'ha |
4. ah'ha |
||
5. al'la |
5. al'la |
||
</pre> |
|||
=={{header|Uiua}}== |
|||
For each word check if its reverse is known, and that it's greater. This removes palindromes and also keeps only first of each pair. Uses a map as a poor man's set for better performance. |
|||
<syntaxhighlight lang="Uiua"> |
|||
A ← map:⊚⧻.⊜□≠@\n.&fras"unixdict.txt" |
|||
▽:⟜≡(↧⊃(<⇌.|has⇌))⊙◌°map⟜¤A |
|||
&p$"Found _ semordnilaps:"⊸⧻ |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
Found 158 semordnilaps: |
|||
{"able" "abut" "ac" "ah" "al" "am" "amos" "and" "ape" "aps" "are" "ares" "aryl" "as" "at" "ate" "ave" "avid" "avis" "aviv" "avon" "bad" "bag" "ban" "bard" "bat" "bin" "bird" "bog" "bon" "brag" "bud" "burg" "bus" "but" "cal" "cam" "caw" "cit" "cos" "cram" "cup" "dam" "damon" "de" "deep" "deer" "del" "den" "dew" "dial" "dim" "dine" "dog" "don" "doom" "door" "dr" "draw" "dual" "ear" "edit" "eel" "eh" "eire" "em" "emil" "emit" "en" "enol" "eros" "even" "evil" "flog" "flow" "gal" "gar" "gas" "gel" "gem" "gnat" "gnaw" "got" "gulp" "gum" "gut" "haw" "hay" "ho" "hoop" "ir" "irs" "it" "iv" "ix" "jar" "kay" "keel" "keep" "knot" "kramer" "ku" "lager" "lap" "leer" "leon" "leper" "let" "lever" "liar" "lien" "lin" "lit" "loop" "loot" "lop" "los" "map" "mar" "mart" "mat" "may" "meet" "mit" "mn" "moor" "mot" "nap" "nat" "net" "nip" "nit" "no" "nor" "not" "nov" "now" "nu" "nut" "oat" "par" "part" "pat" "pay" "paz" "per" "pit" "pot" "pow" "pus" "rat" "raw" "rot" "saw" "suez" "tort" "tv" "way"} |
|||
</pre> |
|||
=={{header|VBScript}}== |
|||
<syntaxhighlight lang="vb"> |
|||
Set objFSO = CreateObject("Scripting.FileSystemObject") |
|||
Set objInFile = objFSO.OpenTextFile(objFSO.GetParentFolderName(WScript.ScriptFullName) &_ |
|||
"\unixdict.txt",1) |
|||
Set objUnixDict = CreateObject("Scripting.Dictionary") |
|||
Set objSemordnilap = CreateObject("Scripting.Dictionary") |
|||
Do Until objInFile.AtEndOfStream |
|||
line = objInFile.ReadLine |
|||
If Len(line) > 1 Then |
|||
objUnixDict.Add line,"" |
|||
End If |
|||
reverse_line = StrReverse(line) |
|||
If reverse_line <> line And objUnixDict.Exists(reverse_line) Then |
|||
objSemordnilap.Add line, reverse_line |
|||
End If |
|||
Loop |
|||
'Display the first 5 keys. |
|||
k = 0 |
|||
For Each Key In objSemordnilap.Keys |
|||
WScript.StdOut.Write Key & " - " & objSemordnilap.Item(Key) |
|||
WScript.StdOut.WriteLine |
|||
k = k + 1 |
|||
If k = 5 Then |
|||
Exit For |
|||
End If |
|||
Next |
|||
WScript.StdOut.Write "Total Count: " & objSemordnilap.Count |
|||
WScript.StdOut.WriteLine |
|||
objInFile.Close |
|||
Set objFSO = Nothing |
|||
Set objUnixDict = Nothing |
|||
Set objSemordnilap = Nothing |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
ca - ac |
|||
dab - bad |
|||
diva - avid |
|||
dna - and |
|||
drab - bard |
|||
Total Count: 158 |
|||
</pre> |
|||
=={{header|Wren}}== |
|||
<syntaxhighlight lang="wren">import "io" for File |
|||
var dict = File.read("unixdict.txt").split("\n") |
|||
var wmap = {} |
|||
dict.each { |w| wmap[w] = true } |
|||
var pairs = [] |
|||
var used = {} |
|||
for (word in dict) { |
|||
if (word != "") { |
|||
var pal = word[-1..0] |
|||
if (word != pal && wmap[pal] && !used[pal]) { |
|||
pairs.add([word, pal]) |
|||
used[word] = true |
|||
} |
|||
} |
|||
} |
|||
System.print("There are %(pairs.count) unique semordnilap pairs in the dictionary.") |
|||
System.print("\nIn sorted order, the first five are:") |
|||
for (i in 0..4) System.print(" %(pairs[i][0]), %(pairs[i][1])") |
|||
System.print("\nand the last five are:") |
|||
for (i in -5..-1) System.print(" %(pairs[i][0]), %(pairs[i][1])")</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
There are 158 unique semordnilap pairs in the dictionary. |
|||
In sorted order, the first five are: |
|||
able, elba |
|||
abut, tuba |
|||
ac, ca |
|||
ah, ha |
|||
al, la |
|||
and the last five are: |
|||
saw, was |
|||
suez, zeus |
|||
tort, trot |
|||
tv, vt |
|||
way, yaw |
|||
</pre> |
</pre> |
||
=={{header|XPL0}}== |
=={{header|XPL0}}== |
||
< |
<syntaxhighlight lang="xpl0">include c:\cxpl\codes; \intrinsic 'code' declarations |
||
string 0; \use zero-terminated strings |
string 0; \use zero-terminated strings |
||
def LF=$0A, CR=$0D, EOF=$1A; |
def LF=$0A, CR=$0D, EOF=$1A; |
||
Line 1,290: | Line 3,678: | ||
]; |
]; |
||
IntOut(0, Count); CrLf(0); |
IntOut(0, Count); CrLf(0); |
||
]</ |
]</syntaxhighlight> |
||
{{out}} |
|||
Output: |
|||
<pre> |
<pre> |
||
able elba |
able elba |
||
Line 1,302: | Line 3,690: | ||
</pre> |
</pre> |
||
=={{header|Yabasic}}== |
|||
{{trans|FreeBASIC}} |
|||
<syntaxhighlight lang="vbnet">dim norm$(27000), result$(270, 2) |
|||
print "Start reading unixdict.txt" |
|||
open "i:\unixdict.txt" for reading as #1 |
|||
while not(eof(#1)) // read to end of file |
|||
line input #1 in_str$ // get line = word |
|||
in_str$ = trim$(in_str$) // we don//t want spaces |
|||
if len(in_str$) > 1 then // if length > 1 then reverse$ |
|||
rev$ = reverse$(in_str$) |
|||
if in_str$ <> rev$ then // if in_str is not a palingdrome |
|||
count = count + 1 // increase counter |
|||
norm$(count) = in_str$ // store in the array |
|||
big$ = big$ + rev$ + " " // create big string with reverse$d words |
|||
fi |
|||
fi |
|||
wend |
|||
close #1 |
|||
print " ... Done" |
|||
print |
|||
print "Start looking for semordnilap" |
|||
for i = 1 to count |
|||
for j = 1 to amount // check to avoid the double |
|||
if result$(j, 2) = norm$(i) continue |
|||
next j |
|||
j = instr(big$, " " + norm$(i) + " ") |
|||
if j <> 0 then // found one |
|||
amount = amount + 1 // increase counter |
|||
result$(amount, 1) = norm$(i) // store normal word |
|||
result$(amount, 2) = reverse$(norm$(i)) // store reverse$ word |
|||
fi |
|||
next i |
|||
print |
|||
print "Found", amount, " unique semordnilap pairs" |
|||
print |
|||
print "Display 5 semordnilap pairs" |
|||
print |
|||
count = 0 |
|||
for i = 1 to amount |
|||
if len(result$(i, 1)) >= 5 then |
|||
count = count + 1 |
|||
print result$(i, 1), chr$(9), result$(i, 2) |
|||
if count >= 5 break |
|||
fi |
|||
next i |
|||
end |
|||
sub reverse$(norm$) |
|||
local rev$, i, l |
|||
l = len(norm$) - 1 |
|||
rev$ = norm$ |
|||
for i = 0 to l |
|||
mid$(rev$, l - i, 1) = mid$(norm$, i, 1) |
|||
next i |
|||
return rev$ |
|||
end sub</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
Start reading unixdict.txt |
|||
... Done |
|||
Start looking for semordnilap |
|||
Found70 unique semordnilap pairs |
|||
Display 5 semordnilap pairs |
|||
diesel seidel |
|||
dirge ridge |
|||
gamma magma |
|||
groan organ |
|||
latus talus |
|||
---Program done, press RETURN---</pre> |
|||
=={{header|zkl}}== |
|||
<syntaxhighlight lang="zkl">var [const] words= // create hashed unixdict of striped words (word:True, ...) |
|||
File("dict.txt").howza(11).pump(Dictionary().howza(8).add.fp1(True)); |
|||
ss:=words.pump(List, // push stripped unixdict words through some functions |
|||
fcn(w){ words.holds(w.reverse()) }, Void.Filter, // filter palindromes |
|||
// create ("word","drow") if "word"<"drow" (ie remove duplicates) |
|||
fcn(w){ r:=w.reverse(); if(w<r) T(w,r) else Void.Skip }); |
|||
ss.len().println(); //--> 158 |
|||
ss.shuffle()[0,5].println();</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
158 |
|||
L(L("bog","gob"),L("cup","puc"),L("mart","tram"),L("kay","yak"),L("able","elba")) |
|||
</pre> |
|||
{{omit from|6502 Assembly|unixdict.txt is much larger than the CPU's address space.}} |
|||
{{omit from|8080 Assembly|See 6502 Assembly.}} |
|||
{{omit from|Brlcad}} |
{{omit from|Brlcad}} |
||
{{omit from|GUISS}} |
{{omit from|GUISS}} |
||
Line 1,307: | Line 3,795: | ||
{{omit from|Openscad}} |
{{omit from|Openscad}} |
||
{{omit from|TPP}} |
{{omit from|TPP}} |
||
{{omit from|Z80 Assembly|See 6502 Assembly.}} |
|||
{{omit from|ZX Spectrum Basic}} |
{{omit from|ZX Spectrum Basic}} |
Latest revision as of 23:09, 11 July 2024
![Task](http://static.miraheze.org/rosettacodewiki/thumb/b/ba/Rcode-button-task-crushed.png/64px-Rcode-button-task-crushed.png)
You are encouraged to solve this task according to the task description, using any language you may know.
A semordnilap is a word (or phrase) that spells a different word (or phrase) backward. "Semordnilap" is a word that itself is a semordnilap.
Example: lager and regal
- Task
This task does not consider semordnilap phrases, only single words. Using only words from this list, report the total number of unique semordnilap pairs, and print 5 examples. Two matching semordnilaps, such as lager and regal, should be counted as one unique pair. (Note that the word "semordnilap" is not in the above dictionary.)
- Metrics
- Counting
- Word frequency
- Letter frequency
- Jewels and stones
- I before E except after C
- Bioinformatics/base count
- Count occurrences of a substring
- Count how many vowels and consonants occur in a string
- Remove/replace
- XXXX redacted
- Conjugate a Latin verb
- Remove vowels from a string
- String interpolation (included)
- Strip block comments
- Strip comments from a string
- Strip a set of characters from a string
- Strip whitespace from a string -- top and tail
- Strip control codes and extended characters from a string
- Anagrams/Derangements/shuffling
- Word wheel
- ABC problem
- Sattolo cycle
- Knuth shuffle
- Ordered words
- Superpermutation minimisation
- Textonyms (using a phone text pad)
- Anagrams
- Anagrams/Deranged anagrams
- Permutations/Derangements
- Find/Search/Determine
- ABC words
- Odd words
- Word ladder
- Semordnilap
- Word search
- Wordiff (game)
- String matching
- Tea cup rim text
- Alternade words
- Changeable words
- State name puzzle
- String comparison
- Unique characters
- Unique characters in each string
- Extract file extension
- Levenshtein distance
- Palindrome detection
- Common list elements
- Longest common suffix
- Longest common prefix
- Compare a list of strings
- Longest common substring
- Find common directory path
- Words from neighbour ones
- Change e letters to i in words
- Non-continuous subsequences
- Longest common subsequence
- Longest palindromic substrings
- Longest increasing subsequence
- Words containing "the" substring
- Sum of the digits of n is substring of n
- Determine if a string is numeric
- Determine if a string is collapsible
- Determine if a string is squeezable
- Determine if a string has all unique characters
- Determine if a string has all the same characters
- Longest substrings without repeating characters
- Find words which contains all the vowels
- Find words which contain the most consonants
- Find words which contains more than 3 vowels
- Find words whose first and last three letters are equal
- Find words with alternating vowels and consonants
- Formatting
- Substring
- Rep-string
- Word wrap
- String case
- Align columns
- Literals/String
- Repeat a string
- Brace expansion
- Brace expansion using ranges
- Reverse a string
- Phrase reversals
- Comma quibbling
- Special characters
- String concatenation
- Substring/Top and tail
- Commatizing numbers
- Reverse words in a string
- Suffixation of decimal numbers
- Long literals, with continuations
- Numerical and alphabetical suffixes
- Abbreviations, easy
- Abbreviations, simple
- Abbreviations, automatic
- Song lyrics/poems/Mad Libs/phrases
- Mad Libs
- Magic 8-ball
- 99 bottles of beer
- The Name Game (a song)
- The Old lady swallowed a fly
- The Twelve Days of Christmas
- Tokenize
- Text between
- Tokenize a string
- Word break problem
- Tokenize a string with escaping
- Split a character string based on change of character
- Sequences
11l
V wordset = Set(File(‘unixdict.txt’).read().split("\n"))
V revlist = wordset.map(word -> reversed(word))
V pairs = Set(zip(wordset, revlist).filter((wrd, rev) -> wrd < rev & rev C :wordset))
print(pairs.len)
print(sorted(Array(pairs), key' p -> (p[0].len, p))[(len)-5..])
- Output:
158 [(damon, nomad), (lager, regal), (leper, repel), (lever, revel), (kramer, remark)]
8th
We're using a map to keep track of what's been seen, and an array to store the results. We load the "unixdict.txt" as an "asset", meaning a file stored alongside the program code:
[] var, results
: processline \ m s --
clone nip
tuck s:rev
m:exists? if
results @ rot a:push drop
else
swap true m:!
then ;
{} "unixdict.txt" app:asset >s
' processline s:eachline
results @ dup a:len . " pairs" . cr
a:shuffle
( a:shift dup . " is the reverse of " . s:rev . cr ) 5 times bye
- Output:
158 pairs trap is the reverse of part nab is the reverse of ban la is the reverse of al ta is the reverse of at tin is the reverse of nit
Ada
Before tackling the real problem, we specify a package String_Vectors and a class String_Vectors.Vec, to store the list of words in the dictionary:
with Ada.Containers.Indefinite_Vectors, Ada.Text_IO;
package String_Vectors is
package String_Vec is new Ada.Containers.Indefinite_Vectors
(Index_Type => Positive, Element_Type => String);
type Vec is new String_Vec.Vector with null record;
function Read(Filename: String) return Vec;
-- uses Ada.Text_IO to read words from the given file into a Vec
-- requirement: each word is written in a single line
function Is_In(List: Vec;
Word: String;
Start: Positive; Stop: Natural) return Boolean;
-- checks if Word is in List(Start .. Stop);
-- requirement: the words in List are sorted alphabetically
end String_Vectors;
The specified class String_Vectors.Vec has been derived from Ada.Containers.Indefinite_Vectors.Vector and provides two additional primitive operations Read and Is_In. Here is the implementation:
package body String_Vectors is
function Is_In(List: Vec;
Word: String;
Start: Positive; Stop: Natural) return Boolean is
Middle: Positive;
begin
if Start > Stop then
return False;
else
Middle := (Start+Stop) / 2;
if List.Element(Middle) = Word then
return True;
elsif List.Element(Middle) < Word then
return List.Is_In(Word, Middle+1, Stop);
else
return List.Is_In(Word, Start, Middle-1);
end if;
end if;
end Is_In;
function Read(Filename: String) return Vec is
package IO renames Ada.Text_IO;
Persistent_List: IO.File_Type;
List: Vec;
begin
IO.Open(File => Persistent_List, Name => Filename, Mode => IO.In_File);
while not IO.End_Of_File(Persistent_List) loop
List.Append(New_Item => IO.Get_Line(Persistent_List));
end loop;
IO.Close(Persistent_List);
return List;
end Read;
end String_Vectors;
This is the main program:
with String_Vectors, Ada.Text_IO, Ada.Command_Line;
procedure Semordnilap is
function Backward(S: String) return String is
begin
if S'Length < 2 then
return S;
else
return (S(S'Last) & Backward(S(S'First+1 .. S'Last-1)) & S(S'First));
end if;
end Backward;
W: String_Vectors.Vec := String_Vectors.Read(Ada.Command_Line.Argument(1));
Semi_Counter: Natural := 0;
begin
for I in W.First_Index .. W.Last_Index loop
if W.Element(I) /= Backward(W.Element(I)) and then
W.Is_In(Backward(W.Element(I)), W.First_Index, I) then
Semi_Counter := Semi_Counter + 1;
if Semi_Counter <= 5 then
Ada.Text_IO.Put_Line(W.Element(I) & " - " & Backward(W.Element(I)));
end if;
end if;
end loop;
Ada.Text_IO.New_Line;
Ada.Text_IO.Put("pairs found:" & Integer'Image(Semi_Counter));
end Semordnilap;
- Output:
>./semordnilap unixdict.txt ca - ac dab - bad diva - avid dna - and drab - bard pairs found: 158
Aime
integer p, z;
record r;
file f;
text s, t;
f.affix("unixdict.txt");
p = 0;
while (f.line(s) != -1) {
if (r_o_integer(z, r, t = b_reverse(s))) {
p += 1;
if (p <= 5) {
o_(s, " ", t, "\n");
}
}
r[s] = 0;
}
o_form("Semordnilap pairs: ~\n", p);
- Output:
ca ac dab bad diva avid dna and drab bard Semordnilap pairs: 158
ALGOL 68
The Algol 68 G "read" PRAGMA is used to include the associative array code from Associative_array/Iteration.
# find the semordnilaps in a list of words #
# use the associative array in the Associate array/iteration task #
PR read "aArray.a68" PR
# returns text with the characters reversed #
OP REVERSE = ( STRING text )STRING:
BEGIN
STRING reversed := text;
INT start pos := LWB text;
FOR end pos FROM UPB reversed BY -1 TO LWB reversed
DO
reversed[ end pos ] := text[ start pos ];
start pos +:= 1
OD;
reversed
END # REVERSE # ;
# read the list of words and store the words in an associative array #
# check for semordnilaps #
IF FILE input file;
STRING file name = "unixdict.txt";
open( input file, file name, stand in channel ) /= 0
THEN
# failed to open the file #
print( ( "Unable to open """ + file name + """", newline ) )
ELSE
# file opened OK #
BOOL at eof := FALSE;
# set the EOF handler for the file #
on logical file end( input file, ( REF FILE f )BOOL:
BEGIN
# note that we reached EOF on the #
# latest read #
at eof := TRUE;
# return TRUE so processing can continue #
TRUE
END
);
REF AARRAY words := INIT LOC AARRAY;
STRING word;
INT semordnilap count := 0;
WHILE NOT at eof
DO
STRING word;
get( input file, ( word, newline ) );
STRING reversed word = REVERSE word;
IF ( words // reversed word ) = ""
THEN
# the reversed word isn't in the array #
words // word := reversed word
ELSE
# we already have this reversed - we have a semordnilap #
semordnilap count +:= 1;
IF semordnilap count <= 5
THEN
print( ( reversed word, " & ", word, newline ) )
FI
FI
OD;
close( input file );
print( ( whole( semordnilap count, 0 ), " semordnilaps found", newline ) )
FI
- Output:
ac & ca bad & dab avid & diva and & dna bard & drab 158 semordnilaps found
Arturo
words: read.lines "http://wiki.puzzlers.org/pub/wordlists/unixdict.txt"
pairs: []
loop words 'wrd [
if and? contains? words reverse wrd
wrd <> reverse wrd [
'pairs ++ @[@[wrd reverse wrd]]
print [wrd "-" reverse wrd]
]
]
unique 'pairs
print map 1..5 => [sample pairs]
AutoHotkey
S := [], M := []
FileRead, dict, unixdict.txt
Loop, Parse, dict, `n, `r`n
{
r := Reverse(A_LoopField)
if (S[r])
M.Insert(r " / " A_LoopField)
else
S[A_LoopField] := 1
}
Loop, 5
Out .= "`t" M[A_Index] "`n"
MsgBox, % "5 Examples:`n" Out "`nTotal Pairs:`n`t" M.MaxIndex()
Reverse(s) {
Loop, Parse, s
r := A_LoopField . r
return r
}
- Output:
5 Examples: ac / ca bad / dab avid / diva and / dna bard / drab Total Pairs: 158
AWK
# syntax: GAWK -f SEMORDNILAP.AWK unixdict.txt
{ arr[$0]++ }
END {
PROCINFO["sorted_in"] = "@ind_str_asc"
for (word in arr) {
rword = ""
for (j=length(word); j>0; j--) {
rword = rword substr(word,j,1)
}
if (word == rword) { continue } # palindrome
if (rword in arr) {
if (word in shown || rword in shown) { continue }
shown[word]++
shown[rword]++
if (n++ < 5) { printf("%s %s\n",word,rword) }
}
}
printf("%d words\n",n)
exit(0)
}
- Output:
able elba abut tuba ac ca ah ha al la 158 words
BBC BASIC
INSTALL @lib$+"SORTLIB"
Sort% = FN_sortinit(0,0)
DIM dict$(26000*2)
REM Load the dictionary, eliminating palindromes:
dict% = OPENIN("C:\unixdict.txt")
IF dict%=0 ERROR 100, "No dictionary file"
index% = 0
REPEAT
A$ = GET$#dict%
B$ = FNreverse(A$)
IF A$<>B$ THEN
dict$(index%) = A$
dict$(index%+1) = B$
index% += 2
ENDIF
UNTIL EOF#dict%
CLOSE #dict%
Total% = index%
REM Sort the dictionary:
C% = Total%
CALL Sort%, dict$(0)
REM Find semordnilaps:
pairs% = 0
examples% = 0
FOR index% = 0 TO Total%-2
IF dict$(index%)=dict$(index%+1) THEN
IF examples%<5 IF LEN(dict$(index%))>4 THEN
PRINT dict$(index%) " " FNreverse(dict$(index%))
examples% += 1
ENDIF
pairs% += 1
ENDIF
NEXT
PRINT "Total number of unique pairs = "; pairs%/2
END
DEF FNreverse(A$)
LOCAL I%, L%, P%
IF A$="" THEN =""
L% = LENA$ - 1
P% = !^A$
FOR I% = 0 TO L% DIV 2
SWAP P%?I%, L%?(P%-I%)
NEXT
= A$
- Output:
damon nomad kramer remark lager regal leper repel lever revel Total number of unique pairs = 158
Bracmat
( get'("unixdict.txt",STR):?dict
& new$hash:?H
& 0:?p
& ( @( !dict
: ?
( [!p ?w \n [?p ?
& (H..insert)$(!w.rev$!w)
& ~
)
)
| 0:?N
& (H..forall)
$ (
=
. !arg:(?a.?b)
& !a:<!b
& (H..find)$!b
& !N+1:?N:<6
& out$(!a !b)
|
)
& out$(semordnilap !N dnuoF)
)
);
- Output:
tv vt ir ri ac ca eh he ku uk semordnilap 158 dnuoF
C
#include <stdio.h>
#include <stdlib.h>
#include <alloca.h> /* stdlib.h might not have obliged. */
#include <string.h>
static void reverse(char *s, int len)
{
int i, j;
char tmp;
for (i = 0, j = len - 1; i < len / 2; ++i, --j)
tmp = s[i], s[i] = s[j], s[j] = tmp;
}
/* Wrap strcmp() for qsort(). */
static int strsort(const void *s1, const void *s2)
{
return strcmp(*(char *const *) s1, *(char *const *) s2);
}
int main(void)
{
int i, c, ct = 0, len, sem = 0;
char **words, **drows, tmp[24];
FILE *dict = fopen("unixdict.txt", "r");
/* Determine word count. */
while ((c = fgetc(dict)) != EOF)
ct += c == '\n';
rewind(dict);
/* Using alloca() is generally discouraged, but we're not doing
* anything too fancy and the memory gains are significant. */
words = alloca(ct * sizeof words);
drows = alloca(ct * sizeof drows);
for (i = 0; fscanf(dict, "%s%n", tmp, &len) != EOF; ++i) {
/* Use just enough memory to store the next word. */
strcpy(words[i] = alloca(len), tmp);
/* Store it again, then reverse it. */
strcpy(drows[i] = alloca(len), tmp);
reverse(drows[i], len - 1);
}
fclose(dict);
qsort(drows, ct, sizeof drows, strsort);
/* Walk both sorted lists, checking only the words which could
* possibly be a semordnilap pair for the current reversed word. */
for (c = i = 0; i < ct; ++i) {
while (strcmp(drows[i], words[c]) > 0 && c < ct - 1)
c++;
/* We found a semordnilap. */
if (!strcmp(drows[i], words[c])) {
strcpy(tmp, drows[i]);
reverse(tmp, strlen(tmp));
/* Unless it was a palindrome. */
if (strcmp(drows[i], tmp) > 0 && sem++ < 5)
printf("%s\t%s\n", drows[i], tmp);
}
}
printf("Semordnilap pairs: %d\n", sem);
return 0;
}
- Output:
ca ac dab bad diva avid dna and drab bard Semordnilap pairs: 158
C#
using System;
using System.Net;
using System.Collections.Generic;
using System.Linq;
using System.IO;
public class Semordnilap
{
public static void Main() {
var results = FindSemordnilaps("http://www.puzzlers.org/pub/wordlists/unixdict.txt").ToList();
Console.WriteLine(results.Count);
var random = new Random();
Console.WriteLine("5 random results:");
foreach (string s in results.OrderBy(_ => random.Next()).Distinct().Take(5)) Console.WriteLine(s + " " + Reversed(s));
}
private static IEnumerable<string> FindSemordnilaps(string url) {
var found = new HashSet<string>();
foreach (string line in GetLines(url)) {
string reversed = Reversed(line);
//Not taking advantage of the fact the input file is sorted
if (line.CompareTo(reversed) != 0) {
if (found.Remove(reversed)) yield return reversed;
else found.Add(line);
}
}
}
private static IEnumerable<string> GetLines(string url) {
WebRequest request = WebRequest.Create(url);
using (var reader = new StreamReader(request.GetResponse().GetResponseStream(), true)) {
while (!reader.EndOfStream) {
yield return reader.ReadLine();
}
}
}
private static string Reversed(string value) => new string(value.Reverse().ToArray());
}
- Output:
158 5 random results: keep peek lever revel ix xi avid diva gar rag
C++
#include <fstream>
#include <iostream>
#include <set>
#include <string>
int main() {
std::ifstream input("unixdict.txt");
if (input) {
std::set<std::string> words; // previous words
std::string word; // current word
size_t count = 0; // pair count
while (input >> word) {
std::string drow(word.rbegin(), word.rend()); // reverse
if (words.find(drow) == words.end()) {
// pair not found
words.insert(word);
} else {
// pair found
if (count++ < 5)
std::cout << word << ' ' << drow << '\n';
}
}
std::cout << "\nSemordnilap pairs: " << count << '\n';
return 0;
} else
return 1; // couldn't open input file
}
- Output:
ca ac dab bad diva avid dna and drab bard Semordnilap pairs: 158
Clojure
(ns rosettacode.semordnilaps
(:require [clojure.string :as str])
[clojure.java.io :as io ]))
(def dict-file
(or (first *command-line-args*) "unixdict.txt"))
(def dict (-> dict-file io/reader line-seq set))
(defn semordnilap? [word]
(let [rev (str/reverse word)]
(and (not= word rev) (dict rev))))
(def semordnilaps
(->> dict
(filter semordnilap?)
(map #([% (str/reverse %)]))
(filter (fn [[x y]] (<= (compare x y) 0)))))
(printf "There are %d semordnilaps in %s. Here are 5:\n"
(count semordnilaps)
dict-file)
(dorun (->> semordnilaps shuffle (take 5) sort (map println)))
- Output:
There are 158 semordnilaps in unixdict.txt. Here are 5: [bog gob] [gnaw wang] [it ti] [los sol] [mot tom]
Common Lisp
(defun semordnilaps (word-list)
(let ((word-map (make-hash-table :test 'equal)))
(loop for word in word-list do
(setf (gethash word word-map) t))
(loop for word in word-list
for rword = (reverse word)
when (and (string< word rword) (gethash rword word-map))
collect (cons word rword))))
(defun main ()
(let ((words
(semordnilaps
(with-open-file (s "unixdict.txt")
(loop for line = (read-line s nil nil)
until (null line)
collect (string-right-trim #(#\space #\return #\newline) line))))))
(format t "Found pairs: ~D" (length words))
(loop for x from 1 to 5
for word in words
do (print word)))
(values))
- Output:
* (main) Found pairs: 158 ("able" . "elba") ("abut" . "tuba") ("ac" . "ca") ("ah" . "ha") ("al" . "la")
Crystal
require "set"
UNIXDICT = File.read("unixdict.txt").lines
def word?(word : String)
UNIXDICT.includes?(word)
end
# is it a word and is it a word backwards?
semordnilap = UNIXDICT.select { |word| word?(word) && word?(word.reverse) }
# consolidate pairs like [bad, dab] == [dab, bad]
final_results = semordnilap.map { |word| [word, word.reverse].to_set }.uniq
# sets of N=1 mean the word is identical backwards
# print out the size, and 5 random pairs
puts final_results.size, final_results.sample(5)
- Output:
246 [Set{"s's"}, Set{"eire", "erie"}, Set{"bag", "gab"}, Set{"mat", "tam"}, Set{"gel", "leg"}]
D
Simple Imperative Version
void main() {
import std.stdio, std.file, std.string, std.algorithm;
bool[string] seenWords;
size_t pairCount = 0;
foreach (const word; "unixdict.txt".readText.toLower.splitter) {
//const drow = word.dup.reverse();
auto drow = word.dup;
drow.reverse();
if (drow in seenWords) {
if (pairCount++ < 5)
writeln(word, " ", drow);
} else
seenWords[word] = true;
}
writeln("\nSemordnilap pairs: ", pairCount);
}
- Output:
ca ac dab bad diva avid dna and drab bard Semordnilap pairs: 158
A More Functional Version
void main() {
import std.stdio, std.file, std.algorithm, std.string, std.range;
auto words = "unixdict.txt".readText.split.zip(0.repeat).assocArray;
auto pairs = zip(words.byKey, words.byKey.map!(w => w.dup.reverse))
.filter!(wr => wr[0] < wr[1] && wr[1] in words)
.zip(0.repeat).assocArray;
writeln(pairs.length, "\n", pairs.byKey.take(5));
}
- Output:
158 [Tuple!(string, char[])("bag", "gab"), Tuple!(string, char[])("pat", "tap"), Tuple!(string, char[])("avis", "siva"), Tuple!(string, char[])("haw", "wah"), Tuple!(string, char[])("rot", "tor")]
Delphi
program Semordnilap;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils,
System.Classes,
System.StrUtils,
System.Diagnostics;
function Sort(s: string): string;
var
c: Char;
i, j, aLength: Integer;
begin
aLength := s.Length;
if aLength = 0 then
exit('');
Result := s;
for i := 1 to aLength - 1 do
for j := i + 1 to aLength do
if result[i] > result[j] then
begin
c := result[i];
result[i] := result[j];
result[j] := c;
end;
end;
function IsAnagram(s1, s2: string): Boolean;
begin
if s1.Length <> s2.Length then
exit(False);
Result := Sort(s1) = Sort(s2);
end;
function CompareLength(List: TStringList; Index1, Index2: Integer): Integer;
begin
result := List[Index1].Length - List[Index2].Length;
if Result = 0 then
Result := CompareText(Sort(List[Index2]), Sort(List[Index1]));
end;
function IsSemordnilap(word1, word2: string): Boolean;
begin
Result := SameText(word1, ReverseString(word2));
end;
var
SemordnilapDict, Dict: TStringList;
Count, Index, i, j: Integer;
words: string;
StopWatch: TStopwatch;
begin
Randomize;
StopWatch := TStopwatch.Create;
StopWatch.Start;
Dict := TStringList.Create();
Dict.LoadFromFile('unixdict.txt');
SemordnilapDict := TStringList.Create;
Dict.CustomSort(CompareLength);
Index := Dict.Count - 1;
words := '';
Count := 1;
while Index - Count >= 0 do
begin
if IsAnagram(Dict[Index], Dict[Index - Count]) then
begin
if IsSemordnilap(Dict[Index], Dict[Index - Count]) then
begin
words := Dict[Index] + ' - ' + Dict[Index - Count];
SemordnilapDict.Add(words);
end;
Inc(Count);
end
else
begin
if Count > 2 then
for i := 1 to Count - 2 do
for j := i + 1 to Count - 1 do
begin
if IsSemordnilap(Dict[Index - i], Dict[Index - j]) then
begin
words := Dict[Index - i] + ' - ' + Dict[Index - j];
SemordnilapDict.Add(words);
end;
end;
Dec(Index, Count);
Count := 1;
end;
end;
StopWatch.Stop;
Writeln(Format('Time pass: %d ms [i7-4500U Windows 7]', [StopWatch.ElapsedMilliseconds]));
writeln(#10'Semordnilap found: ', SemordnilapDict.Count);
writeln(#10'Five random samples:'#10);
for Index := 0 to 4 do
writeln(' ', SemordnilapDict[Random(SemordnilapDict.Count)]);
SemordnilapDict.SaveToFile('Semordnilap.txt');
SemordnilapDict.Free;
Dict.Free;
Readln;
end.
- Output:
Time pass: 558 ms [i7-4500U Windows 7] Semordnilap found: 158 Five random samples: on - no me - em peek - keep ton - not viva - aviv
EchoLisp
We use the words library, and the french dictionary delivered with EchoLisp.
(lib 'struct)
(lib 'sql)
(lib 'words)
(lib 'dico.fr.no-accent) ;; load dictionary
(string-delimiter "")
;; check reverse r of w is a word
;; take only one pair : r < w
(define (semordnilap? w)
(define r (list->string (reverse (string->list w))))
(and (word? r) (string<? r w)))
;; to get longest first
(define (string-sort a b) (> (string-length a) (string-length b)))
(define (task)
;; select unique words into the list 'mots'
(define mots (make-set (words-select #:any null 999999)))
(define semordnilap
(list-sort string-sort (for/list ((w mots))
#:when (semordnilap? w)
w )))
(writeln 'pairs '→ (length semordnilap))
(writeln 'longest '→ (take semordnilap 5)))
- Output:
(task) pairs → 345 longest → (rengager tresser strasse reveler retrace)
Eiffel
First the programm reads the wordlist into an array. Then it mirrors each word and searchs for it across the array using binary search.
class
SEMORDNILAP
create
make
feature
make
--Semordnilaps in 'solution'.
local
count, i, middle, upper, lower: INTEGER
reverse: STRING
do
read_wordlist
create solution.make_empty
from
i := 1
until
i > word_array.count
loop
word_array [i].mirror
reverse := word_array [i]
from
lower := i + 1
upper := word_array.count
until
lower >= upper
loop
middle := (upper - lower) // 2 + lower
if reverse.same_string (word_array [middle]) then
count := count + 1
upper := 0
lower := 1
solution.force (word_array [i], count)
elseif reverse.is_less (word_array [middle]) then
upper := middle - 1
else
lower := middle + 1
end
end
if lower < word_array.count and then reverse.same_string (word_array [lower]) then
count := count + 1
upper := 0
lower := 1
solution.force (word_array [i], count)
end
i := i + 1
end
end
solution: ARRAY [STRING]
original_list: STRING = "unixdict.txt"
feature {NONE}
read_wordlist
-- Preprocessed word_array for finding Semordnilaps.
local
l_file: PLAIN_TEXT_FILE
wordlist: LIST [STRING]
do
create l_file.make_open_read_write (original_list)
l_file.read_stream (l_file.count)
wordlist := l_file.last_string.split ('%N')
l_file.close
create word_array.make_empty
across
1 |..| wordlist.count as i
loop
word_array.force (wordlist.at (i.item), i.item)
end
end
word_array: ARRAY [STRING]
end
Test:
class
APPLICATION
create
make
feature
make
local
test: ARRAY [STRING]
s: STRING
do
create se.make
test := se.solution
create sort.sort (test)
across
test.subarray (1, 5) as t
loop
s := t.item
io.put_string (t.item + "%T")
s.mirror
io.put_string (s)
io.new_line
end
io.put_string ("Total number of semordnilaps: ")
io.put_integer (test.count)
end
se: SEMORDNILAP
sort: MERGE_SORT [STRING]
end
- Output:
ca ac dab bad diva avid dna and drab bard Total number of semordnilaps: 158
Elixir
words = File.stream!("unixdict.txt")
|> Enum.map(&String.strip/1)
|> Enum.group_by(&min(&1, String.reverse &1))
|> Map.values
|> Enum.filter(&(length &1) == 2)
IO.puts "Semordnilap pair: #{length(words)}"
IO.inspect Enum.take(words,5)
- Output:
Semordnilap pair: 158 [["dab", "bad"], ["drib", "bird"], ["marc", "cram"], ["soma", "amos"], ["tab", "bat"]]
Erlang
#!/usr/bin/env escript
main([]) -> main(["unixdict.txt"]);
main([DictFile]) ->
Dict = sets:from_list(read_lines(DictFile)),
Semordnilaps =
lists:filter(fun([W,R]) -> W < R end,
lists:map(fun(W) -> [W, lists:reverse(W)] end,
semordnilaps(Dict))),
io:fwrite("There are ~b semordnilaps in ~s~n",
[length(Semordnilaps), DictFile]),
lists:map(fun([W,R]) -> io:fwrite("~s/~s~n", [W, R]) end,
lists:sort(lists:sublist(shuffle(Semordnilaps),1,5))).
read_lines(Filename) when is_list(Filename) ->
{ ok, File } = file:open(Filename, [read]),
read_lines(File);
read_lines(File) when is_pid(File) ->
case file:read_line(File) of
{ok, Data} -> [chop(Data) | read_lines(File)];
eof -> []
end.
is_semordnilap(Word, Dict) ->
Rev = lists:reverse(Word),
sets:is_element(Word, Dict) and sets:is_element(Rev, Dict).
semordnilaps(Dict) ->
lists:filter(fun(W) -> is_semordnilap(W, Dict) end, sets:to_list(Dict)).
shuffle(List) ->
[X||{_,X} <- lists:sort([ {random:uniform(), N} || N <- List])].
chop(L) -> [_|T] = lists:reverse(L), lists:reverse(T).
- Output:
There are 158 semordnilaps in unixdict.txt aryl/lyra caw/wac cram/marc dine/enid dual/laud
F#
Using a mutable dictionary.
open System
let seen = new System.Collections.Generic.Dictionary<string,bool>()
let lines = System.IO.File.ReadLines("unixdict.txt")
let sems = seq {
for word in lines do
let drow = new String(Array.rev(word.ToCharArray()))
if fst(seen.TryGetValue(drow)) then yield (drow, word)
seen.[drow] <- true
seen.[word] <- true
}
let s = Seq.toList sems
printfn "%d" s.Length
for i in 0 .. 4 do printfn "%A" s.[i]
- Output:
158 ("ac", "ca") ("bad", "dab") ("avid", "diva") ("and", "dna") ("bard", "drab")
Factor
USING: assocs combinators.short-circuit formatting
io.encodings.utf8 io.files kernel literals locals make
prettyprint random sequences ;
IN: rosetta-code.semordnilap
CONSTANT: words $[ "unixdict.txt" utf8 file-lines ]
: semordnilap? ( str1 str2 -- ? )
{ [ = not ] [ nip words member? ] } 2&& ;
[
[let
V{ } clone :> seen words
[
dup reverse 2dup
{ [ semordnilap? ] [ drop seen member? not ] } 2&&
[ 2dup [ seen push ] bi@ ,, ] [ 2drop ] if
] each
]
] H{ } make >alist
[ length "%d semordnilap pairs.\n" printf ] [ 5 sample . ] bi
- Output:
158 semordnilap pairs. { { "pan" "nap" } { "lac" "cal" } { "tang" "gnat" } { "wolf" "flow" } { "mac" "cam" } }
Forth
This code uses a Forth wordlist to contain the dictionary, and uses the Forth-2012 TRAVERSE-WORDLIST to walk through it (a simpler way would be to check for the presence of the reversed word when putting the word into the wordlist).
One interesting issue is how I get each pair only once and exclude palindromes: I accept only pairs where nt<nt2. A type checking bigot will likely argue that nts should not be compared with <, because they are opaque data types. But their implementation does not matter for this check: Whatever bit patterns these two nts get, either it's the same nt, then nt<nt2 will return false, as desired; and if they are different, exactly one of nt<nt2 and nt2<nt will return true.
The code uses two Gforth-specific words: EXECUTE-PARSING (implementable in standard Forth, but not easy) for allowing to provide the name of the defined word on the stack; and FIND-NAME-IN to look up the reversed word (could be replaced with a use of the standard SEARCH-WORDLIST, but the code would become a little more complicated).
wordlist constant dict
: load-dict ( c-addr u -- )
r/o open-file throw >r
begin
pad 1024 r@ read-line throw while
pad swap ['] create execute-parsing
repeat
drop r> close-file throw ;
: xreverse {: c-addr u -- c-addr2 u :}
u allocate throw u + c-addr swap over u + >r begin ( from to r:end)
over r@ u< while
over r@ over - x-size dup >r - 2dup r@ cmove
swap r> + swap repeat
r> drop nip u ;
: .example ( c-addr u u1 -- )
5 < if
cr 2dup type space 2dup xreverse 2dup type drop free throw then
2drop ;
: nt-semicheck ( u1 nt -- u2 f )
dup >r name>string xreverse 2dup dict find-name-in dup if ( u1 c-addr u nt2)
r@ < if ( u1 c-addr u ) \ count pairs only once and not palindromes
2dup 4 pick .example
rot 1+ -rot then
else
drop then
drop free throw r> drop true ;
get-current dict set-current s" unixdict.txt" load-dict set-current
0 ' nt-semicheck dict traverse-wordlist cr .
cr bye
- Output:
suez zeus paz zap way yaw pay yap may yam 158
Fortran
Please read the comments at the beginning of the f90 source to see the compilation instructions and output of 5 random words from a run. Note that program Semordnilap opens the file unixdict.txt . It does not read from stdin, hence the command line redirection from unixdict.txt is irrelevant. I haven't bothered to change it.
!-*- mode: compilation; default-directory: "/tmp/" -*-
!Compilation started at Sun May 19 21:50:08
!
!a=./F && make $a && $a < unixdict.txt
!f95 -Wall -ffree-form F.F -o F
! 5 of 158 semordnilaps
!yaw
!room
!xi
!tim
!nova
!
!
!Compilation finished at Sun May 19 21:50:08
!
!
!
!
! unixdict.txt information
! wc -l unixdict.txt #--> 25104 25 thousand entries
! gawk 'length(a)<length($0){a=$0}END{print a}' unixdict.txt #--> electroencephalography longest word has 22 characters
! gawk '/[A-Z]/{++a}END{print a}' unixdict.txt #--> <empty> the dictionary is lower case
! sort unixdict.txt | cmp - unixdict.txt #--> - unixdict.txt differ: byte 45, line 12
! the dictionary is unsorted
! mmmmm the dictionary is sorted, according to subroutine bs. There's something about the ampersands within unixdict.txt I misunderstand.
program Semordnilap
implicit none
integer :: i, ios, words, swords
character(len=24), dimension(32768) :: dictionary, backword
real, dimension(5) :: harvest
! read the dictionary
open(7,file='unixdict.txt')
do words = 1, 32768
read(7, '(a)', iostat = ios) dictionary(words)
if (ios .ne. 0) exit
enddo
close(7)
if (iachar(dictionary(words)(1:1)) .eq. 0) words = words-1
! sort the dictionary
call bs(dictionary, words)
!do i = 1, words
! write(6,*) dictionary(i)(1:len_trim(dictionary(i))) ! with which we determine the dictionary was ordered
!enddo
swords = 0
do i = 1, words
call reverse(dictionary(i), backword(swords+1))
if ((binary_search(dictionary, words, backword(swords+1))) & ! the reversed word is in the dictionary
.and. (.not. binary_search(backword, swords, dictionary(i))) & ! and it's new
.and. (dictionary(i) .ne. backword(swords+1))) then ! and it's not a palindrome
swords = swords + 1
call bs(backword, swords)
endif
enddo
call random_number(harvest)
call reverse('spalindromes', backword(swords+1))
write(6, *) '5 of ', swords, backword(swords+1)
write(6,'(5(a/))') (backword(1+int(harvest(i)*(swords-2))), i=1,5)
contains
subroutine reverse(inp, outp)
character(len=*), intent(in) :: inp
character(len=*), intent(inout) :: outp
integer :: k, L
L = len_trim(inp)
do k = 1, L
outp(L+1-k:L+1-k) = inp(k:k)
enddo
do k = L+1, len(outp)
outp(k:k) = ' '
enddo
end subroutine reverse
subroutine bs(a, n) ! ok, despite having claimed that bubble sort should be unceremoniously buried, I'll use it anyway because I expect the dictionary is nearly ordered. It's also not a terrible sort for less than 5 items.
! Please note, I tested bs using unixdict.txt randomized with sort --random .
character(len=*),dimension(*),intent(inout) :: a
integer, intent(in) :: n
integer :: i, j, k
logical :: done
character(len=1) :: t
do i=n-1, 1, -1
done = .true.
do j=1, i
if (a(j+1) .lt. a(j)) then
done = .false.
do k = 1, max(len_trim(a(j+1)), len_trim(a(j)))
t = a(j+1)(k:k)
a(j+1)(k:k) = a(j)(k:k)
a(j)(k:k) = t(1:1)
enddo
endif
enddo
if (done) return
enddo
end subroutine bs
logical function binary_search(source, n, target)
character(len=*),dimension(*),intent(in) :: source
character(len=*),intent(in) :: target
integer, intent(in) :: n
integer :: a,m,z
a = 1
z = n
do while (a .lt. z)
m = a + (z - a) / 2
if (target .lt. source(m)) then
z = m-1
else
if (m .eq. a) exit
a = m
endif
enddo
binary_search = (target .eq. source(a)) .or. (target .eq. source(z))
end function binary_search
end program Semordnilap
FreeBASIC
' version 20-06-2015
' compile with: fbc -s console
Function reverse(norm As String) As String
Dim As String rev
Dim As Integer i, l = Len(norm) -1
rev = norm
For i = 0 To l
rev[l-i] = norm[i]
Next
Return rev
End Function
' ------=< MAIN >=------
Dim As Integer i, j, count, amount, ff = FreeFile
Dim As String in_str, rev, big = " " ' big needs to start with a space
Dim As String norm(27000), result(270, 2)
Print
Print "Start reading unixdict.txt";
Open "unixdict.txt" For Input As #ff
While Not Eof(ff) ' read to end of file
Line Input #ff, in_str ' get line = word
in_str = Trim(in_str) ' we don't want spaces
If Len(in_str) > 1 Then ' if length > 1 then reverse
rev = reverse(in_str)
If in_str <> rev Then ' if in_str is not a palingdrome
count = count + 1 ' increase counter
norm(count) = in_str ' store in the array
big = big + rev + " " ' create big string with reversed words
End If
End If
Wend
Close #ff
Print " ... Done"
Print : Print "Start looking for semordnilap"
For i = 1 To count
For j = 1 To amount ' check to avoid the double
If result(j, 2) = norm(i) Then Continue For, For
Next
j = InStr(big, " " + norm(i) + " ")
If j <> 0 Then ' found one
amount = amount + 1 ' increase counter
result(amount,1) = norm(i) ' store normal word
result(amount,2) = reverse(norm(i)) ' store reverse word
End If
Next
Print : Print "Found"; amount; " unique semordnilap pairs"
Print : Print "Display 5 semordnilap pairs"
Print
count = 0
For i = 1 To amount
If Len(result(i,1)) >= 5 Then
count = count + 1
Print result(i, 1), result(i, 2)
If count >= 5 Then Exit For
EndIf
Next
Print
' empty keyboard buffer
While InKey <> "" : Wend
Print : Print "Hit any key to end program"
Sleep
End
- Output:
Start reading unixdict.txt ... Done Start looking for semordnilap Found 158 unique semordnilap pairs Display 5 semordnilap pairs damon nomad kramer remark lager regal leper repel lever revel
Go
package main
import (
"fmt"
"io/ioutil"
"log"
"strings"
)
func main() {
// read file into memory as one big block
data, err := ioutil.ReadFile("unixdict.txt")
if err != nil {
log.Fatal(err)
}
// copy the block, split it up into words
words := strings.Split(string(data), "\n")
// optional, free the first block for garbage collection
data = nil
// put words in a map, also determine length of longest word
m := make(map[string]bool)
longest := 0
for _, w := range words {
m[string(w)] = true
if len(w) > longest {
longest = len(w)
}
}
// allocate a buffer for reversing words
r := make([]byte, longest)
// iterate over word list
sem := 0
var five []string
for _, w := range words {
// first, delete from map. this prevents a palindrome from matching
// itself, and also prevents it's reversal from matching later.
delete(m, w)
// use buffer to reverse word
last := len(w) - 1
for i := 0; i < len(w); i++ {
r[i] = w[last-i]
}
rs := string(r[:len(w)])
// see if reversed word is in map, accumulate results
if m[rs] {
sem++
if len(five) < 5 {
five = append(five, w+"/"+rs)
}
}
}
// print results
fmt.Println(sem, "pairs")
fmt.Println("examples:")
for _, e := range five {
fmt.Println(" ", e)
}
}
- Output:
158 pairs examples: able/elba abut/tuba ac/ca ah/ha al/la
Groovy
def semordnilapWords(source) {
def words = [] as Set
def semordnilaps = []
source.eachLine { word ->
if (words.contains(word.reverse())) semordnilaps << word
words << word
}
semordnilaps
}
Test Code
def semordnilaps = semordnilapWords(new URL('http://www.puzzlers.org/pub/wordlists/unixdict.txt'))
println "Found ${semordnilaps.size()} semordnilap words"
semordnilaps[0..<5].each { println "$it -> ${it.reverse()}" }
- Output:
Found 158 semordnilap words ca -> ac dab -> bad diva -> avid dna -> and drab -> bard
Haskell
import qualified Data.Set as S
semordnilaps
:: (Ord a, Foldable t)
=> t [a] -> [[a]]
semordnilaps =
let f x (s, w)
| S.member (reverse x) s = (s, x : w)
| otherwise = (S.insert x s, w)
in snd . foldr f (S.empty, [])
main :: IO ()
main = do
s <- readFile "unixdict.txt"
let l = semordnilaps (lines s)
print $ length l
mapM_ (print . ((,) <*> reverse)) $ take 5 (filter ((4 <) . length) l)
- Output:
158 ("damon","nomad") ("kramer","remark") ("lager","regal") ("leper","repel") ("lever","revel")
Icon and Unicon
The following solution works in both Icon and Unicon:
procedure main(a)
words := set()
found := 0
every word := map(!&input) do {
if member(words, reverse(word)) then {
if (found +:= 1) <= 5 then write("\t",reverse(word),"/",word)
}
else insert(words, word)
}
write("\nFound ",found," semordnilap words")
end
Sample run with unixdict:
->smp <unixdict.txt ac/ca bad/dab avid/diva and/dna bard/drab Found 158 semordnilap words ->
J
We find all semordnilaps by filtering only words which, when reversed, are a member of the set of dictionary words and are not palindromes. We then find only unique semordnilaps by pairing them with their reversed instance, sorting each pair, and eliminating duplicates pairs:
isSemordnilap=: |.&.> (~: *. e.) ]
unixdict=: <;._2 freads 'unixdict.txt'
#semordnilaps=: ~. /:~"1 (,. |.&.>) (#~ isSemordnilap) unixdict
158
We see that there are 158 semordnilaps.
Here's 5 of them, picked arbitrarily:
(5?.158) { semordnilaps
┌────┬────┐
│kay │yak │
├────┼────┤
│nat │tan │
├────┼────┤
│avis│siva│
├────┼────┤
│flow│wolf│
├────┼────┤
│caw │wac │
└────┴────┘
Java
import java.nio.file.*;
import java.util.*;
public class Semordnilap {
public static void main(String[] args) throws Exception {
List<String> lst = Files.readAllLines(Paths.get("unixdict.txt"));
Set<String> seen = new HashSet<>();
int count = 0;
for (String w : lst) {
w = w.toLowerCase();
String r = new StringBuilder(w).reverse().toString();
if (seen.contains(r)) {
if (count++ < 5)
System.out.printf("%-10s %-10s\n", w, r);
} else seen.add(w);
}
System.out.println("\nSemordnilap pairs found: " + count);
}
}
ca ac dab bad diva avid dna and drab bard Semordnilap pairs found: 158
JavaScript
Node.js
#!/usr/bin/env node
var fs = require('fs');
var sys = require('sys');
var dictFile = process.argv[2] || "unixdict.txt";
var dict = {};
fs.readFileSync(dictFile)
.toString()
.split('\n')
.forEach(function(word) {
dict[word] = word.split("").reverse().join("");
});
function isSemordnilap(word) { return dict[dict[word]]; };
var semordnilaps = []
for (var key in dict) {
if (isSemordnilap(key)) {
var rev = dict[key];
if (key < rev) {
semordnilaps.push([key,rev]) ;
}
}
}
var count = semordnilaps.length;
sys.puts("There are " + count + " semordnilaps in " +
dictFile + ". Here are 5:" );
var indices=[]
for (var i=0; i<count; ++i) {
if (Math.random() < 1/Math.ceil(i/5.0)) {
indices[i%5] = i
}
}
indices.sort()
for (var i=0; i<5; ++i) {
sys.puts(semordnilaps[indices[i]]);
}
Rhino
#!/usr/bin/env rhino
importPackage (java.io)
var dictFile = arguments[0] || "unixdict.txt";
var reader = new BufferedReader(new FileReader(dictFile));
var dict = {};
var word;
while (word = reader.readLine()) {
dict[word] = word.split("").reverse().join("");
}
function isSemordnilap(word) { return dict[dict[word]]; };
var semordnilaps = []
for (var key in dict) {
if (isSemordnilap(key)) {
var rev = dict[key];
if (key < rev) {
semordnilaps.push([key,rev]) ;
}
}
}
var count = semordnilaps.length;
print("There are " + count + " semordnilaps in " +
dictFile + ". Here are 5:" );
var indices=[]
for (var i=0; i<count; ++i) {
if (Math.random() < 1/Math.ceil(i/5.0)) {
indices[i%5] = i
}
}
indices.sort()
for (var i=0; i<5; ++i) {
print(semordnilaps[indices[i]]);
}
- Output:
There are 158 semordnilaps in unixdict.txt. Here are 5: loot,tool ah,ha dial,laid dine,enid haw,wah
macOS JavaScript for Automation
(() => {
'use strict';
// semordnilap :: [String] -> String
const semordnilap = xs => {
const go = ([s, ws], w) =>
s.has(w.split('').reverse().join('')) ? (
[s, [w].concat(ws)]
) : [s.add(w), ws];
return xs.reduce(go, [new Set(), []])[1];
};
const main = () => {
// xs :: [String]
const xs = semordnilap(
lines(readFile('unixdict.txt'))
);
console.log(xs.length);
xs.filter(x => 4 < x.length).forEach(
x => showLog(...[x, x.split('').reverse().join('')])
)
};
// GENERIC FUNCTIONS ----------------------------
// lines :: String -> [String]
const lines = s => s.split(/[\r\n]/);
// readFile :: FilePath -> IO String
const readFile = fp => {
const
e = $(),
uw = ObjC.unwrap,
s = uw(
$.NSString.stringWithContentsOfFileEncodingError(
$(fp)
.stringByStandardizingPath,
$.NSUTF8StringEncoding,
e
)
);
return undefined !== s ? (
s
) : uw(e.localizedDescription);
};
// showLog :: a -> IO ()
const showLog = (...args) =>
console.log(
args
.map(JSON.stringify)
.join(' -> ')
);
// MAIN ---
return main();
})();
- Output:
158 "revel" -> "lever" "repel" -> "leper" "remark" -> "kramer" "regal" -> "lager" "nomad" -> "damon"
jq
The following program illustrates several points about jq:
- jq can be used to process text, as well as JSON;
- for text-processing tasks for which awk is well-suited, jq may be slightly slower;
- jq objects (i.e. JSON objects) can be used to define time-efficient mappings from strings.
Here are some running times on the same machine:
- awk program:
user 0m0.134s; sys 0m0.012s
- time /usr/local/bin/jq -M -s -R -r -f semordnilap.jq unixdict.txt
user 0m0.440s; sys 0m0.010s
# Produce a stream
def report:
split("\n") as $list
# construct the dictionary:
| (reduce $list[] as $entry ({}; . + {($entry): 1})) as $dict
# construct the list of semordnilaps:
| $list[]
| select( (explode|reverse|implode) as $rev
| (. < $rev and $dict[$rev]) );
[report] | (.[0:5][], "length = \(length)")
- Output:
able abut ac ah al length = 158
Julia
raw = readdlm("unixdict.txt",String)[:]
inter = intersect(raw,map(reverse,raw)) #find the matching strings/revstrings
res = String[b == 1 && a != reverse(a) && a < reverse(a) ? a : reverse(a) for a in inter, b in 1:2] #create pairs
res = res[res[:,1] .!= res[:,2],:] #get rid of duplicates, palindromes
julia> length(res[:,1]) 158 julia> res[1:5,:] 5x2 String Array: "able" "elba" "abut" "tuba" "ac" "ca" "ah" "ha" "al" "la"
Kotlin
// version 1.2.0
import java.io.File
fun main(args: Array<String>) {
val words = File("unixdict.txt").readLines().toSet()
val pairs = words.map { Pair(it, it.reversed()) }
.filter { it.first < it.second && it.second in words } // avoid dupes+palindromes, find matches
println("Found ${pairs.size} semordnilap pairs")
println(pairs.take(5))
}
- Output:
Found 158 semordnilap pairs [(able, elba), (abut, tuba), (ac, ca), (ah, ha), (al, la)]
Ksh
#!/bin/ksh
# Semordnilap
# # Variables:
#
integer MIN_WORD_LEN=1 TRUE=1 FALSE=0
dict='/home/ostrande/prj/roscode/unixdict.txt'
integer i j=0 k=0
typeset -A word
# # Functions:
#
# # Function _flipit(string) - return flipped string
#
function _flipit {
typeset _buf ; _buf="$1"
typeset _tmp ; unset _tmp
for (( _i=$(( ${#_buf}-1 )); _i>=0; _i-- )); do
_tmp="${_tmp}${_buf:${_i}:1}"
done
echo "${_tmp}"
}
# # Function _isword(word, wordlist) - return 1 if word in wordlist
#
function _isword {
typeset _word ; _word="$1"
typeset _wordlist ; nameref _wordlist="$2"
[[ ${_word} == @(${_wordlist}) ]] && return $TRUE
return $FALSE
}
######
# main #
######
# # Due to the large number of words in unixdist.txt subgroup by 1st letter and length
# # only accept words containing alpha chars and > 1 chars
#
while read; do
[[ $REPLY != *+(\W)* ]] && [[ $REPLY != *+(\d)* ]] && \
(( ${#REPLY} > MIN_WORD_LEN )) && word[${REPLY:0:1}][${#REPLY}]+=( $REPLY )
done < ${dict}
print Examples:
for fl in ${!word[*]}; do # Over $fl first letter
for len in ${!word[${fl}][*]}; do # Over $len word length
for ((i=0; i<${#word[${fl}][${len}][*]}; i++)); do
Word=${word[${fl}][${len}][i]} # dummy
Try=$(_flipit ${Word})
if [[ ${Try} != ${Word} ]]; then # no palindromes
unset words
oldIFS="$IFS" ; IFS='|' ; words=${word[${Try:0:1}][${#Try}][*]} ; IFS="${oldIFS}"
_isword "${Try}" words
if (( $? )); then
if [[ ${Try} != @(${uniq%\|*}) ]]; then
((++j))
(( ${#Word} >= 5 )) && (( k<=5 )) && print $((++k)). ${Word} ${Try}
uniq+="${Try}|${Word}|"
fi
fi
fi
done
done
done
echo ; print ${j} pairs found.
- Output:
Examples: 1. damon nomad 2. kramer remark 3. lager regal 4. leper repel 5. lever revel
158 pairs found.
Lasso
local(
words = string(include_url('http://www.puzzlers.org/pub/wordlists/unixdict.txt')) -> split('\n'),
semordnilaps = array,
found_size,
example,
haveexamples = false,
examples = array
)
#words -> removeall('')
with word in #words do {
local(reversed = string(#word) -> reverse&)
if(not(#word == #reversed) and not(#semordnilaps >> #word) and not(#semordnilaps >> #reversed) and #words >> #reversed) => {
#semordnilaps -> insert(#word = #reversed)
}
}
#found_size = #semordnilaps -> size
while(not(#haveexamples)) => {
#example = #semordnilaps -> get(integer_random(#found_size, 1))
not(#examples >> #example -> name) ? #examples -> insert(#example)
#examples -> size >= 5 ? #haveexamples = true
}
'Total found: '
#found_size
'<br />'
#examples
- Output:
Total found: 158 array((dew = wed), (are = era), (den = ned), (oat = tao), (eel = lee))
Liberty BASIC
print "Loading dictionary."
open "unixdict.txt" for input as #1
while not(eof(#1))
line input #1, a$
dict$=dict$+" "+a$
wend
close #1
print "Dictionary loaded."
print "Seaching for semordnilaps."
semo$=" " 'string to hold words with semordnilaps
do
i=i+1
w$=word$(dict$,i)
p$=reverseString$(w$)
if w$<>p$ then
p$=" "+p$+" "
if instr(semo$,p$) = 0 then
if instr(dict$,p$) then
pairs=pairs+1
print w$+" /"+p$
semo$=semo$+w$+p$
end if
end if
end if
scan
loop until w$=""
print "Total number of unique semordnilap pairs is ";pairs
wait
Function isPalindrome(string$)
string$ = Lower$(string$)
reverseString$ = reverseString$(string$)
If string$ = reverseString$ Then isPalindrome = 1
End Function
Function reverseString$(string$)
For i = Len(string$) To 1 Step -1
reverseString$ = reverseString$ + Mid$(string$, i, 1)
Next i
End Function
- Output:
able / elba leper / repel lever / revel moor / room suez / zeus tort / trot Total number of unique semordnilap pairs is 158
Lua
#!/usr/bin/env lua
-- allow dictionary file and sample size to be specified on command line
local dictfile = arg[1] or "unixdict.txt"
local sample_size = arg[2] or 5;
-- read dictionary
local f = assert(io.open(dictfile, "r"))
local dict = {}
for line in f:lines() do
dict[line] = line:reverse()
end
f:close()
-- find the semordnilaps
local semordnilaps = {}
for fwd, rev in pairs(dict) do
if dict[rev] and fwd < rev then
table.insert(semordnilaps, {fwd,rev})
end
end
-- print the report
print("There are " .. #semordnilaps .. " semordnilaps in " .. dictfile .. ". Here are " .. sample_size .. ":")
math.randomseed( os.time() )
for i = 1, sample_size do
local j
repeat
j = math.random(1,#semordnilaps)
until semordnilaps[j]
local f, r = unpack(semordnilaps[j])
semordnilaps[j] = nil
print(f .. " -> " .. r)
end
- Output:
There are 158 semordnilaps in unixdict.txt. Here are 5: deer -> reed rat -> tar pus -> sup meet -> teem bat -> tab
M2000 Interpreter
Module semordnilaps {
Document d$
Load.Doc d$, "unixdict.txt"
Inventory MyDict, Result
Function s$(a$) {
m$=a$:k=Len(a$):for i=1 to k {insert i, 1 m$=mid$(a$, k, 1):k--} : =m$
}
L=Doc.Par(d$)
m=Paragraph(d$, 0)
If not Forward(d$,m) then exit
i=1
While m {
word$=Paragraph$(d$,(m))
Print Over $(0, 10), str$(i/L,"##0.00%"), Len(Result) : i++
If Exist(MyDict, word$) then { if Exist(Result, word$) Then exit
Append Result, word$
} Else.if len(word$)>1 Then p$=s$(word$):if p$<>word$ Then Append MyDict, p$
}
Print
Print "Semordnilap pairs: ";Len(Result)
For i=0 to len(Result)-1 step len(Result) div 5 {
p$=Eval$(Result, i)
Print s$(p$);"/";p$
}
}
semordnilaps
- Output:
Semordnilap pairs: 158 ac/ca nap/pan cos/soc loot/tool way/yaw
Mathematica /Wolfram Language
data = Import["http://www.puzzlers.org/pub/wordlists/unixdict.txt", "List"];
result = DeleteDuplicates[ Select[data, MemberQ[data, StringReverse[#]]
&& # =!= StringReverse[#] &], (# ===StringReverse[#2]) &];
Print[Length[result], Take[result, 5]]
- Output:
158 {able,abut,ac,ah,al}
Nanoquery
import Nanoquery.IO
def reverse_str(string)
ret = ""
for char in list(string).reverse()
ret += char
end
return ret
end
lst = split(new(File).open("rosetta-code/unixdict.txt").readAll(), "\n")
seen = list()
count = 0
for w in lst
w = lower(w)
r = reverse_str(w)
if r in seen
count += 1
if count <= 5
print format("%-10s %-10s\n", w, r)
end
else
seen.append(w)
end
end
println "\nSemordnilap pairs found: " + count
- Output:
ca ac dab bad diva avid dna and drab bard Semordnilap pairs found: 158
NetRexx
/* NetRexx */
options replace format comments java crossref symbols nobinary
/* REXX ***************************************************************
* 07.09.2012 Walter Pachl
**********************************************************************/
fid = 'unixdict.txt' /* the test dictionary */
ifi = File(fid)
ifr = BufferedReader(FileReader(ifi))
have = '' /* words encountered */
pi = 0 /* number of palindromes */
loop label j_ forever /* as long there is input */
line = ifr.readLine /* read a line (String) */
if line = null then leave j_ /* NULL indicates EOF */
w = Rexx(line) /* each line contains 1 word */
If w > '' Then Do /* not a blank line */
r = w.reverse /* reverse it */
If have[r] > '' Then Do /* was already encountered */
pi = pi + 1 /* increment number of pal's */
If pi <= 5 Then /* the first 5 are listed */
Say have[r] w
End
have[w] = w /* remember the word */
End
end j_
ifr.close
Say pi 'words in' fid 'have a palindrome' /* total number found */
return
- Output:
ac ca bad dab avid diva and dna bard drab 158 words in unixdict.txt have a palindrome
NewLisp
;;; Get the words as a list, splitting at newline
(setq data
(parse (get-url "http://wiki.puzzlers.org/pub/wordlists/unixdict.txt")
"\n"))
;
;;; destructive reverse wrapped into a function
(define (get-reverse x) (reverse x))
;
;;; stack of the results
(setq res '())
;
;;; Find the semordlinap and put them on the stack
(dolist (x data)
(let (y (get-reverse x))
(if (and
(member y data) ; reverse is a dictionary word
(!= x y) ; but not a palindrome
(not (member y res))) ; not already stacked
(push x res -1))))
;
;;; Count results
(println "Found " (length res) " pairs.")
(println)
;;; Show the longest ones
(dolist (x res)
(if (> (length x) 4) (println x " -- " (get-reverse x))))
- Output:
Found 158 pairs. damon -- nomad kramer -- remark lager -- regal leper -- repel lever -- revel
Nim
import strutils, sequtils, sets, algorithm
proc reversed(s: string): string =
result = newString(s.len)
for i, c in s:
result[s.high - i] = c
let
words = readFile("unixdict.txt").strip().splitLines()
wordset = words.toHashSet
revs = words.map(reversed)
var pairs = zip(words, revs).filterIt(it[0] < it[1] and it[1] in wordset)
echo "Total number of semordnilaps: ", pairs.len
pairs = pairs.sortedByIt(it[0].len)
echo pairs[^5..^1]
- Output:
Total number of semordnilaps: 158 @[(a: damon, b: nomad), (a: lager, b: regal), (a: leper, b: repel), (a: lever, b: revel), (a: kramer, b: remark)]
OCaml
module StrSet = Set.Make(String)
let str_rev s =
let len = String.length s in
let r = Bytes.create len in
for i = 0 to len - 1 do
Bytes.set r i s.[len - 1 - i]
done;
Bytes.to_string r
let input_line_opt ic =
try Some (input_line ic)
with End_of_file -> close_in ic; None
let () =
let ic = open_in "unixdict.txt" in
let rec aux set acc =
match input_line_opt ic with
| Some word ->
let rev = str_rev word in
if StrSet.mem rev set
then aux set ((word, rev) :: acc)
else aux (StrSet.add word set) acc
| None ->
(acc)
in
let pairs = aux StrSet.empty [] in
let len = List.length pairs in
Printf.printf "Semordnilap pairs: %d\n" len;
Random.self_init ();
for i = 1 to 5 do
let (word, rev) = List.nth pairs (Random.int len) in
Printf.printf " %s %s\n" word rev
done
- Output:
Semordnilap pairs: 158 tar rat sera ares sub bus tic cit mid dim
Octave
a = strsplit(fileread("unixdict.txt"), "\n");
a = intersect(a, cellfun(@fliplr, a, "UniformOutput", false));
a = a(arrayfun(@(i) ismember(fliplr(a{i}), a(i+1:length(a))), 1:length(a)));
length(a)
arrayfun(@(i) printf("%s %s\n", a{i}, fliplr(a{i})), 1:5)
Output:
ans = 158 able elba abut tuba ac ca ah ha al la
Oforth
: semordnilap
| w wr wrds |
ListBuffer new ->wrds
ListBuffer new
File new("unixdict.txt") forEach: w [
wrds include(w reverse dup ->wr) ifTrue: [ [wr, w] over add ]
w wr < ifTrue: [ wrds add(w) ]
] ;
- Output:
>semordnilap dup size println left(5) println 158 [[ac, ca], [bad, dab], [avid, diva], [and, dna], [bard, drab]]
Perl
while (<>) {
chomp;
my $r = reverse;
$seen{$r}++ and $c++ < 5 and print "$_ $r\n" or $seen{$_}++;
}
print "$c\n"
Phix
with javascript_semantics sequence words = unix_dict(), semordnilap={} for i=1 to length(words) do string word = words[i] if rfind(reverse(word),words,i-1) then semordnilap = append(semordnilap,word) end if end for printf(1,"%d semordnilap found, the first five are:\n",length(semordnilap)) for i=1 to 5 do printf(1,"%s - %s\n",{semordnilap[i],reverse(semordnilap[i])}) end for
- Output:
158 semordnilap found, the first five are: ca - ac dab - bad diva - avid dna - and drab - bard
Phixmonti
include ..\Utilitys.pmt
( ) ( )
"unixdict.txt" "r" fopen var f
true while
f fgets
dup -1 == if
drop
f fclose
false
else
-1 del
0 put
true
endif
endwhile
len while
len 1 > if
pop swap reverse find dup
if
extract rot swap 0 put swap
else
drop
endif
true
else
drop false
endif
endwhile
( 50 54 ) for get dup reverse print " -> " print ? endfor nl
len print " pairs" ?
- Output:
dew -> wed dial -> laid dim -> mid dine -> enid dog -> god 158 pairs === Press any key to exit ===
PHP
<?php
// Read dictionary into array
$dictionary = array_fill_keys(file(
'http://www.puzzlers.org/pub/wordlists/unixdict.txt',
FILE_IGNORE_NEW_LINES | FILE_SKIP_EMPTY_LINES
), true);
foreach (array_keys($dictionary) as $word) {
$reversed_word = strrev($word);
if (isset($dictionary[$reversed_word]) && $word > $reversed_word)
$words[$word] = $reversed_word;
}
echo count($words), "\n";
// array_rand() returns keys, not values
foreach (array_rand($words, 5) as $word)
echo "$word $words[$word]\n";
- Output:
158 ti it tide edit top pot tram mart un nu
PicoLisp
(let Semordnilap
(mapcon
'((Lst)
(when (member (reverse (car Lst)) (cdr Lst))
(cons (pack (car Lst))) ) )
(make (in "unixdict.txt" (while (line) (link @)))) )
(println (length Semordnilap) (head 5 Semordnilap)) )
- Output:
158 ("able" "abut" "ac" "ah" "al")
PL/I
find: procedure options (main); /* 20/1/2013 */
declare word character (20) varying controlled;
declare dict(*) character (20) varying controlled;
declare 1 pair controlled,
2 a character (20) varying, 2 b character (20) varying;
declare (i, j) fixed binary;
declare in file;
open file(in) title ('/UNIXDICT.TXT,type(LF),recsize(100)');
on endfile (in) go to completed_read;
do forever;
allocate word;
get file (in) edit (word) (L);
end;
completed_read:
free word; /* because at the final allocation, no word was stored. */
allocate dict(allocation(word));
do i = 1 to hbound(dict,1);
dict(i) = word; free word;
end;
/* Search dictionary for pairs: */
do i = 1 to hbound(dict,1)-1;
do j = i+1 to hbound(dict,1);
if length(dict(i)) = length(dict(j)) then
do;
if dict(i) = reverse(dict(j)) then
do;
allocate pair; pair.a = dict(i); pair.b = dict(j);
end;
end;
end;
end;
put skip list ('There are ' || trim(allocation(pair)) || ' pairs.');
do while (allocation(pair) > 0);
put skip edit (pair) (a, col(20), a); free pair;
end;
end find;
There are 158 pairs.
5 values at random:
ward draw was saw wed dew wolf flow won now
PowerShell
function Reverse-String ([string]$String)
{
[char[]]$output = $String.ToCharArray()
[Array]::Reverse($output)
$output -join ""
}
[string]$url = "http://www.puzzlers.org/pub/wordlists/unixdict.txt"
[string]$out = ".\unixdict.txt"
(New-Object System.Net.WebClient).DownloadFile($url, $out)
[string[]]$file = Get-Content -Path $out
[hashtable]$unixDict = @{}
[hashtable]$semordnilap = @{}
foreach ($line in $file)
{
if ($line.Length -gt 1)
{
$unixDict.Add($line,"")
}
[string]$reverseLine = Reverse-String $line
if ($reverseLine -notmatch $line -and $unixDict.ContainsKey($reverseLine))
{
$semordnilap.Add($line,$reverseLine)
}
}
$semordnilap
"`nSemordnilap count: {0}" -f ($semordnilap.GetEnumerator() | Measure-Object).Count
- Output:
Name Value ---- ----- nil lin regal lager tom mot . . . peek keep soma amos nob bon Semordnilap count: 158
PureBasic
If OpenConsole("")=0 : End 1 : EndIf
If ReadFile(0,"./Data/unixdict.txt")=0 : End 2 : EndIf
NewList dict$()
While Eof(0)=0 : AddElement(dict$()) : dict$()=Trim(ReadString(0)) : Wend : CloseFile(0)
While FirstElement(dict$())
buf$=dict$() : DeleteElement(dict$())
If buf$="" : Continue : EndIf
xbuf$=ReverseString(buf$)
ForEach dict$()
If xbuf$=dict$()
res$+buf$+" / "+xbuf$+#LF$
Break
EndIf
Next
Wend
PrintN("Semordnilap pairs found: "+Str(CountString(res$,#LF$)))
For k=1 To 5
If k=1 : PrintN(~"\nFirst 5 pairs: "+StringField(res$,k,#LF$)) : Continue : EndIf
PrintN(Space(15)+StringField(res$,k,#LF$))
Next
Input()
- Output:
Semordnilap pairs found: 158 First 5 pairs: able / elba abut / tuba ac / ca ah / ha al / la
Python
Idiomatic
>>> with open('unixdict.txt') as f:
wordset = set(f.read().strip().split())
>>> revlist = (''.join(word[::-1]) for word in wordset)
>>> pairs = set((word, rev) for word, rev in zip(wordset, revlist)
if word < rev and rev in wordset)
>>> len(pairs)
158
>>> sorted(pairs, key=lambda p: (len(p[0]), p))[-5:]
[('damon', 'nomad'), ('lager', 'regal'), ('leper', 'repel'), ('lever', 'revel'), ('kramer', 'remark')]
>>>
As a fold, using reduce
'''Dictionary words paired by equivalence under reversal'''
from functools import (reduce)
from itertools import (chain)
import urllib.request
# semordnilaps :: [String] -> [String]
def semordnilaps(xs):
'''The subset of words in a list which
are paired (by equivalence under reversal)
with other words in that list.
'''
def go(tpl, w):
(s, ws) = tpl
if w[::-1] in s:
return (s, ws + [w])
else:
s.add(w)
return (s, ws)
return reduce(go, xs, (set(), []))[1]
# TEST ----------------------------------------------------
def main():
'''Test'''
url = 'http://wiki.puzzlers.org/pub/wordlists/unixdict.txt'
ws = semordnilaps(
urllib.request.urlopen(
url
).read().splitlines()
)
print(
fTable(
__doc__ + ':\n\n(longest of ' +
str(len(ws)) + ' in ' + url + ')\n'
)(snd)(fst)(identity)(
sorted(
concatMap(
lambda x: (
lambda s=x.decode('utf8'): [
(s, s[::-1])
] if 4 < len(x) else []
)()
)(ws),
key=compose(len)(fst),
reverse=True
)
)
)
# GENERIC -------------------------------------------------
# compose (<<<) :: (b -> c) -> (a -> b) -> a -> c
def compose(g):
'''Right to left function composition.'''
return lambda f: lambda x: g(f(x))
# concatMap :: (a -> [b]) -> [a] -> [b]
def concatMap(f):
'''A concatenated list over which a function has been mapped.
The list monad can be derived by using a function f which
wraps its output in a list,
(using an empty list to represent computational failure).'''
return lambda xs: list(
chain.from_iterable(map(f, xs))
)
# FORMATTING ----------------------------------------------
# fTable :: String -> (a -> String) ->
# (b -> String) -> (a -> b) -> [a] -> String
def fTable(s):
'''Heading -> x display function -> fx display function ->
f -> xs -> tabular string.
'''
def go(xShow, fxShow, f, xs):
ys = [xShow(x) for x in xs]
w = max(map(len, ys))
return s + '\n' + '\n'.join(map(
lambda x, y: y.rjust(w, ' ') + ' -> ' + fxShow(f(x)),
xs, ys
))
return lambda xShow: lambda fxShow: lambda f: lambda xs: go(
xShow, fxShow, f, xs
)
# fst :: (a, b) -> a
def fst(tpl):
'''First member of a pair.'''
return tpl[0]
# identity :: a -> a
def identity(x):
'''The identity function.'''
return x
# snd :: (a, b) -> b
def snd(tpl):
'''Second member of a pair.'''
return tpl[1]
if __name__ == '__main__':
main()
- Output:
Dictionary words paired by equivalence under reversal: (longest of 158 in http://wiki.puzzlers.org/pub/wordlists/unixdict.txt) kramer -> remark damon -> nomad lager -> regal leper -> repel lever -> revel
Lazy generator
Requires the requests
library.
import sys
import random
import requests
URL = 'http://wiki.puzzlers.org/pub/wordlists/unixdict.txt'
def find_semordnilaps(word_generator):
# Keys in this dict are the words seen so far, reversed.
# Values are booleans determining whether we have seen (and yielded)
# the key, so that we don't yield the same word twice.
seen = {}
for word in word_generator:
if word not in seen:
reversed_word = word[::-1]
seen[reversed_word] = False # not yielded yet
else:
yielded_already = seen[word]
if not yielded_already:
yield word
seen[word] = True # the word has been yielded
def url_lines(url):
with requests.get(url, stream=True) as req:
yield from req.iter_lines(decode_unicode=True)
def main(url=URL, num_of_examples=5):
semordnilaps_generator = find_semordnilaps(url_lines(url))
semordnilaps = list(semordnilaps_generator)
example_words = random.choices(semordnilaps, k=int(num_of_examples))
example_pairs = ((word, word[::-1]) for word in example_words)
print(
f'found {len(semordnilaps)} semordnilap words:',
* ['%s %s' % p for p in example_pairs]+['...'],
sep='\n'
)
return semordnilaps
if __name__ == '__main__':
main(*sys.argv[1:])
- Output:
found 158 semordnilap words: mug gum revel lever gab bag lime emil lag gal ...
Quackery
[]
$ "rosetta/unixdict.txt" sharefile drop
nest$
[ behead reverse swap
2dup find over found iff
[ dip [ nested join ] ]
else nip
dup [] = until ]
drop
say "Number of semordnilaps: "
dup size echo cr
sortwith [ size swap size > ]
5 split drop
say "Five longest: "
witheach
[ dup echo$ say "<->"
reverse echo$ sp ]
- Output:
Number of semordnilaps: 158 Five longest: remark<->kramer nomad<->damon regal<->lager repel<->leper revel<->lever
Racket
#lang racket
(define seen (make-hash))
(define semordnilaps '())
(call-with-input-file "/usr/share/dict/words"
(λ(i) (for ([l (in-lines i)])
(define r (list->string (reverse (string->list l))))
(unless (equal? r l)
(hash-set! seen l #t)
(when (hash-ref seen r #f)
(set! semordnilaps (cons (list r l) semordnilaps)))))))
(printf "Total semordnilaps found: ~s\n" (length semordnilaps))
(printf "The five longest ones:\n")
(for ([s (take (sort semordnilaps > #:key (compose1 string-length car)) 5)])
(apply printf " ~s ~s\n" s))
- Output:
Total semordnilaps found: 1961 The five longest ones: "desserts" "stressed" "dioramas" "samaroid" "redrawer" "rewarder" "dessert" "tressed" "pat-pat" "tap-tap"
Raku
(formerly Perl 6)
my $words = set slurp("unixdict.txt").lines;
my @sems = gather for $words.flat -> $word {
my $drow = $word.key.flip;
take $drow if $drow ∈ $words and $drow lt $word;
}
say $_ ~ ' ' ~ $_.flip for @sems.pick(5);
- Output:
abut tuba avid diva bard drab loot tool part trap
REXX
version 1
/* REXX ***************************************************************
* 07.09.2012 Walter Pachl
**********************************************************************/
fid='unixdict.txt' /* the test dictionary */
have.='' /* words encountered */
pi=0 /* number of palindromes */
Do li=1 By 1 While lines(fid)>0 /* as long there is input */
w=linein(fid) /* read a word */
If w>'' Then Do /* not a blank line */
r=reverse(w) /* reverse it */
If have.r>'' Then Do /* was already encountered */
pi=pi+1 /* increment number of pal's */
If pi<=5 Then /* the first 5 ale listed */
Say have.r w
End
have.w=w /* remember the word */
End
End
Say pi 'words in' fid 'have a palindrome' /* total number found */
- Output:
ac ca bad dab avid diva and dna bard drab 158 words in unixdict.txt have a palindrome
version 2
This REXX version makes use of sparse (stemmed) arrays.
The dictionary file wasn't assumed to be in any particular case (upper/lower/mixed).
For instance, DNA & and would be considered semordnilaps, even though their case is different.
The UNIXDICT dictionary specified to be used is all lowercase, however, but the REXX program assumes that the
words may be in any case (lowercase/uppercase/mixedcased).
The order of the words in the dictionary isn't important.
Any blank lines or duplicate words in the dictionary are ignored (as duplicate words wouldn't make them unique).
Any leading, trailing, or imbedded blanks are also ignored (as well as tab characters or other whitespace).
The semordnilap word pairs are shown with a comma delimiter in case there are phrases (words with imbedded
blanks like Sing Sing).
The (first five) semordnilap pairs are shown as they are specified/defined (respective to case) in the dictionary.
/*REXX program finds N semordnilap pairs using a specified dictionary (UNIXDICT.TXT).*/
parse arg n iFID . /*obtain optional argument from the CL.*/
if n=='' | n=="," then n= 5 /*Not specified? Then use the default.*/
if iFID=='' | iFID=="," then iFID='UNIXDICT.TXT' /* " " " " " " */
#= 0 /*number of semordnilaps (so far). */
@.= /*caseless non─duplicated dict. words. */
do while lines(iFID)\==0; _= linein(iFID); u= space(_, 0); upper u /*get a word.*/
if length(u)<2 | @.u\=='' then iterate /*word can't be a unique semordnilap. */
r= reverse(u) /*obtain reverse of the dictionary word*/
if @.r\=='' then do; #= # + 1 /*found a semordnilap word; bump count.*/
if #<=n then say right(@.r, max(32, length(@.r) ) )',' u
end
@.u= _ /*define reverse of the dictionary word*/
end /*while*/ /*stick a fork in it, we're all done. */
say
say "There're " # ' unique semordnilap pairs in the dictionary file: ' iFID
- output when using the default inputs:
ac, ca bad, dab avid, diva and, dna bard, drab There're 158 unique semordnilap pairs in the dictionary file: UNIXDICT.TXT
Ring
# Project : Semordnilap
load "stdlib.ring"
nr = 0
num = 0
aList = file2list("C:\Ring\CalmoSoft\unixdict.txt")
for n = 1 to len(aList)
bool = semordnilap(aList[n])
if (bool > 0 and nr > n)
num = num + 1
if num % 31 = 0
see aList[n] + " " + aList[nr] + nl
ok
ok
next
see "Total number of unique pairs = " + num + nl
func semordnilap(aString)
bString = ""
for i=len(aString) to 1 step -1
bString = bString + aString[i]
next
nr = find(aList,bString)
return nr
- Output:
brag garb edit tide it ti mit tim suez zeus Total number of unique pairs = 158
Ruby
Note: An alternative (old fashioned) method of solving this task (not using a Set as done by other solutions) is to produce 2 sorted files and walk through them. This can be done entirly on disk if required, when done in memory it is faster than a set for large samples.--Nigel Galloway 11:12, 17 September 2012 (UTC)
dict = File.readlines("unixdict.txt").collect(&:strip)
i = 0
res = dict.collect(&:reverse).sort.select do |z|
i += 1 while z > dict[i] and i < dict.length-1
z == dict[i] and z < z.reverse
end
puts "There are #{res.length} semordnilaps, of which the following are 5:"
res.take(5).each {|z| puts "#{z} #{z.reverse}"}
- Output:
There are 158 semordnilaps, of which the following are 5: able elba abut tuba ac ca ah ha al la
Another way
words = File.readlines("unixdict.txt")
.group_by{|x| [x.strip!, x.reverse].min}
.values
.select{|v| v.size==2}
puts "There are #{words.size} semordnilaps, of which the following are 5:"
words.take(5).each {|a,b| puts "#{a} #{b}"}
output is the same above.
Rust
use std::collections::HashSet;
use std::fs::File;
use std::io::{self, BufRead};
use std::iter::FromIterator;
fn semordnilap(filename: &str) -> std::io::Result<()> {
let file = File::open(filename)?;
let mut seen = HashSet::new();
let mut count = 0;
for line in io::BufReader::new(file).lines() {
let mut word = line?;
word.make_ascii_lowercase();
let rev = String::from_iter(word.chars().rev());
if seen.contains(&rev) {
if count < 5 {
println!("{}\t{}", word, rev);
}
count += 1;
} else {
seen.insert(word);
}
}
println!("\nSemordnilap pairs found: {}", count);
Ok(())
}
fn main() {
match semordnilap("unixdict.txt") {
Ok(()) => {}
Err(error) => eprintln!("{}", error),
}
}
- Output:
ca ac dab bad diva avid dna and drab bard Semordnilap pairs found: 158
A Shortened Version
use std::{collections::HashSet, fs};
fn reverse(x: &str) -> String {
x.chars().rev().collect::<String>()
}
fn main() {
let content = fs::read_to_string("unixdict.txt").expect("No file found!");
let work: HashSet<&str> = content.lines().collect();
let mut candidats: Vec<&str> = work.clone().into_iter().collect();
candidats.retain(|&x| work.contains(&reverse(x).as_str()) && x < reverse(x).as_str());
println!("Numbers of pairs found: {}", candidats.len());
for ind in 0..5 {
println!("{}, {}", candidats[ind], reverse(candidats[ind]));
}
}
- Output:
Numbers of pairs found: 158 mn, nm map, pam saw, was deep, peed door, rood
Scala
val wordsAll =
scala.io.Source.
fromURL("http://wiki.puzzlers.org/pub/wordlists/unixdict.txt").
getLines().map(_.toLowerCase).toIndexedSeq
/**
* Given a sequence of lower-case words return a sub-sequence
* of matches containing the word and its reverse if the two
* words are different.
*/
def semordnilap( words:IndexedSeq[String] ) : IndexedSeq[(String,String)] = {
words.
zipWithIndex. // index will be needed to eliminate duplicate
filter {
case (w,i) =>
val j = words.indexOf(w.reverse) // eg. (able,62) and (elba,7519)
i < j && w != w.reverse // save the matches which are not palindromes
}.
map {
case (w,_) => (w,w.reverse) // drop the index
}
}
val ss = semordnilap(wordsAll)
{
println( s"${ss.size} matches, including: \n" )
println( ss.take(5).mkString( "\n" ) )
}
- Output:
158 matches, including: (able,elba) (abut,tuba) (ac,ca) (ah,ha) (al,la)
Seed7
Note that the Seed7 program downloads unixdict.txt from the net.
$ include "seed7_05.s7i";
include "gethttp.s7i";
const proc: main is func
local
var array string: wordList is 0 times "";
var set of string: words is (set of string).value;
var string: word is "";
var string: drow is "";
var integer: count is 0;
begin
wordList := split(lower(getHttp("wiki.puzzlers.org/pub/wordlists/unixdict.txt")), "\n");
for word range wordList do
drow := reverse(word);
if drow not in words then
incl(words, word);
else
if count < 5 then
writeln(word <& " " <& drow);
end if;
incr(count);
end if;
end for;
writeln;
writeln("Semordnilap pairs: " <& count);
end func;
- Output:
ca ac dab bad diva avid dna and drab bard Semordnilap pairs: 158
Sidef
var c = 0
var seen = Hash()
ARGF.each { |line|
line.chomp!
var r = line.reverse
((seen{r} := 0 ++) && (c++ < 5) && say "#{line} #{r}") ->
|| (seen{line} := 0 ++)
}
say c
- Output:
$ sidef semordnilap.sf < unixdict.txt ca ac dab bad diva avid dna and drab bard 158
SNOBOL4
* Program: semordnilap.sbl
* To run: sbl semordnilap.sbl < unixdict.txt
* Description: A semordnilap is a word (or phrase) that spells
* a different word (or phrase) backward. "Semordnilap"
* is a word that itself is a semordnilap.
* Example: lager and regal
* Reads file unixdict.txt
* Comment: Tested using the Spitbol for Linux version of SNOBOL4
output = "Some Semordnilap Pairs from File unixdict.txt"
atable = table(25200,,-1)
ntable = table(25200,,-2)
* Read dictionary file into memory
in1
word = input :f(p1)
count = count + 1
atable[word] = word
ntable[count] = word
:(in1)
* Process dictionary to find unique semordnilaps
p1
i = lt(i,count) i + 1 :f(p2)
newword = atable[reverse(ntable[i])]
leq(newword,-1) :s(p1)
ident(ntable[i],newword) :s(p1)
output = lt(outcount,5) ntable[i] ', ' newword
atable[ntable[i]] = atable[newword] = -1
outcount = outcount + 1
:(p1)
p2
output = 'The number of semordnilap pairs is: ' outcount
END
- Output:
Some Semordnilap Pairs from File unixdict.txt able, elba abut, tuba ac, ca ah, ha al, la The number of semordnilap pairs is: 158
Stata
set seed 17760704
import delimited http://www.puzzlers.org/pub/wordlists/unixdict.txt, clear
save temp, replace
replace v1=strreverse(v1)
merge 1:1 v1 using temp, nogen keep(3)
drop if v1>=strreverse(v1)
count
158
sample 5, count
gen v2=strreverse(v1)
list, noheader noobs
+-------------+
| evil live |
| pat tap |
| at ta |
| nit tin |
| ku uk |
+-------------+
SuperCollider
Submitted to Rosetta Code 2024-06-07 by: MusicCoder.
// ==========================================================================
// START-SuperCollider solution to Rosetta Code TASK: Semordnilap ## BY: MusicCoder : 2024-06-07 ##
// ==========================================================================
(
/*
https://rosettacode.org/wiki/Semordnilap
A semordnilap is a word (or phrase) that spells a **different word** (or phrase) backward.
"Semordnilap" is a word that itself is a semordnilap, i.e. palindromes. Example: lager and regal
This task does not consider semordnilap phrases, only single words.
Using only words from this list: unixdict.txt,
report the total number of unique semordnilap pairs, and print 5 examples.
Two matching semordnilaps, such as lager and regal, should be counted as ***one unique pair***.
*/
var text, words, revs, candidates, pairs, selection;
// open file and read all contents into a single string variable called text
File.use("~/rosetta/data/unixdict.txt".standardizePath, "r", { |f| text = f.readAllString });
// to get words - split on new-line, to get distinct convert to SET
words = text.split(Char.nl).as(Set);
// reverse order of all characters then split & convert as above
revs = text.reverse.split(Char.nl).as(Set);
// get the intersection of the two sets: forward and reversed words
candidates = (words & revs).as(Array);
// use a list comprehension to build the pairs AND to drop any palindromes & revs
pairs = all {: [word, rev], word <- candidates, var rev = word.reverse, word < rev };
"There are % semordnilas in unixdict.txt\n".postf(pairs.size);
"For example those, with more than 3 characters:".postln;
// SELECT only those pairs where the word length is >= 4
// SCRAMBLE the resulting array and KEEP only 5 pairs
selection = pairs.select { |each| each[0].size >= 4 }.scramble.keep(5);
// PRINT each example on a new line
selection.do { |each| each.postln; };"\n";
)
// ==========================================================================
// **END-SuperCollider solution to Rosetta Code TASK: Semordnilap ## BY: MusicCoder : 2024-06-07 ##
// ==========================================================================
- Output:
There are 158 semordnilas in unixdict.txt For example those, with more than 3 characters: [ gnaw, wang ] [ part, trap ] [ hoop, pooh ] [ leper, repel ] [ aryl, lyra ]
Swift
guard let data = try? String(contentsOfFile: "unixdict.txt") else {
fatalError()
}
let words = Set(data.components(separatedBy: "\n"))
let pairs = words
.map({ ($0, String($0.reversed())) })
.filter({ $0.0 < $0.1 && words.contains($0.1) })
print("Found \(pairs.count) pairs")
print("Five examples: \(pairs.prefix(5))")
- Output:
Found 158 pairs Five examples: [("dial", "laid"), ("emil", "lime"), ("burg", "grub"), ("den", "ned"), ("enol", "lone")]
Tcl
package require Tcl 8.5
package require http
# Fetch the words
set t [http::geturl http://www.puzzlers.org/pub/wordlists/unixdict.txt]
set wordlist [split [http::data $t] \n]
http::cleanup $t
# Build hash table for speed
foreach word $wordlist {
set reversed([string reverse $word]) "dummy"
}
# Find where a reversal exists
foreach word $wordlist {
if {[info exists reversed($word)] && $word ne [string reverse $word]} {
# Remove to prevent pairs from being printed twice
unset reversed([string reverse $word])
# Add to collection of pairs
set pairs($word/[string reverse $word]) "dummy"
}
}
set pairlist [array names pairs] ;# NB: pairs are in *arbitrary* order
# Report what we've found
puts "Found [llength $pairlist] reversed pairs"
foreach pair $pairlist {
puts "Example: $pair"
if {[incr i]>=5} break
}
- Output:
Found 158 reversed pairs Example: lap/pal Example: jar/raj Example: ix/xi Example: eros/sore Example: bard/drab
Transd
#lang transd
MainModule: {
_start: (λ (with fs FileStream()
(open-r fs "/mnt/vault/tmp/unixdict.txt") )
(with v ( -|
(read-text fs)
(split)
(group-by (λ s String() -> String()
(ret (min s (reverse (cp s))))))
(values)
(filter where: (λ v Vector<String>() (ret (== (size v) 2))))
(shuffle))
(lout "Total number of semordnilaps: " (size v))
(lout "Random five: " Range(in: v 0 5))))
)
}
- Output:
Total number of semordnilaps: 158 Random five: [[deer, reed], [nip, pin], [eire, erie], [am, ma], [gem, meg]]
TUSCRIPT
$$ MODE TUSCRIPT,{}
requestdata = REQUEST ("http://www.puzzlers.org/pub/wordlists/unixdict.txt")
DICT semordnilap CREATE 99999
COMPILE
LOOP r=requestdata
rstrings=STRINGS(r," ? ")
rreverse=REVERSE(rstrings)
revstring=EXCHANGE (rreverse,":'':':'::")
group=APPEND (r,revstring)
sort=ALPHA_SORT (group)
DICT semordnilap APPEND/QUIET/COUNT sort,num,cnt,"",""
ENDLOOP
DICT semordnilap UNLOAD wordgroups,num,howmany
get_palins=FILTER_INDEX (howmany,-," 1 ")
size=SIZE(get_palins)
PRINT "unixdict.txt contains ", size, " palindromes"
PRINT " "
palindromes=SELECT (wordgroups,#get_palins)
LOOP n=1,5
take5=SELECT (palindromes,#n)
PRINT n,". ",take5
ENDLOOP
ENDCOMPILE
- Output:
unixdict.txt contains 158 palindromes 1. able'elba 2. abut'tuba 3. ac'ca 4. ah'ha 5. al'la
Uiua
For each word check if its reverse is known, and that it's greater. This removes palindromes and also keeps only first of each pair. Uses a map as a poor man's set for better performance.
A ← map:⊚⧻.⊜□≠@\n.&fras"unixdict.txt"
▽:⟜≡(↧⊃(<⇌.|has⇌))⊙◌°map⟜¤A
&p$"Found _ semordnilaps:"⊸⧻
- Output:
Found 158 semordnilaps: {"able" "abut" "ac" "ah" "al" "am" "amos" "and" "ape" "aps" "are" "ares" "aryl" "as" "at" "ate" "ave" "avid" "avis" "aviv" "avon" "bad" "bag" "ban" "bard" "bat" "bin" "bird" "bog" "bon" "brag" "bud" "burg" "bus" "but" "cal" "cam" "caw" "cit" "cos" "cram" "cup" "dam" "damon" "de" "deep" "deer" "del" "den" "dew" "dial" "dim" "dine" "dog" "don" "doom" "door" "dr" "draw" "dual" "ear" "edit" "eel" "eh" "eire" "em" "emil" "emit" "en" "enol" "eros" "even" "evil" "flog" "flow" "gal" "gar" "gas" "gel" "gem" "gnat" "gnaw" "got" "gulp" "gum" "gut" "haw" "hay" "ho" "hoop" "ir" "irs" "it" "iv" "ix" "jar" "kay" "keel" "keep" "knot" "kramer" "ku" "lager" "lap" "leer" "leon" "leper" "let" "lever" "liar" "lien" "lin" "lit" "loop" "loot" "lop" "los" "map" "mar" "mart" "mat" "may" "meet" "mit" "mn" "moor" "mot" "nap" "nat" "net" "nip" "nit" "no" "nor" "not" "nov" "now" "nu" "nut" "oat" "par" "part" "pat" "pay" "paz" "per" "pit" "pot" "pow" "pus" "rat" "raw" "rot" "saw" "suez" "tort" "tv" "way"}
VBScript
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objInFile = objFSO.OpenTextFile(objFSO.GetParentFolderName(WScript.ScriptFullName) &_
"\unixdict.txt",1)
Set objUnixDict = CreateObject("Scripting.Dictionary")
Set objSemordnilap = CreateObject("Scripting.Dictionary")
Do Until objInFile.AtEndOfStream
line = objInFile.ReadLine
If Len(line) > 1 Then
objUnixDict.Add line,""
End If
reverse_line = StrReverse(line)
If reverse_line <> line And objUnixDict.Exists(reverse_line) Then
objSemordnilap.Add line, reverse_line
End If
Loop
'Display the first 5 keys.
k = 0
For Each Key In objSemordnilap.Keys
WScript.StdOut.Write Key & " - " & objSemordnilap.Item(Key)
WScript.StdOut.WriteLine
k = k + 1
If k = 5 Then
Exit For
End If
Next
WScript.StdOut.Write "Total Count: " & objSemordnilap.Count
WScript.StdOut.WriteLine
objInFile.Close
Set objFSO = Nothing
Set objUnixDict = Nothing
Set objSemordnilap = Nothing
- Output:
ca - ac dab - bad diva - avid dna - and drab - bard Total Count: 158
Wren
import "io" for File
var dict = File.read("unixdict.txt").split("\n")
var wmap = {}
dict.each { |w| wmap[w] = true }
var pairs = []
var used = {}
for (word in dict) {
if (word != "") {
var pal = word[-1..0]
if (word != pal && wmap[pal] && !used[pal]) {
pairs.add([word, pal])
used[word] = true
}
}
}
System.print("There are %(pairs.count) unique semordnilap pairs in the dictionary.")
System.print("\nIn sorted order, the first five are:")
for (i in 0..4) System.print(" %(pairs[i][0]), %(pairs[i][1])")
System.print("\nand the last five are:")
for (i in -5..-1) System.print(" %(pairs[i][0]), %(pairs[i][1])")
- Output:
There are 158 unique semordnilap pairs in the dictionary. In sorted order, the first five are: able, elba abut, tuba ac, ca ah, ha al, la and the last five are: saw, was suez, zeus tort, trot tv, vt way, yaw
XPL0
include c:\cxpl\codes; \intrinsic 'code' declarations
string 0; \use zero-terminated strings
def LF=$0A, CR=$0D, EOF=$1A;
proc RevStr(S); \Reverse order of characters in a string
char S;
int I, J, T;
[J:= 0;
while S(J) do J:= J+1;
J:= J-1;
I:= 0;
while I<J do
[T:= S(I); S(I):= S(J); S(J):= T; \swap
I:= I+1; J:= J-1;
];
];
func StrEqual(S1, S2); \Compare strings, return 'true' if equal
char S1, S2;
int I;
[for I:= 0 to 80-1 do
[if S1(I) # S2(I) then return false;
if S1(I) = 0 then return true;
];
];
int C, I, J, SJ, Count;
char Dict, Word(80);
[\Read file on command line redirected as input, i.e: <unixdict.txt
Dict:= GetHp; \starting address of block of local "heap" memory
I:= 0; \ [GetHp does exact same thing as Reserve(0)]
repeat repeat C:= ChIn(1) until C#LF; \get chars sans line feeds
if C = CR then C:= 0; \replace carriage return with terminator
Dict(I):= C; I:= I+1;
until C = EOF;
SetHp(Dict+I); \set heap pointer beyond Dict
I:= 0; Count:= 0;
loop [J:= 0; \get word at I
repeat C:= Dict(I+J); Word(J):= C; J:= J+1;
until C=0;
RevStr(Word);
J:= J+I; \set J to following word in Dict
if Dict(J) = EOF then quit;
SJ:= J; \save index to following word
loop [if StrEqual(Word, Dict+J) then
[Count:= Count+1;
if Count <= 5 then
[RevStr(Word); \show some examples
Text(0, Word); ChOut(0, ^ ); Text(0, Dict+J); CrLf(0);
];
quit;
];
repeat J:= J+1 until Dict(J) = 0;
J:= J+1;
if Dict(J) = EOF then quit;
];
I:= SJ; \next word
];
IntOut(0, Count); CrLf(0);
]
- Output:
able elba abut tuba ac ca ah ha al la 158
Yabasic
dim norm$(27000), result$(270, 2)
print "Start reading unixdict.txt"
open "i:\unixdict.txt" for reading as #1
while not(eof(#1)) // read to end of file
line input #1 in_str$ // get line = word
in_str$ = trim$(in_str$) // we don//t want spaces
if len(in_str$) > 1 then // if length > 1 then reverse$
rev$ = reverse$(in_str$)
if in_str$ <> rev$ then // if in_str is not a palingdrome
count = count + 1 // increase counter
norm$(count) = in_str$ // store in the array
big$ = big$ + rev$ + " " // create big string with reverse$d words
fi
fi
wend
close #1
print " ... Done"
print
print "Start looking for semordnilap"
for i = 1 to count
for j = 1 to amount // check to avoid the double
if result$(j, 2) = norm$(i) continue
next j
j = instr(big$, " " + norm$(i) + " ")
if j <> 0 then // found one
amount = amount + 1 // increase counter
result$(amount, 1) = norm$(i) // store normal word
result$(amount, 2) = reverse$(norm$(i)) // store reverse$ word
fi
next i
print
print "Found", amount, " unique semordnilap pairs"
print
print "Display 5 semordnilap pairs"
print
count = 0
for i = 1 to amount
if len(result$(i, 1)) >= 5 then
count = count + 1
print result$(i, 1), chr$(9), result$(i, 2)
if count >= 5 break
fi
next i
end
sub reverse$(norm$)
local rev$, i, l
l = len(norm$) - 1
rev$ = norm$
for i = 0 to l
mid$(rev$, l - i, 1) = mid$(norm$, i, 1)
next i
return rev$
end sub
- Output:
Start reading unixdict.txt ... Done Start looking for semordnilap Found70 unique semordnilap pairs Display 5 semordnilap pairs diesel seidel dirge ridge gamma magma groan organ latus talus ---Program done, press RETURN---
zkl
var [const] words= // create hashed unixdict of striped words (word:True, ...)
File("dict.txt").howza(11).pump(Dictionary().howza(8).add.fp1(True));
ss:=words.pump(List, // push stripped unixdict words through some functions
fcn(w){ words.holds(w.reverse()) }, Void.Filter, // filter palindromes
// create ("word","drow") if "word"<"drow" (ie remove duplicates)
fcn(w){ r:=w.reverse(); if(w<r) T(w,r) else Void.Skip });
ss.len().println(); //--> 158
ss.shuffle()[0,5].println();
- Output:
158 L(L("bog","gob"),L("cup","puc"),L("mart","tram"),L("kay","yak"),L("able","elba"))
- Programming Tasks
- Solutions by Programming Task
- 11l
- 8th
- Ada
- Aime
- ALGOL 68
- Arturo
- AutoHotkey
- AWK
- BBC BASIC
- Bracmat
- C
- C sharp
- C++
- Clojure
- Common Lisp
- Crystal
- D
- Delphi
- System.SysUtils
- System.Classes
- System.StrUtils
- System.Diagnostics
- EchoLisp
- Eiffel
- Elixir
- Erlang
- F Sharp
- Factor
- Forth
- Fortran
- FreeBASIC
- Go
- Groovy
- Haskell
- Icon
- Unicon
- J
- Java
- JavaScript
- Jq
- Julia
- Kotlin
- Ksh
- Lasso
- Liberty BASIC
- Lua
- M2000 Interpreter
- Mathematica
- Wolfram Language
- Nanoquery
- NetRexx
- NewLisp
- Nim
- OCaml
- Octave
- Oforth
- Perl
- Phix
- Phixmonti
- PHP
- PicoLisp
- PL/I
- PowerShell
- PureBasic
- Python
- Quackery
- Racket
- Raku
- REXX
- Ring
- Ruby
- Rust
- Scala
- Seed7
- Sidef
- SNOBOL4
- Stata
- SuperCollider
- Swift
- Tcl
- Transd
- TUSCRIPT
- Uiua
- VBScript
- Wren
- XPL0
- Yabasic
- Zkl
- 6502 Assembly/Omit
- 8080 Assembly/Omit
- Brlcad/Omit
- GUISS/Omit
- Locomotive Basic/Omit
- Openscad/Omit
- TPP/Omit
- Z80 Assembly/Omit
- ZX Spectrum Basic/Omit