Semordnilap

From Rosetta Code
Revision as of 01:20, 4 December 2017 by Hout (talk | contribs) (→‎{{header|Haskell}}: hlint, hindent, foldl -> foldr and updated output (from A rather than Z), added type signatures)
Task
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

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.)

Related tasks



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; record r; file f; text s;

f_affix(f, "unixdict.txt");

while (f_line(f, s) != -1) {

   r[s] = 0;

}

p = 0;

for (s in r) {

   text t;
   t = b_string(b_reverse(b_draft(s)));
   if (s > t) {
       if (r_key(r, t)) {
           p += 1;
           if (p <= 5) {
               o_(s, " ", t, "\n");
           }
       }
   }

}

o_form("Semordnilap pairs: ~\n", p);</lang>

Output:
ca ac
dab bad
diva avid
dna and
drab bard
Semordnilap pairs: 158

ALGOL 68

Works with: ALGOL 68G version Any - tested with release 2.8.3.win32

The Algol 68 G "read" PRAGMA is used to include the associative array code from Associative_array/Iteration. <lang algol68># find the semordnilaps in a list of words #

  1. use the associative array in the Associate array/iteration task #

PR read "aArray.a68" PR

  1. 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 # ;
  1. read the list of words and store the words in an associative array #
  2. 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

AutoHotkey

Works with: AutoHotkey_L

<lang AutoHotkey>S := [], M := []

FileRead, dict, unixdict.txt Loop, Parse, dict, `n, `r`n { r := Reverse(A_LoopField) if (S[r]) M.Insert(r " / " A_LoopField) else S[A_LoopField] := 1 }

Loop, 5 Out .= "`t" M[A_Index] "`n"

MsgBox, % "5 Examples:`n" Out "`nTotal Pairs:`n`t" M.MaxIndex()

Reverse(s) { Loop, Parse, s r := A_LoopField . r return r }</lang>

Output:
5 Examples:
	ac / ca
	bad / dab
	avid / diva
	and / dna
	bard / drab

Total Pairs:
	158

AWK

<lang AWK>

  1. 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>

  1. include <stdlib.h>
  2. include <alloca.h> /* stdlib.h might not have obliged. */
  3. 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>

  1. include <iostream>
  2. include <set>
  3. 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>(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")

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")]

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

Translation of: Clojure

<lang erlang>#!/usr/bin/env escript main([]) -> main(["unixdict.txt"]);

main([DictFile]) ->

 Dict = sets:from_list(read_lines(DictFile)),
 Semordnilaps = 
   lists:filter(fun([W,R]) -> W < R end,
     lists:map(fun(W) -> [W, lists:reverse(W)] end, 
       semordnilaps(Dict))),
 io:fwrite("There are ~b semordnilaps in ~s~n",
           [length(Semordnilaps), DictFile]),
 lists:map(fun([W,R]) -> io:fwrite("~s/~s~n", [W, R]) end,
           lists:sort(lists:sublist(shuffle(Semordnilaps),1,5))).

read_lines(Filename) when is_list(Filename) ->

 { ok, File } = file:open(Filename, [read]),
 read_lines(File);

read_lines(File) when is_pid(File) ->

  case file:read_line(File) of
   {ok, Data} -> [chop(Data) | read_lines(File)];
   eof        -> []
  end.

is_semordnilap(Word, Dict) ->

 Rev = lists:reverse(Word),
 sets:is_element(Word, Dict) and sets:is_element(Rev, Dict).

semordnilaps(Dict) ->

 lists:filter(fun(W) -> is_semordnilap(W, Dict) end, sets:to_list(Dict)).

shuffle(List) ->

 [X||{_,X} <- lists:sort([ {random:uniform(), N} || N <- List])].

chop(L) -> [_|T] = lists:reverse(L), lists:reverse(T).</lang>

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")

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

Print

' 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 = snd . foldr f (S.empty, [])

 where
   f x (s, w)
     | S.member (reverse x) s = (s, x : w)
     | otherwise = (S.insert x s, w)

main :: IO () main = do

 s <- readFile "unixdict.txt"
 let l = semordnilaps (lines s)
 print $ length l
 mapM_ (print . ((,) <*> reverse)) $ take 5 l</lang>
Output:
158
("able","elba")
("abut","tuba")
("ac","ca")
("ah","ha")
("al","la")

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

Translation of: D
Works with: Java version 7+

<lang java5>import java.nio.file.*; import java.util.*;

public class Semordnilap {

   public static void main(String[] args) throws Exception {
       List<String> lst = Files.readAllLines(Paths.get("unixdict.txt"));
       Set<String> seen = new HashSet<>();
       int count = 0;
       for (String w : lst) {
           w = w.toLowerCase();
           String r = new StringBuilder(w).reverse().toString();
           if (seen.contains(r)) {
               if (count++ < 5)
                   System.out.printf("%-10s %-10s\n", w, r);
           } else seen.add(w);
       }
       System.out.println("\nSemordnilap pairs found: " + count);
   }

}</lang>

ca         ac        
dab        bad       
diva       avid      
dna        and       
drab       bard      

Semordnilap pairs found: 158

JavaScript

Translation of: Clojure
Works with: 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>

Works with: Rhino version 1.7

<lang javascript>#!/usr/bin/env rhino

importPackage (java.io)

var dictFile = arguments[0] || "unixdict.txt";

var reader = new BufferedReader(new FileReader(dictFile)); var dict = {}; var word; while (word = reader.readLine()) {

 dict[word] = word.split("").reverse().join("");

}

function isSemordnilap(word) { return dict[dict[word]]; };

var semordnilaps = [] for (var key in dict) {

 if (isSemordnilap(key)) {
   var rev = dict[key];
   if (key < rev) {
     semordnilaps.push([key,rev]) ;
   }
 }

}

var count = semordnilaps.length; print("There are " + count + " semordnilaps in " +

     dictFile + ".  Here are 5:" );

var indices=[] for (var i=0; i<count; ++i) {

 if (Math.random() < 1/Math.ceil(i/5.0)) {
    indices[i%5] = i 
 }

} indices.sort() for (var i=0; i<5; ++i) {

 print(semordnilaps[indices[i]]);

}</lang>

Output:
There are 158 semordnilaps in unixdict.txt.  Here are 5:
loot,tool
ah,ha
dial,laid
dine,enid
haw,wah

jq

Works with: jq version 1.4

The following program illustrates several points about jq:

  • jq can be used to process text, as well as JSON;
  • for text-processing tasks for which awk is well-suited, jq may be slightly slower;
  • jq objects (i.e. JSON objects) can be used to define time-efficient mappings from strings.

Here are some running times on the same machine:

  • awk program:

user 0m0.134s; sys 0m0.012s

  • time /usr/local/bin/jq -M -s -R -r -f semordnilap.jq unixdict.txt

user 0m0.440s; sys 0m0.010s <lang jq>

  1. 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

This example is incorrect. Please fix the code and remove this message.

Details: The number of pairs should be 158. Please use the linked dict file

Translation of: D
Works with: Kotlin version 1.0b4

<lang scala>import java.io.File

fun main(args: Array<String>) {

   val words = File("/usr/share/dict/words").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 465 semordnilap pairs
[(abac, caba), (abut, tuba), (acara, araca), (ad, da), (adad, dada)]

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 )

  1. 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) } }

  1. 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: '

  1. found_size

'
'

  1. 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

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

Translation of: REXX

<lang NetRexx>/* NetRexx */ options replace format comments java crossref symbols nobinary

/* REXX ***************************************************************

  • 07.09.2012 Walter Pachl
                                                                                                                                            • /

fid = 'unixdict.txt' /* the test dictionary */ ifi = File(fid) ifr = BufferedReader(FileReader(ifi)) have = /* words encountered */ pi = 0 /* number of palindromes */ loop label j_ forever /* as long there is input */

 line = ifr.readLine                  /* read a line (String)       */
 if line = null then leave j_         /* NULL indicates EOF         */
 w = Rexx(line)                       /* each line contains 1 word  */
 If w >  Then Do                    /* not a blank line           */
   r = w.reverse                      /* reverse it                 */
   If have[r] >  Then Do            /* was already encountered    */
     pi = pi + 1                      /* increment number of pal's  */
     If pi <= 5 Then                  /* the first 5 are listed     */
       Say have[r] w
     End
   have[w] = w                        /* remember the word          */
   End
 end j_

ifr.close

Say pi 'words in' fid 'have a palindrome' /* total number found */ return </lang>

Output:
ac ca 
bad dab 
avid diva 
and dna 
bard drab 
158 words in unixdict.txt have a palindrome

Nim

<lang nim>import strutils, sequtils, sets, algorithm

proc reverse(s): string =

 result = newString(s.len)
 for i,c in s:
   result[s.high - i] = c

let

 words = readFile("unixdict.txt").strip.splitLines
 wordset = words.toSet
 revs = words.map(reverse)

var pairs = zip(words, revs).filterIt(it[0] < it[1] and it[1] in wordset)

echo "Total number of semordnilaps: ", pairs.len pairs.sort(proc (x,y): auto = cmp(x[0].len,y[0].len)) echo pairs[pairs.high-4..pairs.high]</lang>

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 = 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>

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>

Perl 6

Works with: rakudo version 2015-10-26

<lang perl6>my $words = set slurp("unixdict.txt").lines;

my @sems = gather for $words.flat -> $word {

   my $drow = $word.key.flip;
   take $drow if $drow ∈ $words and $drow lt $word;

}

say $_ ~ ' ' ~ $_.flip for @sems.pick(5);</lang>

Output:
abut tuba
avid diva
bard drab
loot tool
part trap

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

Translation of: Perl 6

<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

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>

Translation of: Perl 6

<lang python>import os import random

  1. Load file and put it to dictionary as set

dictionary = {word.rstrip(os.linesep) for word in open('unixdict.txt')}

  1. 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

Racket

<lang Racket>

  1. 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"

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, trailing, or imbedded 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 in a dictionary (the default is UNIXDICT.TXT). */

  1. =0 /*number palindromes (so far).*/

parse arg iFID .; if iFID== then iFID='UNIXDICT.TXT' /*Not specified? Use default.*/ @.= /*uppercase no─duplicated word*/

   do  while lines(iFID)\==0;  _=space(linein(iFID),0)   /*read a word from dictionary.*/
   parse upper var _ u                                   /*obtain an uppercase version.*/
   if length(_)<2 | @.u\==  then iterate               /*can't be a unique palindrome*/
   r=reverse(u)                                          /*get the reverse of the word.*/
   if @.r\==  then do;  #=#+1                          /*find a palindrome pair ?    */
                          if #<6  then say  @.r','   _   /*just show 1st 5 palindromes.*/
                     end                                 /* [↑]  bump palindrome count.*/
   @.u=_                                                 /*define a unique palindrome. */
   end   /*while*/                                       /* [↑]  read the dictionary.  */

say say "There're " # ' unique palindrome pairs in the dictionary file: ' iFID

                                                     /*stick a fork in it, we're done. */</lang>

output   when using the default dictionary as the input:

ac, ca
bad, dab
avid, diva
and, dna
bard, drab

There're  158  unique palindrome pairs in the dictionary file:  UNIXDICT.TXT

Ring

This example is incorrect. Please fix the code and remove this message.

Details: The output is wrong. See other examples.

<lang ring> load "stdlib.ring" aList = file2list("C:\Ring\unixdict.txt") for m = 1 to 10

   nr = random(len(aList)-1) + 1
   bool = semordnilap(aList[nr])
   see aList[nr] + nl
   if bool = 0 see "is palindrome" + nl + nl
   else see "is semordnilap" + nl + nl ok

next

func semordnilap aString

    bString = ""
    for i=len(aString) to 1 step -1
        bString = bString + aString[i]
    next
    see aString
    if aString = bString return 0 else return 1 ok

</lang>

Output:
consecutive
is semordnilap

aforementioned
is semordnilap

chairwomen
is semordnilap

penis
is semordnilap

gaithersburg
is semordnilap

glade
is semordnilap

diebold
is semordnilap

fro
is semordnilap

powers
is semordnilap

cauldron
is semordnilap

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.

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

Translation of: Perl

<lang ruby>var c = 0 var seen = Hash()

ARGF.each { |line|

   line.chomp!
   var r = line.reverse
   ((seen{r} := 0 ++) && (c++ < 5) && say "#{line} #{r}") ->
       || (seen{line} := 0 ++)

}

say c</lang>

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

This example is incorrect. Please fix the code and remove this message.

Details: The number of pairs should be 158.

<lang SuperCollider>( var text, words, sdrow, semordnilap, selection; File.use("unixdict.txt".resolveRelative, "r", { |f| x = text = f.readAllString }); words = text.split(Char.nl).collect { |each| each.asSymbol }; sdrow = text.reverse.split(Char.nl).collect { |each| each.asSymbol }; semordnilap = sect(words, sdrow); // converted to symbols so intersection is possible semordnilap = semordnilap.collect { |each| each.asString }; "There are % in unixdict.txt\n".postf(semordnilap.size); "For example those, with more than 3 characters:".postln; selection = semordnilap.select { |each| each.size >= 4 }.scramble.keep(4); selection.do { |each| "% %\n".postf(each, each.reverse); }; )</lang>

Answers: <lang SuperCollider> There are 405 in unixdict.txt For example those, with more than 3 characters: live evil tram mart drib bird eros sore </lang>

This seems wrong, but perhaps the test file has changed?

Tcl

<lang tcl>package require Tcl 8.5 package require http

  1. 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

  1. Build hash table for speed

foreach word $wordlist {

   set reversed([string reverse $word]) "dummy"

}

  1. 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

  1. 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

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"))