Semordnilap: Difference between revisions
Content added Content deleted
m (→{{header|C++}}: little code reduction) |
Drkameleon (talk | contribs) (Replaced content with "=={{header|Arturo}}== <lang rebol>words: read.lines "http://wiki.puzzlers.org/pub/wordlists/unixdict.txt" pairs: [] loop words 'wrd [ if and? contains? words reverse...") |
||
Line 1: | Line 1: | ||
=={{header|Arturo}}== |
|||
{{task}} |
|||
<lang rebol>words: read.lines "http://wiki.puzzlers.org/pub/wordlists/unixdict.txt" |
|||
pairs: [] |
|||
A [[wp:semordnilap|semordnilap]] is a word (or phrase) that spells a different word (or phrase) backward. |
|||
loop words 'wrd [ |
|||
"Semordnilap" is a word that itself is a semordnilap. |
|||
if and? contains? words reverse wrd |
|||
wrd <> reverse wrd [ |
|||
Example: ''lager'' and ''regal'' |
|||
'pairs ++ @[@[wrd reverse wrd]] |
|||
<br><br> |
|||
print [wrd "-" reverse wrd] |
|||
;Task |
|||
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. (Note that lager/regal and regal/lager should be counted as one unique pair.) |
|||
{{Template:Strings}} |
|||
<br><br> |
|||
=={{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: |
|||
<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 |
|||
</lang> |
|||
{{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> |
|||
=={{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: |
|||
<lang Ada>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;</lang> |
|||
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: |
|||
<lang Ada>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;</lang> |
|||
This is the main program: |
|||
<lang Ada>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;</lang> |
|||
{{out}} |
|||
<pre>>./semordnilap unixdict.txt |
|||
ca - ac |
|||
dab - bad |
|||
diva - avid |
|||
dna - and |
|||
drab - bard |
|||
pairs found: 158</pre> |
|||
=={{header|Aime}}== |
|||
<lang 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);</lang> |
|||
{{out}} |
|||
<pre>ca ac |
|||
dab bad |
|||
diva avid |
|||
dna and |
|||
drab bard |
|||
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. |
|||
<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</lang> |
|||
{{out}} |
|||
<pre> |
|||
ac & ca |
|||
bad & dab |
|||
avid & diva |
|||
and & dna |
|||
bard & drab |
|||
158 semordnilaps found |
|||
</pre> |
|||
=={{header|AutoHotkey}}== |
|||
{{works with|AutoHotkey_L}} |
|||
<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 |
|||
}</lang> |
|||
{{out}} |
|||
<pre>5 Examples: |
|||
ac / ca |
|||
bad / dab |
|||
avid / diva |
|||
and / dna |
|||
bard / drab |
|||
Total Pairs: |
|||
158</pre> |
|||
=={{header|AWK}}== |
|||
<lang 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) |
|||
} |
|||
</lang> |
|||
{{out}} |
|||
<pre> |
|||
able elba |
|||
abut tuba |
|||
ac ca |
|||
ah ha |
|||
al la |
|||
158 words |
|||
</pre> |
|||
=={{header|BBC BASIC}}== |
|||
{{works with|BBC BASIC for Windows}} |
|||
<lang bbcbasic> 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$</lang> |
|||
{{out}} |
|||
<pre> |
|||
damon nomad |
|||
kramer remark |
|||
lager regal |
|||
leper repel |
|||
lever revel |
|||
Total number of unique pairs = 158 |
|||
</pre> |
|||
=={{header|Bracmat}}== |
|||
<lang 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) |
|||
) |
|||
);</lang> |
|||
{{out}} |
|||
<pre>tv vt |
|||
ir ri |
|||
ac ca |
|||
eh he |
|||
ku uk |
|||
semordnilap 158 dnuoF</pre> |
|||
=={{header|C}}== |
|||
<lang 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; |
|||
}</lang> |
|||
{{out}} |
|||
<pre>ca ac |
|||
dab bad |
|||
diva avid |
|||
dna and |
|||
drab bard |
|||
Semordnilap pairs: 158</pre> |
|||
=={{header|C sharp}}== |
|||
<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()); |
|||
}</lang> |
|||
{{out}} |
|||
<pre> |
|||
158 |
|||
5 random results: |
|||
keep peek |
|||
lever revel |
|||
ix xi |
|||
avid diva |
|||
gar rag</pre> |
|||
=={{header|C++}}== |
|||
<lang cpp>#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 |
|||
}</lang> |
|||
{{out}} |
|||
<pre> |
|||
ca ac |
|||
dab bad |
|||
diva avid |
|||
dna and |
|||
drab bard |
|||
Semordnilap pairs: 158 |
|||
</pre> |
|||
=={{header|Clojure}}== |
|||
<lang 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)))</lang> |
|||
{{out}} |
|||
<pre>There are 158 semordnilaps in unixdict.txt. Here are 5: |
|||
[bog gob] |
|||
[gnaw wang] |
|||
[it ti] |
|||
[los sol] |
|||
[mot tom]</pre> |
|||
=={{header|Common Lisp}}== |
|||
<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))</lang> |
|||
{{out}} |
|||
<pre>* (main) |
|||
Found pairs: 158 |
|||
("able" . "elba") |
|||
("abut" . "tuba") |
|||
("ac" . "ca") |
|||
("ah" . "ha") |
|||
("al" . "la")</pre> |
|||
=={{header|Crystal}}== |
|||
<lang 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) |
|||
</lang> |
|||
{{out}} |
|||
<pre> |
|||
246 |
|||
[Set{"s's"}, Set{"eire", "erie"}, Set{"bag", "gab"}, Set{"mat", "tam"}, Set{"gel", "leg"}] |
|||
</pre> |
|||
=={{header|D}}== |
|||
===Simple Imperative Version=== |
|||
<lang d>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); |
|||
}</lang> |
|||
{{out}} |
|||
<pre>ca ac |
|||
dab bad |
|||
diva avid |
|||
dna and |
|||
drab bard |
|||
Semordnilap pairs: 158</pre> |
|||
===A More Functional Version=== |
|||
<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)); |
|||
}</lang> |
|||
{{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}} |
|||
<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. |
|||
</lang> |
|||
{{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. |
|||
<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))) |
|||
{{out}} |
|||
(task) |
|||
pairs → 345 |
|||
longest → (rengager tresser strasse reveler retrace) |
|||
</lang> |
|||
=={{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. |
|||
<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 |
|||
</lang> |
|||
Test: |
|||
<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 |
|||
</lang> |
|||
{{out}} |
|||
<pre> |
|||
ca ac |
|||
dab bad |
|||
diva avid |
|||
dna and |
|||
drab bard |
|||
Total number of semordnilaps: 158 |
|||
</pre> |
|||
=={{header|Elixir}}== |
|||
<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)</lang> |
|||
{{out}} |
|||
<pre> |
|||
Semordnilap pair: 158 |
|||
[["dab", "bad"], ["drib", "bird"], ["marc", "cram"], ["soma", "amos"], |
|||
["tab", "bat"]] |
|||
</pre> |
|||
=={{header|Erlang}}== |
|||
{{trans|Clojure}} |
|||
<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).</lang> |
|||
{{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. |
|||
<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]</lang> |
|||
{{out}} |
|||
<pre>158 |
|||
("ac", "ca") |
|||
("bad", "dab") |
|||
("avid", "diva") |
|||
("and", "dna") |
|||
("bard", "drab")</pre> |
|||
=={{header|Factor}}== |
|||
<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</lang> |
|||
{{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). |
|||
<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 |
|||
</lang> |
|||
{{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. |
|||
<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 |
|||
</lang> |
|||
=={{header|FreeBASIC}}== |
|||
<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</lang> |
|||
{{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}}== |
|||
<lang 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) |
|||
} |
|||
}</lang> |
|||
{{out}} |
|||
<pre> |
|||
158 pairs |
|||
examples: |
|||
able/elba |
|||
abut/tuba |
|||
ac/ca |
|||
ah/ha |
|||
al/la |
|||
</pre> |
|||
=={{header|Groovy}}== |
|||
<lang groovy>def semordnilapWords(source) { |
|||
def words = [] as Set |
|||
def semordnilaps = [] |
|||
source.eachLine { word -> |
|||
if (words.contains(word.reverse())) semordnilaps << word |
|||
words << word |
|||
} |
|||
semordnilaps |
|||
}</lang> |
|||
Test Code |
|||
<lang groovy>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()}" } </lang> |
|||
{{out}} |
|||
<pre>Found 158 semordnilap words |
|||
ca -> ac |
|||
dab -> bad |
|||
diva -> avid |
|||
dna -> and |
|||
drab -> bard</pre> |
|||
=={{header|Haskell}}== |
|||
<lang 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)</lang> |
|||
{{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: |
|||
<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 |
|||
</lang> |
|||
Sample run with unixdict: |
|||
<pre> |
|||
->smp <unixdict.txt |
|||
ac/ca |
|||
bad/dab |
|||
avid/diva |
|||
and/dna |
|||
bard/drab |
|||
Found 158 semordnilap words |
|||
-> |
|||
</pre> |
|||
=={{header|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: |
|||
<lang j> isSemordnilap=: |.&.> (~: *. e.) ] |
|||
unixdict=: <;._2 freads 'unixdict.txt' |
|||
#semordnilaps=: ~. /:~"1 (,. |.&.>) (#~ isSemordnilap) unixdict |
|||
158</lang> |
|||
We see that there are 158 semordnilaps. |
|||
Here's 5 of them, picked arbitrarily: |
|||
<lang> (5?.158) { semordnilaps |
|||
┌────┬────┐ |
|||
│kay │yak │ |
|||
├────┼────┤ |
|||
│nat │tan │ |
|||
├────┼────┤ |
|||
│avis│siva│ |
|||
├────┼────┤ |
|||
│flow│wolf│ |
|||
├────┼────┤ |
|||
│caw │wac │ |
|||
└────┴────┘</lang> |
|||
=={{header|Java}}== |
|||
{{trans|D}} |
|||
{{works with|Java|7+}} |
|||
<lang java5>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); |
|||
} |
|||
}</lang> |
|||
<pre>ca ac |
|||
dab bad |
|||
diva avid |
|||
dna and |
|||
drab bard |
|||
Semordnilap pairs found: 158</pre> |
|||
=={{header|JavaScript}}== |
|||
===Node.js=== |
|||
{{trans|Clojure}} |
|||
<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]]); |
|||
}</lang> |
|||
===Rhino=== |
|||
{{works with|Rhino|1.7}} |
|||
<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]]); |
|||
}</lang> |
|||
{{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}} |
|||
<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(); |
|||
})();</lang> |
|||
{{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 |
|||
<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)")</lang> |
|||
{{Out}} |
|||
able |
|||
abut |
|||
ac |
|||
ah |
|||
al |
|||
length = 158 |
|||
=={{header|Julia}}== |
|||
<lang 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</lang> |
|||
<pre>julia> length(res[:,1]) |
|||
158 |
|||
julia> res[1:5,:] |
|||
5x2 String Array: |
|||
"able" "elba" |
|||
"abut" "tuba" |
|||
"ac" "ca" |
|||
"ah" "ha" |
|||
"al" "la" </pre> |
|||
=={{header|Kotlin}}== |
|||
{{trans|D}} |
|||
<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)) |
|||
}</lang> |
|||
{{out}} |
|||
<pre> |
|||
Found 158 semordnilap pairs |
|||
[(able, elba), (abut, tuba), (ac, ca), (ah, ha), (al, la)] |
|||
</pre> |
|||
=={{header|Lasso}}== |
|||
<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</lang> |
|||
{{out}} |
|||
<pre>Total found: 158 |
|||
array((dew = wed), (are = era), (den = ned), (oat = tao), (eel = lee))</pre> |
|||
=={{header|Liberty BASIC}}== |
|||
<lang lb> |
|||
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 |
|||
</lang> |
|||
{{out}} |
|||
<pre> |
|||
able / elba |
|||
leper / repel |
|||
lever / revel |
|||
moor / room |
|||
suez / zeus |
|||
tort / trot |
|||
Total number of unique semordnilap pairs is 158 |
|||
</pre> |
|||
=={{header|Lua}}== |
|||
<lang 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</lang> |
|||
{{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}}== |
|||
<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 |
|||
</lang> |
|||
{{out}} |
|||
<pre style="height:30ex;overflow:scroll"> |
|||
Semordnilap pairs: 158 |
|||
ac/ca |
|||
nap/pan |
|||
cos/soc |
|||
loot/tool |
|||
way/yaw |
|||
</pre > |
|||
=={{header|Mathematica}}== |
|||
<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]]</lang> |
|||
{{out}} |
|||
<pre>158 {able,abut,ac,ah,al}</pre> |
|||
=={{header|Nanoquery}}== |
|||
{{trans|Java}} |
|||
<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</lang> |
|||
{{out}} |
|||
<pre>ca ac |
|||
dab bad |
|||
diva avid |
|||
dna and |
|||
drab bard |
|||
Semordnilap pairs found: 158</pre> |
|||
=={{header|NetRexx}}== |
|||
{{Trans|REXX}} |
|||
<lang 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 |
|||
</lang> |
|||
{{out}} |
|||
<pre> |
|||
ac ca |
|||
bad dab |
|||
avid diva |
|||
and dna |
|||
bard drab |
|||
158 words in unixdict.txt have a palindrome |
|||
</pre> |
|||
=={{header|NewLisp}}== |
|||
<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)))) |
|||
</lang> |
|||
{{out}} |
|||
<pre> |
|||
Found 158 pairs. |
|||
damon -- nomad |
|||
kramer -- remark |
|||
lager -- regal |
|||
leper -- repel |
|||
lever -- revel |
|||
</pre> |
|||
=={{header|Nim}}== |
|||
<lang nim>import strutils, sequtils, sets, algorithm |
|||
proc reverse(s): string = |
|||
result = newString(s.len) |
|||
for i,c in s: |
|||
result[s.high - i] = c |
|||
let |
|||
words = readFile("unixdict.txt").strip.splitLines |
|||
wordset = words.toSet |
|||
revs = words.map(reverse) |
|||
var pairs = zip(words, revs).filterIt(it[0] < it[1] and it[1] in wordset) |
|||
echo "Total number of semordnilaps: ", pairs.len |
|||
pairs.sort(proc (x,y): auto = cmp(x[0].len,y[0].len)) |
|||
echo pairs[pairs.high-4..pairs.high]</lang> |
|||
{{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}}== |
|||
<lang 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</lang> |
|||
{{out}} |
|||
<pre> |
|||
Semordnilap pairs: 158 |
|||
tar rat |
|||
sera ares |
|||
sub bus |
|||
tic cit |
|||
mid dim |
|||
</pre> |
|||
=={{header|Octave}}== |
|||
<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)</lang> |
|||
'''Output:''' |
|||
<pre>ans = 158 |
|||
able elba |
|||
abut tuba |
|||
ac ca |
|||
ah ha |
|||
al la</pre> |
|||
=={{header|Oforth}}== |
|||
<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) ] |
|||
] ;</lang> |
|||
{{out}} |
|||
<pre> |
|||
>semordnilap dup size println left(5) println |
|||
158 |
|||
[[ac, ca], [bad, dab], [avid, diva], [and, dna], [bard, drab]] |
|||
</pre> |
|||
=={{header|Perl}}== |
|||
<lang perl>while (<>) { |
|||
chomp; |
|||
my $r = reverse; |
|||
$seen{$r}++ and $c++ < 5 and print "$_ $r\n" or $seen{$_}++; |
|||
} |
|||
print "$c\n"</lang> |
|||
=={{header|Phix}}== |
|||
<lang Phix>sequence words={}, semilordnaps={} |
|||
object word |
|||
constant fn = open("demo\\unixdict.txt","r") |
|||
while 1 do |
|||
word = trim(gets(fn)) |
|||
if atom(word) then exit end if |
|||
if find(reverse(word),words) then |
|||
semilordnaps = append(semilordnaps,word) |
|||
end if |
|||
words = append(words,word) |
|||
end while |
|||
close(fn) |
|||
?length(semilordnaps) |
|||
for i=1 to 5 do |
|||
word = semilordnaps[i] |
|||
printf(1,"%s - %s\n",{word,reverse(word)}) |
|||
end for</lang> |
|||
{{out}} |
|||
<pre> |
|||
158 |
|||
ca - ac |
|||
dab - bad |
|||
diva - avid |
|||
dna - and |
|||
drab - bard |
|||
</pre> |
|||
=={{header|PHP}}== |
|||
{{trans|Raku}} |
|||
<lang 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";</lang> |
|||
{{out}} |
|||
<pre>158 |
|||
ti it |
|||
tide edit |
|||
top pot |
|||
tram mart |
|||
un nu</pre> |
|||
=={{header|PicoLisp}}== |
|||
<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)) )</lang> |
|||
{{out}} |
|||
<pre>158 ("able" "abut" "ac" "ah" "al")</pre> |
|||
=={{header|PL/I}}== |
|||
<lang 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; |
|||
</lang> |
|||
<pre> |
|||
There are 158 pairs. |
|||
</pre> |
|||
5 values at random: |
|||
<pre> |
|||
ward draw |
|||
was saw |
|||
wed dew |
|||
wolf flow |
|||
won now |
|||
</pre> |
|||
=={{header|PowerShell}}== |
|||
<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 |
|||
</lang> |
|||
{{Out}} |
|||
<pre> |
|||
Name Value |
|||
---- ----- |
|||
nil lin |
|||
regal lager |
|||
tom mot |
|||
. |
|||
. |
|||
. |
|||
peek keep |
|||
soma amos |
|||
nob bon |
|||
Semordnilap count: 158 |
|||
</pre> |
|||
=={{header|Python}}== |
|||
===Idiomatic=== |
|||
<lang python>>>> with open('unixdict.txt') as f: |
|||
wordset = set(f.read().strip().split()) |
|||
>>> revlist = (''.join(word[::-1]) for word in wordset) |
|||
>>> pairs = set((wrd, rev) for wrd, rev in zip(wordset, revlist) |
|||
if wrd < 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')] |
|||
>>> </lang> |
|||
{{trans|Raku}} |
|||
<lang python>import os |
|||
import random |
|||
# Load file and put it to dictionary as set |
|||
dictionary = {word.rstrip(os.linesep) for word in open('unixdict.txt')} |
|||
# List of results |
|||
results = [] |
|||
for word in dictionary: |
|||
# [::-1] reverses string |
|||
reversed_word = word[::-1] |
|||
if reversed_word in dictionary and word > reversed_word: |
|||
results.append((word, reversed_word)) |
|||
print(len(results)) |
|||
for words in random.sample(results, 5): |
|||
print(' '.join(words))</lang> |
|||
{{out}} |
|||
<pre>158 |
|||
nob bon |
|||
mac cam |
|||
dub bud |
|||
viva aviv |
|||
nomad damon</pre> |
|||
===As a fold, using reduce=== |
|||
{{Works with|Python|3.7}} |
|||
<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()</lang> |
|||
{{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. |
|||
<lang python>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 usernames:', |
|||
* ['%s %s' % p for p in example_pairs]+['...'], |
|||
sep='\n' |
|||
) |
|||
return semordnilaps |
|||
if __name__ == '__main__': |
|||
main(*sys.argv[1:]) |
|||
</lang> |
|||
{{Out}} |
|||
<pre> |
|||
found 158 semordnilap usernames: |
|||
mug gum |
|||
revel lever |
|||
gab bag |
|||
lime emil |
|||
lag gal |
|||
... |
|||
</pre> |
|||
=={{header|Racket}}== |
|||
<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)) |
|||
</lang> |
|||
{{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}} |
|||
<lang perl6>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);</lang> |
|||
{{out}} |
|||
<pre>abut tuba |
|||
avid diva |
|||
bard drab |
|||
loot tool |
|||
part trap</pre> |
|||
=={{header|REXX}}== |
|||
===version 1=== |
|||
<lang rexx>/* 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 */</lang> |
|||
{{out}} |
|||
<pre> |
|||
ac ca |
|||
bad dab |
|||
avid diva |
|||
and dna |
|||
bard drab |
|||
158 words in unixdict.txt have a palindrome |
|||
</pre> |
|||
===version 2=== |
|||
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''' <big> & </big> '''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, trailing, or imbedded 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 in a dictionary (the default is UNIXDICT.TXT). */ |
|||
#=0 /*number palindromes (so far).*/ |
|||
parse arg iFID .; if iFID=='' then iFID='UNIXDICT.TXT' /*Not specified? Use default.*/ |
|||
@.= /*uppercase no─duplicated word*/ |
|||
do while lines(iFID)\==0; _=space(linein(iFID),0) /*read a word from dictionary.*/ |
|||
parse upper var _ u /*obtain an uppercase version.*/ |
|||
if length(_)<2 | @.u\=='' then iterate /*can't be a unique palindrome*/ |
|||
r=reverse(u) /*get the reverse of the word.*/ |
|||
if @.r\=='' then do; #=#+1 /*find a palindrome pair ? */ |
|||
if #<6 then say @.r',' _ /*just show 1st 5 palindromes.*/ |
|||
end /* [↑] bump palindrome count.*/ |
|||
@.u=_ /*define a unique palindrome. */ |
|||
end /*while*/ /* [↑] read the dictionary. */ |
|||
say |
|||
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> |
|||
ac, ca |
|||
bad, dab |
|||
avid, diva |
|||
and, dna |
|||
bard, drab |
|||
There're 158 unique palindrome pairs in the dictionary file: UNIXDICT.TXT |
|||
</pre> |
|||
=={{header|Ring}}== |
|||
<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 |
|||
</lang> |
|||
{{out}} |
|||
<pre> |
|||
brag garb |
|||
edit tide |
|||
it ti |
|||
mit tim |
|||
suez zeus |
|||
Total number of unique pairs = 158 |
|||
</pre> |
|||
=={{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) |
|||
<lang Ruby>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}"}</lang> |
|||
{{out}} |
|||
<pre> |
|||
There are 158 semordnilaps, of which the following are 5: |
|||
able elba |
|||
abut tuba |
|||
ac ca |
|||
ah ha |
|||
al la |
|||
</pre> |
|||
Another way |
|||
<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}"}</lang> |
|||
output is the same above. |
|||
=={{header|Rust}}== |
|||
{{trans|Java}} |
|||
<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), |
|||
} |
|||
}</lang> |
|||
{{out}} |
|||
<pre> |
|||
ca ac |
|||
dab bad |
|||
diva avid |
|||
dna and |
|||
drab bard |
|||
Semordnilap pairs found: 158 |
|||
</pre> |
|||
=={{header|Scala}}== |
|||
<lang scala>val wordsAll = scala.io.Source.fromURL("http://www.puzzlers.org/pub/wordlists/unixdict.txt").getLines.map(_.toLowerCase).to[IndexedSeq] |
|||
/** |
|||
* 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:Seq[String] ) : Seq[(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,i) => (w,w.reverse) // drop the index |
|||
} |
|||
} |
|||
val ss = semordnilap(wordsAll) |
|||
{ |
|||
println( ss.size + " matches, including: \n" ) |
|||
println( ss.take(5).mkString( "\n" ) ) |
|||
}</lang> |
|||
{{out}} |
|||
<pre>158 matches, including: |
|||
(able,elba) |
|||
(abut,tuba) |
|||
(ac,ca) |
|||
(ah,ha) |
|||
(al,la) |
|||
</pre> |
|||
=={{header|Seed7}}== |
|||
<lang seed7>$ include "seed7_05.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 |
|||
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("www.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;</lang> |
|||
{{out}} |
|||
<pre> |
|||
ca ac |
|||
dab bad |
|||
diva avid |
|||
dna and |
|||
drab bard |
|||
Semordnilap pairs: 158 |
|||
</pre> |
|||
=={{header|Sidef}}== |
|||
{{trans|Perl}} |
|||
<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</lang> |
|||
{{out}} |
|||
<pre> |
|||
$ sidef semordnilap.sf < unixdict.txt |
|||
ca ac |
|||
dab bad |
|||
diva avid |
|||
dna and |
|||
drab bard |
|||
158 |
|||
</pre> |
|||
=={{header|Stata}}== |
|||
<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 | |
|||
+-------------+</lang> |
|||
=={{header|SuperCollider}}== |
|||
{{incorrect|SuperCollider|The number of pairs should be 158.}} |
|||
<lang SuperCollider>( |
|||
var text, words, sdrow, semordnilap, selection; |
|||
File.use("unixdict.txt".resolveRelative, "r", { |f| x = text = f.readAllString }); |
|||
words = text.split(Char.nl).collect { |each| each.asSymbol }; |
|||
sdrow = text.reverse.split(Char.nl).collect { |each| each.asSymbol }; |
|||
semordnilap = sect(words, sdrow); // converted to symbols so intersection is possible |
|||
semordnilap = semordnilap.collect { |each| each.asString }; |
|||
"There are % in unixdict.txt\n".postf(semordnilap.size); |
|||
"For example those, with more than 3 characters:".postln; |
|||
selection = semordnilap.select { |each| each.size >= 4 }.scramble.keep(4); |
|||
selection.do { |each| "% %\n".postf(each, each.reverse); }; |
|||
)</lang> |
|||
Answers: |
|||
<lang SuperCollider> |
|||
There are 405 in unixdict.txt |
|||
For example those, with more than 3 characters: |
|||
live evil |
|||
tram mart |
|||
drib bird |
|||
eros sore |
|||
</lang> |
|||
This seems wrong, but perhaps the test file has changed? |
|||
=={{header|Swift}}== |
|||
<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))")</lang> |
|||
{{out}} |
|||
<pre>Found 158 pairs |
|||
Five examples: [("dial", "laid"), ("emil", "lime"), ("burg", "grub"), ("den", "ned"), ("enol", "lone")]</pre> |
|||
=={{header|Tcl}}== |
|||
<lang 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 |
|||
}</lang> |
|||
{{out}} |
|||
<pre> |
|||
Found 158 reversed pairs |
|||
Example: lap/pal |
|||
Example: jar/raj |
|||
Example: ix/xi |
|||
Example: eros/sore |
|||
Example: bard/drab |
|||
</pre> |
|||
=={{header|TUSCRIPT}}== |
|||
<lang 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 |
|||
</lang> |
|||
{{out}} |
|||
<pre> |
|||
unixdict.txt contains 158 palindromes |
|||
1. able'elba |
|||
2. abut'tuba |
|||
3. ac'ca |
|||
4. ah'ha |
|||
5. al'la |
|||
</pre> |
|||
=={{header|VBScript}}== |
|||
<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 |
|||
</lang> |
|||
{{out}} |
|||
<pre> |
|||
ca - ac |
|||
dab - bad |
|||
diva - avid |
|||
dna - and |
|||
drab - bard |
|||
Total Count: 158 |
|||
</pre> |
|||
=={{header|Wren}}== |
|||
<lang ecmascript>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])")</lang> |
|||
{{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> |
|||
=={{header|XPL0}}== |
|||
<lang 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); |
|||
]</lang> |
|||
{{out}} |
|||
<pre> |
|||
able elba |
|||
abut tuba |
|||
ac ca |
|||
ah ha |
|||
al la |
|||
158 |
|||
</pre> |
|||
=={{header|zkl}}== |
|||
<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();</lang> |
|||
{{out}} |
|||
<pre> |
|||
158 |
|||
L(L("bog","gob"),L("cup","puc"),L("mart","tram"),L("kay","yak"),L("able","elba")) |
|||
</pre> |
|||
unique 'pairs |
|||
print map 1..5 => [sample pairs]</lang> |
|||
{{omit from|Brlcad}} |
|||
{{omit from|GUISS}} |
|||
{{omit from|Locomotive Basic}} |
|||
{{omit from|Openscad}} |
|||
{{omit from|TPP}} |
|||
{{omit from|ZX Spectrum Basic}} |
Revision as of 06:24, 20 February 2021
Arturo
<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]</lang>