Semordnilap
You are encouraged to solve this task according to the task description, using any language you may know.
A semordnilap is a word that spells a different word (or phrase) backward.
Example: lager and regal
- Task
Using only words from this list, 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.)
- Metrics
- Counting
- Word frequency
- Letter frequency
- Jewels and stones
- I before E except after C
- Bioinformatics/base count
- Count occurrences of a substring
- Count how many vowels and consonants occur in a string
- Remove/replace
- XXXX redacted
- Conjugate a Latin verb
- Remove vowels from a string
- String interpolation (included)
- Strip block comments
- Strip comments from a string
- Strip a set of characters from a string
- Strip whitespace from a string -- top and tail
- Strip control codes and extended characters from a string
- Anagrams/Derangements/shuffling
- Word wheel
- ABC problem
- Sattolo cycle
- Knuth shuffle
- Ordered words
- Superpermutation minimisation
- Textonyms (using a phone text pad)
- Anagrams
- Anagrams/Deranged anagrams
- Permutations/Derangements
- Find/Search/Determine
- ABC words
- Odd words
- Word ladder
- Semordnilap
- Word search
- Wordiff (game)
- String matching
- Tea cup rim text
- Alternade words
- Changeable words
- State name puzzle
- String comparison
- Unique characters
- Unique characters in each string
- Extract file extension
- Levenshtein distance
- Palindrome detection
- Common list elements
- Longest common suffix
- Longest common prefix
- Compare a list of strings
- Longest common substring
- Find common directory path
- Words from neighbour ones
- Change e letters to i in words
- Non-continuous subsequences
- Longest common subsequence
- Longest palindromic substrings
- Longest increasing subsequence
- Words containing "the" substring
- Sum of the digits of n is substring of n
- Determine if a string is numeric
- Determine if a string is collapsible
- Determine if a string is squeezable
- Determine if a string has all unique characters
- Determine if a string has all the same characters
- Longest substrings without repeating characters
- Find words which contains all the vowels
- Find words which contains most consonants
- Find words which contains more than 3 vowels
- Find words which first and last three letters are equals
- Find words which odd letters are consonants and even letters are vowels or vice_versa
- Formatting
- Substring
- Rep-string
- Word wrap
- String case
- Align columns
- Literals/String
- Repeat a string
- Brace expansion
- Brace expansion using ranges
- Reverse a string
- Phrase reversals
- Comma quibbling
- Special characters
- String concatenation
- Substring/Top and tail
- Commatizing numbers
- Reverse words in a string
- Suffixation of decimal numbers
- Long literals, with continuations
- Numerical and alphabetical suffixes
- Abbreviations, easy
- Abbreviations, simple
- Abbreviations, automatic
- Song lyrics/poems/Mad Libs/phrases
- Mad Libs
- Magic 8-ball
- 99 Bottles of Beer
- The Name Game (a song)
- The Old lady swallowed a fly
- The Twelve Days of Christmas
- Tokenize
- Text between
- Tokenize a string
- Word break problem
- Tokenize a string with escaping
- Split a character string based on change of character
- Sequences
11l
<lang 11l>V wordset = Set(File(‘unixdict.txt’).read().split("\n")) V revlist = wordset.map(word -> reversed(word)) V pairs = Set(zip(wordset, revlist).filter((wrd, rev) -> wrd < rev & rev C :wordset))
print(pairs.len) print(sorted(Array(pairs), key' p -> (p[0].len, p))[(len)-5..])</lang>
- Output:
158 [(damon, nomad), (lager, regal), (leper, repel), (lever, revel), (kramer, remark)]
8th
We're using a map to keep track of what's been seen, and an array to store the results. We load the "unixdict.txt" as an "asset", meaning a file stored alongside the program code: <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>
- Output:
158 pairs trap is the reverse of part nab is the reverse of ban la is the reverse of al ta is the reverse of at tin is the reverse of nit
Ada
Before tackling the real problem, we specify a package String_Vectors and a class String_Vectors.Vec, to store the list of words in the dictionary:
<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>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>
- Output:
ca ac dab bad diva avid dna and drab bard Semordnilap pairs: 158
ALGOL 68
The Algol 68 G "read" PRAGMA is used to include the associative array code from Associative_array/Iteration. <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>
- Output:
ac & ca bad & dab avid & diva and & dna bard & drab 158 semordnilaps found
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>
AutoHotkey
<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>
- Output:
5 Examples: ac / ca bad / dab avid / diva and / dna bard / drab Total 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 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>
- Output:
158 5 random results: keep peek lever revel ix xi avid diva gar rag
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>
- Output:
ca ac dab bad diva avid dna and drab bard Semordnilap pairs: 158
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>
- Output:
There are 158 semordnilaps in unixdict.txt. Here are 5: [bog gob] [gnaw wang] [it ti] [los sol] [mot tom]
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>
- Output:
* (main) Found pairs: 158 ("able" . "elba") ("abut" . "tuba") ("ac" . "ca") ("ah" . "ha") ("al" . "la")
Crystal
<lang ruby>require "set"
UNIXDICT = File.read("unixdict.txt").lines
def word?(word : String)
UNIXDICT.includes?(word)
end
- is it a word and is it a word backwards?
semordnilap = UNIXDICT.select { |word| word?(word) && word?(word.reverse) }
- consolidate pairs like [bad, dab] == [dab, bad]
final_results = semordnilap.map { |word| [word, word.reverse].to_set }.uniq
- sets of N=1 mean the word is identical backwards
- print out the size, and 5 random pairs
puts final_results.size, final_results.sample(5) </lang>
- Output:
246 [Set{"s's"}, Set{"eire", "erie"}, Set{"bag", "gab"}, Set{"mat", "tam"}, Set{"gel", "leg"}]
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>
- Output:
ca ac dab bad diva avid dna and drab bard Semordnilap pairs: 158
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>
- Output:
158 [Tuple!(string, char[])("bag", "gab"), Tuple!(string, char[])("pat", "tap"), Tuple!(string, char[])("avis", "siva"), Tuple!(string, char[])("haw", "wah"), Tuple!(string, char[])("rot", "tor")]
Delphi
<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>
- Output:
Time pass: 558 ms [i7-4500U Windows 7] Semordnilap found: 158 Five random samples: on - no me - em peek - keep ton - not viva - aviv
EchoLisp
We use the words library, and the french dictionary delivered with EchoLisp.
<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)))
- Output:
(task)
pairs → 345 longest → (rengager tresser strasse reveler retrace)
</lang>
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>
- Output:
ca ac dab bad diva avid dna and drab bard Total number of semordnilaps: 158
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>
- Output:
Semordnilap pair: 158 [["dab", "bad"], ["drib", "bird"], ["marc", "cram"], ["soma", "amos"], ["tab", "bat"]]
Erlang
<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>
- Output:
There are 158 semordnilaps in unixdict.txt aryl/lyra caw/wac cram/marc dine/enid dual/laud
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>
- Output:
158 ("ac", "ca") ("bad", "dab") ("avid", "diva") ("and", "dna") ("bard", "drab")
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>
- Output:
158 semordnilap pairs. { { "pan" "nap" } { "lac" "cal" } { "tang" "gnat" } { "wolf" "flow" } { "mac" "cam" } }
Forth
This code uses a Forth wordlist to contain the dictionary, and uses the Forth-2012 TRAVERSE-WORDLIST to walk through it (a simpler way would be to check for the presence of the reversed word when putting the word into the wordlist).
One interesting issue is how I get each pair only once and exclude palindromes: I accept only pairs where nt<nt2. A type checking bigot will likely argue that nts should not be compared with <, because they are opaque data types. But their implementation does not matter for this check: Whatever bit patterns these two nts get, either it's the same nt, then nt<nt2 will return false, as desired; and if they are different, exactly one of nt<nt2 and nt2<nt will return true.
The code uses two Gforth-specific words: EXECUTE-PARSING (implementable in standard Forth, but not easy) for allowing to provide the name of the defined word on the stack; and FIND-NAME-IN to look up the reversed word (could be replaced with a use of the standard SEARCH-WORDLIST, but the code would become a little more complicated).
<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>
- Output:
suez zeus paz zap way yaw pay yap may yam 158
Fortran
Please read the comments at the beginning of the f90 source to see the compilation instructions and output of 5 random words from a run. Note that program Semordnilap opens the file unixdict.txt . It does not read from stdin, hence the command line redirection from unixdict.txt is irrelevant. I haven't bothered to change it.
<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>
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
' empty keyboard buffer While InKey <> "" : Wend Print : Print "Hit any key to end program" Sleep End</lang>
- Output:
Start reading unixdict.txt ... Done Start looking for semordnilap Found 158 unique semordnilap pairs Display 5 semordnilap pairs damon nomad kramer remark lager regal leper repel lever revel
Go
<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
:: (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>
- Output:
158 ("damon","nomad") ("kramer","remark") ("lager","regal") ("leper","repel") ("lever","revel")
Icon and 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:
->smp <unixdict.txt ac/ca bad/dab avid/diva and/dna bard/drab Found 158 semordnilap words ->
J
We find all semordnilaps by filtering only words which, when reversed, are a member of the set of dictionary words and are not palindromes. We then find only unique semordnilaps by pairing them with their reversed instance, sorting each pair, and eliminating duplicates pairs:
<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.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>
ca ac dab bad diva avid dna and drab bard Semordnilap pairs found: 158
JavaScript
Node.js
<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
<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>
- Output:
There are 158 semordnilaps in unixdict.txt. Here are 5: loot,tool ah,ha dial,laid dine,enid haw,wah
macOS JavaScript for Automation
<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>
- Output:
158 "revel" -> "lever" "repel" -> "leper" "remark" -> "kramer" "regal" -> "lager" "nomad" -> "damon"
jq
The following program illustrates several points about jq:
- jq can be used to process text, as well as JSON;
- for text-processing tasks for which awk is well-suited, jq may be slightly slower;
- jq objects (i.e. JSON objects) can be used to define time-efficient mappings from strings.
Here are some running times on the same machine:
- awk program:
user 0m0.134s; sys 0m0.012s
- time /usr/local/bin/jq -M -s -R -r -f semordnilap.jq unixdict.txt
user 0m0.440s; sys 0m0.010s <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>
- Output:
able abut ac ah al length = 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"
Kotlin
<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>
- Output:
Found 158 semordnilap pairs [(able, elba), (abut, tuba), (ac, ca), (ah, ha), (al, la)]
Ksh
<lang ksh>
- !/bin/ksh
- Semordnilap
- # Variables:
integer MIN_WORD_LEN=1 TRUE=1 FALSE=0 dict='/home/ostrande/prj/roscode/unixdict.txt'
integer i j=0 k=0 typeset -A word
- # Functions:
- # Function _flipit(string) - return flipped string
function _flipit { typeset _buf ; _buf="$1" typeset _tmp ; unset _tmp
for (( _i=$(( ${#_buf}-1 )); _i>=0; _i-- )); do _tmp="${_tmp}${_buf:${_i}:1}" done
echo "${_tmp}" }
- # Function _isword(word, wordlist) - return 1 if word in wordlist
function _isword { typeset _word ; _word="$1" typeset _wordlist ; nameref _wordlist="$2"
[[ ${_word} == @(${_wordlist}) ]] && return $TRUE return $FALSE }
######
- main #
######
- # Due to the large number of words in unixdist.txt subgroup by 1st letter and length
- # only accept words containing alpha chars and > 1 chars
while read; do $REPLY != *+(\W)* && $REPLY != *+(\d)* && \ (( ${#REPLY} > MIN_WORD_LEN )) && word[${REPLY:0:1}][${#REPLY}]+=( $REPLY ) done < ${dict}
print Examples: for fl in ${!word[*]}; do # Over $fl first letter for len in ${!word[${fl}][*]}; do # Over $len word length for ((i=0; i<${#word[${fl}][${len}][*]}; i++)); do Word=${word[${fl}][${len}][i]} # dummy Try=$(_flipit ${Word}) if [[ ${Try} != ${Word} ]]; then # no palindromes unset words oldIFS="$IFS" ; IFS='|' ; words=${word[${Try:0:1}][${#Try}][*]} ; IFS="${oldIFS}" _isword "${Try}" words if (( $? )); then if [[ ${Try} != @(${uniq%\|*}) ]]; then ((++j)) (( ${#Word} >= 5 )) && (( k<=5 )) && print $((++k)). ${Word} ${Try} uniq+="${Try}|${Word}|" fi fi fi done done done echo ; print ${j} pairs found.</lang>
- Output:
Examples: 1. damon nomad 2. kramer remark 3. lager regal 4. leper repel 5. lever revel
158 pairs found.
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
'
'
- examples</lang>
- Output:
Total found: 158 array((dew = wed), (are = era), (den = ned), (oat = tao), (eel = lee))
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
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>
- Output:
There are 158 semordnilaps in unixdict.txt. Here are 5: deer -> reed rat -> tar pus -> sup meet -> teem bat -> tab
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>
- Output:
Semordnilap pairs: 158 ac/ca nap/pan cos/soc loot/tool way/yaw
Mathematica/Wolfram Language
<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}
Nanoquery
<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>
- Output:
ca ac dab bad diva avid dna and drab bard Semordnilap pairs found: 158
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
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>
- Output:
Found 158 pairs. damon -- nomad kramer -- remark lager -- regal leper -- repel lever -- revel
Nim
<lang nim>import strutils, sequtils, sets, algorithm
proc reversed(s: string): string =
result = newString(s.len) for i, c in s: result[s.high - i] = c
let
words = readFile("unixdict.txt").strip().splitLines() wordset = words.toHashSet revs = words.map(reversed)
var pairs = zip(words, revs).filterIt(it[0] < it[1] and it[1] in wordset)
echo "Total number of semordnilaps: ", pairs.len pairs = pairs.sortedByIt(it[0].len) echo pairs[^5..^1]</lang>
- Output:
Total number of semordnilaps: 158 @[(a: damon, b: nomad), (a: lager, b: regal), (a: leper, b: repel), (a: lever, b: revel), (a: kramer, b: remark)]
OCaml
<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>
- Output:
Semordnilap pairs: 158 tar rat sera ares sub bus tic cit mid dim
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:
ans = 158 able elba abut tuba ac ca ah ha al la
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>
- Output:
>semordnilap dup size println left(5) println 158 [[ac, ca], [bad, dab], [avid, diva], [and, dna], [bard, drab]]
Perl
<lang perl>while (<>) { chomp; my $r = reverse; $seen{$r}++ and $c++ < 5 and print "$_ $r\n" or $seen{$_}++; }
print "$c\n"</lang>
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>
- Output:
158 ca - ac dab - bad diva - avid dna - and drab - bard
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
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>
- Output:
158 ("able" "abut" "ac" "ah" "al")
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
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>
- Output:
Name Value ---- ----- nil lin regal lager tom mot . . . peek keep soma amos nob bon Semordnilap count: 158
PureBasic
<lang PureBasic>If OpenConsole("")=0 : End 1 : EndIf If ReadFile(0,"./Data/unixdict.txt")=0 : End 2 : EndIf NewList dict$()
While Eof(0)=0 : AddElement(dict$()) : dict$()=Trim(ReadString(0)) : Wend : CloseFile(0)
While FirstElement(dict$())
buf$=dict$() : DeleteElement(dict$()) If buf$="" : Continue : EndIf xbuf$=ReverseString(buf$) ForEach dict$() If xbuf$=dict$() res$+buf$+" / "+xbuf$+#LF$ Break EndIf Next
Wend
PrintN("Semordnilap pairs found: "+Str(CountString(res$,#LF$))) For k=1 To 5
If k=1 : PrintN(~"\nFirst 5 pairs: "+StringField(res$,k,#LF$)) : Continue : EndIf PrintN(Space(15)+StringField(res$,k,#LF$))
Next Input()</lang>
- Output:
Semordnilap pairs found: 158 First 5 pairs: able / elba abut / tuba ac / ca ah / ha al / la
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
As a fold, using reduce
<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>
- Output:
Dictionary words paired by equivalence under reversal: (longest of 158 in http://wiki.puzzlers.org/pub/wordlists/unixdict.txt) kramer -> remark damon -> nomad lager -> regal leper -> repel lever -> revel
Lazy generator
Requires the requests
library.
<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>
- Output:
found 158 semordnilap usernames: mug gum revel lever gab bag lime emil lag gal ...
Quackery
<lang Quackery> []
$ "rosetta/unixdict.txt" sharefile drop nest$ [ behead reverse swap 2dup find over found iff [ dip [ nested join ] ] else nip dup [] = until ] drop say "Number of semordnilaps: " dup size echo cr sortwith [ size swap size > ] 5 split drop say "Five longest: " witheach [ dup echo$ say "<->" reverse echo$ sp ]</lang>
- Output:
Number of semordnilaps: 158 Five longest: remark<->kramer nomad<->damon regal<->lager repel<->leper revel<->lever
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>
- Output:
Total semordnilaps found: 1961 The five longest ones: "desserts" "stressed" "dioramas" "samaroid" "redrawer" "rewarder" "dessert" "tressed" "pat-pat" "tap-tap"
Raku
(formerly Perl 6)
<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>
- Output:
abut tuba avid diva bard drab loot tool part trap
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 semordnilaps, even though their case is different.
The UNIXDICT dictionary specified to be used is all lowercase, however, but the REXX program assumes that the
words may be in any case (lowercase/uppercase/mixedcased).
The order of the words in the dictionary isn't important.
Any blank lines or duplicate words in the dictionary are ignored (as duplicate words wouldn't make them unique).
Any leading, trailing, or imbedded blanks are also ignored (as well as tab characters or other whitespace).
The semordnilap word pairs are shown with a comma delimiter in case there are phrases (words with imbedded
blanks like Sing Sing).
The (first five) semordnilap pairs are shown as they are specified/defined (respective to case) in the dictionary. <lang rexx>/*REXX program finds N semordnilap pairs using a specified dictionary (UNIXDICT.TXT).*/ parse arg n iFID . /*obtain optional argument from the CL.*/ if n== | n=="," then n= 5 /*Not specified? Then use the default.*/ if iFID== | iFID=="," then iFID='UNIXDICT.TXT' /* " " " " " " */
- = 0 /*number of semordnilaps (so far). */
@.= /*caseless non─duplicated dict. words. */
do while lines(iFID)\==0; _= linein(iFID); u= space(_, 0); upper u /*get a word.*/ if length(u)<2 | @.u\== then iterate /*word can't be a unique semordnilap. */ r= reverse(u) /*obtain reverse of the dictionary word*/ if @.r\== then do; #= # + 1 /*found a semordnilap word; bump count.*/ if #<=n then say right(@.r, max(32, length(@.r) ) )',' u end @.u= _ /*define reverse of the dictionary word*/ end /*while*/ /*stick a fork in it, we're all done. */
say say "There're " # ' unique semordnilap pairs in the dictionary file: ' iFID</lang>
- output when using the default inputs:
ac, ca bad, dab avid, diva and, dna bard, drab There're 158 unique semordnilap pairs in the dictionary file: UNIXDICT.TXT
Ring
<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>
- Output:
brag garb edit tide it ti mit tim suez zeus Total number of unique pairs = 158
Ruby
Note: An alternative (old fashioned) method of solving this task (not using a Set as done by other solutions) is to produce 2 sorted files and walk through them. This can be done entirly on disk if required, when done in memory it is faster than a set for large samples.--Nigel Galloway 11:12, 17 September 2012 (UTC) <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>
- Output:
There are 158 semordnilaps, of which the following are 5: able elba abut tuba ac ca ah ha al la
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.
Rust
<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>
- Output:
ca ac dab bad diva avid dna and drab bard Semordnilap pairs found: 158
A Shortened Version
<lang Rust>use std::{collections::HashSet, fs};
fn reverse(x: &str) -> String {
x.chars().rev().collect::<String>()
}
fn main() {
let content = fs::read_to_string("unixdict.txt").expect("No file found!"); let work: HashSet<&str> = content.lines().collect();
let mut candidats: Vec<&str> = work.clone().into_iter().collect(); candidats.retain(|&x| work.contains(&reverse(x).as_str()) && x < reverse(x).as_str());
println!("Numbers of pairs found: {}", candidats.len()); for ind in 0..5 { println!("{}, {}", candidats[ind], reverse(candidats[ind])); }
}</lang>
- Output:
Numbers of pairs found: 158 mn, nm map, pam saw, was deep, peed door, rood
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
Sidef
<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>
- Output:
$ sidef semordnilap.sf < unixdict.txt ca ac dab bad diva avid dna and drab bard 158
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>
SuperCollider
<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?
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>
- Output:
Found 158 pairs Five examples: [("dial", "laid"), ("emil", "lime"), ("burg", "grub"), ("den", "ned"), ("enol", "lone")]
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
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>
- Output:
ca - ac dab - bad diva - avid dna - and drab - bard Total Count: 158
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>
- Output:
There are 158 unique semordnilap pairs in the dictionary. In sorted order, the first five are: able, elba abut, tuba ac, ca ah, ha al, la and the last five are: saw, was suez, zeus tort, trot tv, vt way, yaw
XPL0
<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
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>
- Output:
158 L(L("bog","gob"),L("cup","puc"),L("mart","tram"),L("kay","yak"),L("able","elba"))
- Programming Tasks
- Solutions by Programming Task
- 11l
- 8th
- Ada
- Aime
- ALGOL 68
- Arturo
- AutoHotkey
- AWK
- BBC BASIC
- Bracmat
- C
- C sharp
- C++
- Clojure
- Common Lisp
- Crystal
- D
- Delphi
- System.SysUtils
- System.Classes
- System.StrUtils
- System.Diagnostics
- EchoLisp
- Eiffel
- Elixir
- Erlang
- F Sharp
- Factor
- Forth
- Fortran
- FreeBASIC
- Go
- Groovy
- Haskell
- Icon
- Unicon
- J
- Java
- JavaScript
- Jq
- Julia
- Kotlin
- Ksh
- Lasso
- Liberty BASIC
- Lua
- M2000 Interpreter
- Mathematica
- Wolfram Language
- Nanoquery
- NetRexx
- NewLisp
- Nim
- OCaml
- Octave
- Oforth
- Perl
- Phix
- PHP
- PicoLisp
- PL/I
- PowerShell
- PureBasic
- Python
- Quackery
- Racket
- Raku
- REXX
- Ring
- Ruby
- Rust
- Scala
- Seed7
- Sidef
- Stata
- SuperCollider
- SuperCollider examples needing attention
- Examples needing attention
- Swift
- Tcl
- TUSCRIPT
- VBScript
- Wren
- XPL0
- Zkl
- 6502 Assembly/Omit
- 8080 Assembly/Omit
- Brlcad/Omit
- GUISS/Omit
- Locomotive Basic/Omit
- Openscad/Omit
- TPP/Omit
- Z80 Assembly/Omit
- ZX Spectrum Basic/Omit