Semordnilap
You are encouraged to solve this task according to the task description, using any language you may know.
A semordnilap, is a word (or phrase) that spells a different word (or phrase) backward. "Semordnilap" is a word that itself is a semordnilap.
Example: lager and regal
Using only words from the unixdict, report the total number of unique semordnilap pairs, and print 5 examples. (Note that lager/regal and regal/lager should be counted as one unique pair.)
- Cf.
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>
- Output:
>./semordnilap unixdict.txt ca - ac dab - bad diva - avid dna - and drab - bard pairs found: 158
Aime
<lang aime>text reverse(text s) {
data b; integer i;
i = length(s);
while (i) {
i -= 1;
b_insert(b, -1, character(s, i));
}
return b_string(b);
}
integer main(void) {
integer c, p; record r; file f; text s;
f_affix(f, "unixdict.txt");
while (f_line(f, s) != -1) {
r_p_integer(r, s, 0);
}
c = 0; p = 0;
if (r_first(r, s)) {
do {
text t;
t = reverse(s);
if (compare(s, t) > 0) {
if (r_key(r, t)) {
p += 1;
if (c < 5) {
c += 1;
o_text(s);
o_byte(' ');
o_text(t);
o_byte('\n');
}
}
}
} while (r_greater(r, s, s));
}
o_text("Semordnilap pairs: ");
o_integer(p);
o_text("\n");
return 0;
}</lang>
- Output:
ca ac dab bad diva avid dna and drab bard Semordnilap pairs: 158
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>
output:
able elba abut tuba ac ca ah ha al la 158 words
BBC BASIC
<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>
Output:
damon nomad kramer remark lager regal leper repel lever revel Total number of unique pairs = 158
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> Output:
tv vt ir ri ac ca eh he ku uk semordnilap 158 dnuoF
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>
- Output:
ca ac dab bad diva avid dna and drab bard Semordnilap pairs: 158
C++
<lang cpp>#include <fstream>
- include <iostream>
- include <set>
- include <string>
int main() {
std::ifstream input("unixdict.txt");
if (!input) {
return 1; // couldn't open input file
}
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';
}
++count;
}
}
std::cout << "\nSemordnilap pairs: " << count << '\n';
}</lang>
- Output:
ca ac dab bad diva avid dna and drab bard Semordnilap pairs: 158
Clojure
<lang clojure>(use 'clojure.java.io) (require '[clojure.string :as string])
(def dict-file (or (first *command-line-args*) "unixdict.txt"))
(def dict (set (line-seq (reader dict-file))))
(defn semordnilap? [word]
(let [rev (string/reverse word)] (and (not (= word rev)) (dict rev))))
(def semordnilaps
(filter (fn x y (<= (compare x y) 0)) (map (fn [word] [word (string/reverse word)]) (filter semordnilap? dict))))
(printf "There are %d semordnilaps in %s. Here are 5:\n"
(count semordnilaps) dict-file)
(dorun (map println (sort (take 5 (shuffle semordnilaps)))))</lang>
- Output:
There are 158 semordnilaps in unixdict.txt. Here are 5: [bog gob] [gnaw wang] [it ti] [los sol] [mot tom]
D
<lang d>import std.stdio, std.file, std.string, std.algorithm;
void main() {
bool[string] seenWords; size_t pairCount = 0;
foreach (word; readText("unixdict.txt").toLower().splitter()) {
auto drow = word.dup.reverse;
if (drow in seenWords) {
if (pairCount++ < 5)
writeln(word, " ", drow);
} else
seenWords[word] = true;
}
writeln("\nSemordnilap pairs: ", pairCount);
}</lang>
- Output:
ca ac dab bad diva avid dna and drab bard Semordnilap pairs: 158
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>
- Output:
158 pairs examples: able/elba abut/tuba ac/ca ah/ha al/la
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>
- Output:
Found 158 semordnilap words ca -> ac dab -> bad diva -> avid dna -> and drab -> bard
Haskell
<lang haskell>import qualified Data.Set as S
semordnilaps = snd . foldl f (S.empty,[]) where f (s,w) x | S.member (reverse x) s = (s, x:w) | otherwise = (S.insert x s, w)
main=do s <- readFile "unixdict.txt" let l = semordnilaps (lines s) print $ length l mapM_ print $ map (\x->(x, reverse x)) $ take 5 l</lang>
- Output:
158
("zeus","suez")
("zap","paz")
("yaw","way")
("yap","pay")
("yam","may")
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>
Java
<lang java5>import java.io.*; import java.util.*;
public class Semordnilaps {
public static void main(String[] args) throws IOException {
List<String> lst = readLines("unixdict.txt");
Set<String> seen = new HashSet<>();
int count = 0;
for (String w : lst) {
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);
}
private static List<String> readLines(String fn) throws IOException {
List<String> lines;
try (BufferedReader br = new BufferedReader(new FileReader(fn))) {
lines = new ArrayList<>();
String line;
while ((line = br.readLine()) != null)
lines.add(line.trim().toLowerCase());
}
return lines;
}
}</lang>
ca ac dab bad diva avid dna and drab bard Semordnilap pairs found: 158
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>
julia> length(res[:,1]) 158 julia> res[1:5,:] 5x2 String Array: "able" "elba" "abut" "tuba" "ac" "ca" "ah" "ha" "al" "la"
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> Output:
able / elba leper / repel lever / revel moor / room suez / zeus tort / trot Total number of unique semordnilap pairs is 158
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>
- Output:
158 {able,abut,ac,ah,al}
NetRexx
<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> Output:
ac ca bad dab avid diva and dna bard drab 158 words in unixdict.txt have a palindrome
OCaml
<lang ocaml>module StrSet = Set.Make(String)
let str_rev s =
let len = String.length s in let r = String.create len in for i = 0 to len - 1 do r.[i] <- s.[len - 1 - i] done; (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>
Perl
<lang perl>while (<>) { chomp; my $r = reverse; $seen{$r}++ and $c++ < 5 and print "$_ $r\n" or $seen{$_}++; }
print "$c\n"</lang>
Perl 6
This is written in the "sigilless" style in order to fool people into thinking that Perl 6 is elegant. :-) <lang perl6>my \words = set slurp("unixdict.txt").lines;
my \sems = gather for words.list -> \word {
my \drow = word.flip; take [word,drow] if drow ∈ words and drow lt word;
}
.say for +sems, sems.pick(5);</lang>
- Output:
158 golf flog repel leper top pot live evil yap pay
We will not comment on the hilarity of some of these...
PHP
<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>
- Output:
158 ti it tide edit top pot tram mart un nu
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>
There are 158 pairs.
5 values at random:
ward draw was saw wed dew wolf flow won now
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>
<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>
- Output:
158 nob bon mac cam dub bud viva aviv nomad damon
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> Output:
ac ca bad dab avid diva and dna bard drab 158 words in unixdict.txt have a palindrome
version 2
This REXX version makes use of sparse (stemmed) arrays.
The dictionary file wasn't assumed to be in any particular case (upper/lower/mixed).
For instance, DNA & and would be considered palindromes.
The UNIXDICT dictionary specified to be used is all lowercase, however, but the REXX
program assumes that the words may be in any case.
The order of the words in the dictionary isn't important.
Any blank lines or duplicate words in the dictionary are ignored (as duplicate words wouldn't make them unique).
Any leading or trailing blanks are also ignored (as well as tab characters or other whitespace).
The palindrome pairs are shown with a comma delimiter in case there're phrases (words with imbedded blanks like Sing Sing).
The (first five) palindrome pairs are shown as they are specified (respective to case) in the dictionary.
<lang rexx>/*REXX program finds palindrome pairs using a dictionary (UNIXDICT.TXT)*/
- =0 /*number of palindromes (so far).*/
parse arg iFID .; if iFID== then iFID='UNIXDICT.TXT' /*use default?*/ @.= /*caseless non-duplicated words. */
do while lines(ifid)\==0; _=linein(iFID); u=translate(space(_,0))
if length(u)<2 | @.u\== then iterate /*can't be a unique pal.*/
r=reverse(u)
if @.r\== then do; #=#+1 /*found palindrome pair.*/
if #<6 then say @.r',' _ /*only list first 5 pals*/
end
@.u=_
end /*while*/
say /*a unique palindrome pair = a semordnilap*/ say "There're" # 'unique palindrome pairs in the dictionary file:' iFID
/*stick a fork in it, we're done.*/</lang>
output when using the default dictionary as the input
ac, ca bad, dab avid, diva and, dna bard, drab There're 158 unique palindrome pairs in the dictionary file: UNIXDICT.TXT
Ruby
Note: An alternative (old fashioned) method of solving this task (not using a Set as done by other solutions) is to produce 2 sorted files and walk through them. This can be done entirly on disk if required, when done in memory it is faster than a set for large samples.--Nigel Galloway 11:12, 17 September 2012 (UTC) <lang Ruby>DICT=File.readlines("unixdict.txt").collect{|line| line.tr("\n", "")} res=[] i = 0 DICT.collect {|z| z.reverse}.sort.each {|z|
i+=1 while z > DICT[i] and i < DICT.length-1 res.push z if z.eql?(DICT[i]) and z < z.reverse
} puts "There are #{res.length} semordnilaps, of which the following are 5:" res.sample(5).each {|z| puts "#{z} #{z.reverse}"} </lang> Produces (the five examples should change with each invocation):
There are 158 semordnilaps, of which the following are 5: flow wolf flog golf but tub aryl lyra avis siva
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>
- Output:
158 matches, including: (able,elba) (abut,tuba) (ac,ca) (ah,ha) (al,la)
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>
- Output:
ca ac dab bad diva avid dna and drab bard Semordnilap pairs: 158
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>
- Output:
Found 158 reversed pairs Example: lap/pal Example: jar/raj Example: ix/xi Example: eros/sore Example: bard/drab
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> Output:
unixdict.txt contains 158 palindromes 1. able'elba 2. abut'tuba 3. ac'ca 4. ah'ha 5. al'la
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>
Output:
able elba abut tuba ac ca ah ha al la 158