include c:\cxpl\codes;          \intrinsic 'code' declarations

func real Floor(X);             \Truncate X toward - infinity
real X;
return float(fix(X-0.5));

func PerfectSq(N);              \Return 'true' if N is a perfect square
int N;
return sqrt(N)*sqrt(N) = N;

int N, M, M0;
[for N:= 1 to 22 do
        [IntOut(0, fix(float(N) + Floor(0.5 + sqrt(float(N)))));  ChOut(0,^ )];
CrLf(0);
M0:= 1;
for N:= 1 to 999_999 do
        [M:= fix(float(N) + Floor(0.5 + sqrt(float(N))));
        if PerfectSq(M) then [IntOut(0, M);  Crlf(0)];  \error: have square
        if M#M0+1 and not PerfectSq(M0+1) then          \error: not sequential
                [IntOut(0, M);  Crlf(0)];
        M0:= M;
        ];
]


// Display first 22 values
print "The first 22 numbers generated by the sequence are : "
for i = 1 to 22
    print nonSquare(i), " ";
next i
print

// Check for squares up to one million
found = false
for i = 1 to 1e6
    j = sqrt(nonSquare(i))
    if j = int(j) then
        found = true
        print i, " square numbers found"    //print "Found square: ", i
        break
    end if
next i
if not found  print "No squares found"
end

sub nonSquare (n)
    return n + int(0.5 + sqrt(n))
end sub


fcn seq(n){n + (0.5+n.toFloat().sqrt()).floor()}
[1..22].apply(seq).toString(*).println();

fcn isSquare(n){n.toFloat().sqrt().modf()[1]==0.0}
isSquare(25)  //-->True
isSquare(26)  //-->False
[2..0d1_000_000].filter(fcn(n){isSquare(seq(n))}).println();


EnableExplicit
#SPC=Chr(32)
#TB=~"\t"
#TBLF=~"\t\n"
Define.i a,b,l,n,count=0
Define *count.Integer=@count

Procedure.i AddCount(*c.Integer) ; *counter: by Ref
  *c\i+1
  ProcedureReturn *c\i
EndProcedure

Procedure.s FormatStr(tx$,l.i)
  Shared *count
  If AddCount(*count)%10=0
    ProcedureReturn RSet(tx$,l,#SPC)+#TBLF
  Else
    ProcedureReturn RSet(tx$,l,#SPC)+#TB
  EndIf
EndProcedure

Procedure.b Trial(n.i)
  Define.i i
  For i=3 To Int(Sqr(n)) Step 2
    If n%i=0 : ProcedureReturn #False : EndIf
  Next
  ProcedureReturn #True
EndProcedure

Procedure.b isPrime(n.i)
  If (n>1 And n%2<>0 And Trial(n)) Or n=2 : ProcedureReturn #True : EndIf
  ProcedureReturn #False
EndProcedure

OpenConsole("Sequence of primes by Trial Division")
PrintN("Input (n1<n2 & n1>0)")
Print("n1 : ") : a=Int(Val(Input()))
Print("n2 : ") : b=Int(Val(Input()))
l=Len(Str(b))
If a<b And a>0
  PrintN(~"\nPrime numbers between "+Str(a)+" and "+Str(b))
  For n=a To b
    If isPrime(n)
      Print(FormatStr(Str(n),l))
    EndIf
  Next
  Print(~"\nPrimes= "+Str(*count\i))
  Input()
EndIf


def prime(a):
    return not (a < 2 or any(a % x == 0 for x in xrange(2, int(a**0.5) + 1)))

def primes_below(n):
    return [i for i in range(n) if prime(i)]


[ [] swap times
  [ i^ isprime if
      [ i^ join ] ] ] is primes< ( n --> [ )

100 primes< echo


#lang lazy
(define nats (cons 1 (map add1 nats)))
(define (sift n l) (filter (λ(x) (not (zero? (modulo x n)))) l))
(define (sieve l) (cons (first l) (sieve (sift (first l) (rest l)))))
(define primes (sieve (rest nats)))
(!! (take 25 primes))


/*REXX program lists a  sequence of primes  by  testing  primality  by  trial division. */
parse arg n .                                    /*get optional number of primes to find*/
if n=='' | n==","  then n= 26                    /*Not specified?  Then use the default.*/
tell= (n>0);            n= abs(n)                /*Is  N  negative?  Then don't display.*/
@.1=2;     if tell  then say right(@.1, 9)       /*display  2  as a special prime case. */
#=1                                              /*#  is number of primes found (so far)*/
                                                 /* [↑]  N:  default lists up to 101 #s.*/
   do j=3  by 2  while  #<n                      /*start with the first odd prime.      */
                                                 /* [↓]  divide by the primes.   ___    */
          do k=2  to #  while  !.k<=j            /*divide  J  with all primes ≤ √ J     */
          if j//@.k==0  then iterate j           /*÷ by prev. prime?  ¬prime     ___    */
          end   /*j*/                            /* [↑]   only divide up to     √ J     */
   #= #+1                                        /*bump the count of number of primes.  */
   @.#= j;           !.#= j*j                    /*define this prime; define its square.*/
   if tell  then say right(j, 9)                 /*maybe display this prime ──► terminal*/
   end   /*j*/                                   /* [↑]  only display N number of primes*/
                                                 /* [↓]  display number of primes found.*/
say  #       ' primes found.'                    /*stick a fork in it,  we're all done. */


for i = 1 to 100
    if isPrime(i) see "" + i + " " ok
next
see nl

func isPrime n
     if n < 2 return false ok
     if n < 4 return true ok
     if n % 2 = 0 return false ok
     for d = 3 to sqrt(n) step 2
         if n % d = 0 return false ok
     next
     return true


require "prime"

pg = Prime::TrialDivisionGenerator.new
p pg.take(10) # => [2, 3, 5, 7, 11, 13, 17, 19, 23, 29]
p pg.next # => 31


fn is_prime(number: u32) -> bool {
    #[allow(clippy::cast_precision_loss)]
    let limit = (number as f32).sqrt() as u32 + 1;

    // We test if the number is divisible by any number up to the limit
    !(number < 2 || (2..limit).any(|x| number % x == 0))
}

fn main() {
    println!(
        "Primes below 100:\n{:?}",
        (0_u32..100).fold(vec![], |mut acc, number| {
            if is_prime(number) {
                acc.push(number)
            };
            acc
        })
    );
}


comment
  Prime number generator in S-BASIC. Only odd numbers are
  checked, and only the prime numbers previously found (up
  to the square root of the number currently under examination)
  are tested as divisors.  Memory is conserved by saving only the
  first 50 primes as potential divisors, since that is sufficient
  to test all numbers up to 32767, which is the highest integer
  value supported by S-BASIC
end

$lines

$constant false = 0
$constant true = 0FFFFH

var i, k, m, n, s, nprimes, divisible = integer
dim integer p(50)

rem compute p mod q
function mod(p, q = integer) = integer
end = p - q * (p / q)

input "How many primes do you want to generate",nprimes

rem initialize p with first prime and display it
p(1) = 2
print using "##### "; p(1);

rem now check odd numbers until nprimes are found
i = 1   rem count of primes found so far
k = 1   rem index of largest prime <= sqrt of n
n = 3   rem current number being checked
while i < nprimes do
   begin
      s = p(k) * p(k)
      if s <= n then k = k + 1
      divisible = false
      m = 1   rem index into primes previously found
      while (m <= k) and (divisible = false) do
         begin
            if mod(n, p(m)) = 0 then divisible = true
            m = m + 1
         end
      if divisible = false then
         begin
            i = i + 1
            if i <= 50 then p(i) = n
            print using "##### ";n;
            if pos(0) > 60 then print   rem wrap long lines
         end
      n = n + 2
   end
print "All done. Goodbye"
end


def sieve(nums: Stream[Int]): Stream[Int] =
    Stream.cons(nums.head, sieve((nums.tail).filter(_ % nums.head != 0)))
  val primes = 2 #:: sieve(Stream.from(3, 2))

  println(primes take 10 toList) //         //List(2, 3, 5, 7, 11, 13, 17, 19, 23, 29)
  println(primes takeWhile (_ < 30) toList) //List(2, 3, 5, 7, 11, 13, 17, 19, 23, 29)


func prime_seq(amount, callback) {
    var (counter, number) = (0, 0);
    while (counter < amount) {
        if (is_prime(number)) {
            callback(number);
            ++counter;
        }
        ++number;
    }
}

prime_seq(100, {|p| say p});     # prints the first 100 primes


con
  _clkmode = xtal1+pll16x
  _clkfreq = 80_000_000

obj
  ser : "FullDuplexSerial"

pub main | d, n

  ser.start(31, 30, 0, 115200)

  repeat n from 2 to 100

    repeat d from 2 to n-1
      if n // d == 0
        quit

    if d == n
      ser.dec(n)
      ser.tx(32)

  waitcnt(_clkfreq + cnt)
  ser.stop


import Foundation

extension SequenceType {
  func takeWhile(include: Generator.Element -> Bool) -> AnyGenerator<Generator.Element> {
    var g = self.generate()
    return anyGenerator { g.next().flatMap{include($0) ? $0 : nil }}
  }
}

var pastPrimes = [2]

var primes = anyGenerator {
  _ -> Int? in
  defer {
    pastPrimes.append(pastPrimes.last!)
    let c = pastPrimes.count - 1
    for p in anyGenerator({++pastPrimes[c]}) {
      let lim = Int(sqrt(Double(p)))
      if (!pastPrimes.takeWhile{$0 <= lim}.contains{p % $0 == 0}) { break }
    }
  }
  return pastPrimes.last
}


templates ifPrime
  def n: $;
  [2..~$n -> $n ~/ $ * $] -> \(<~[<=$n>]> $n ! \)!
end ifPrime

templates primes
  [2..$ -> ifPrime] !
end primes

100 -> primes -> '$;
' -> !OUT::write


set primes {}
proc havePrime n {
    global primes
    foreach p $primes {
	# Do the test-by-trial-division
	if {$n/$p*$p == $n} {return false}
    }
    return true
}
for {set n 2} {$n < 100} {incr n} {
    if {[havePrime $n]} {
	lappend primes $n
	puts -nonewline "$n "
    }
}
puts ""


import "/fmt" for Fmt

var primeSeq = Fiber.new {
    Fiber.yield(2)
    var n = 3
    while (true) {
        var isPrime = true
        var p = 3
        while (p * p <= n) {
            if (n%p == 0) {
                isPrime = false
                break
            }
            p =  p + 2
        }
        if (isPrime) Fiber.yield(n)
        n = n + 2
    }
}

var limit = 315
var count = 0
while (true) {
    var p = primeSeq.call()
    System.write("%(Fmt.d(4, p)) ")
    count = count + 1
    if (count%15 == 0) System.print()
    if (count == limit) break
}


func IsPrime(N);  \Return 'true' if N is prime
int  N, I;
[if N <= 2 then return N = 2;
if (N&1) = 0 then \even >2\ return false;
for I:= 3 to sqrt(N) do
    [if rem(N/I) = 0 then return false;
    I:= I+1;
    ];
return true;
];

int N;
for N:= 2 to 100 do
    if IsPrime(N) then
        [IntOut(0, N);  ChOut(0, ^ )]


sub isPrime(v)
    if v < 2 then return False : fi
    if mod(v, 2) = 0 then return v = 2 : fi
    if mod(v, 3) = 0 then return v = 3 : fi
    d = 5
    while d * d <= v
        if mod(v, d) = 0 then return False else d = d + 2 : fi
    wend
    return True
end sub

for i = 101 to 999
  if isPrime(i)  print str$(i), " ";
next i
end


fcn isPrime(p){
   (p>=2) and (not [2 .. p.toFloat().sqrt()].filter1('wrap(n){ p%n==0 }))
}
fcn primesBelow(n){ [0..n].filter(isPrime) }


#include <map>
#include <iostream>
#include <string>

int main()
{
  std::map<char, std::string> rep =
    {{'a', "DCaBA"}, // replacement string is reversed
     {'b', "E"},
     {'r', "Fr"}};

  std::string magic = "abracadabra";

  for(auto it = magic.begin(); it != magic.end(); ++it)
  {
    if(auto f = rep.find(*it); f != rep.end() && !f->second.empty())
    {
      *it = f->second.back();
      f->second.pop_back();
    }
  }

  std::cout << magic << "\n";
}


USING: assocs formatting grouping kernel random sequences ;

CONSTANT: instrs {
    CHAR: a 1 CHAR: A
    CHAR: a 2 CHAR: B
    CHAR: a 4 CHAR: C
    CHAR: a 5 CHAR: D
    CHAR: b 1 CHAR: E
    CHAR: r 2 CHAR: F
}

: counts ( seq -- assoc )
    H{ } clone swap [ 2dup swap inc-at dupd of ] zip-with nip ;

: replace-nths ( seq instrs -- seq' )
    [ counts ] dip 3 group [ f suffix 2 group ] map substitute keys ;

: test ( str -- )
    dup instrs replace-nths "" like "%s -> %s\n" printf ;

"abracadabra" test
"abracadabra" randomize test


Function replaceChar(Byref S As String) As String
    Dim As String A = "ABaCD", B = "Eb", R = "rF"
    Dim As Byte pA = 1, pB = 1, pR = 1
    For i As Byte = 0 To Len(S)
        Select Case Mid(S,i,1)
        Case "a"
            Mid(S,i,1) = Mid(A,pA,1)
            pA += 1
        Case "b"
            Mid(S,i,1) = Mid(B,pB,1)
            pB += 1
        Case "r"
            Mid(S,i,1) = Mid(R,pR,1)
            pR += 1
        End Select
    Next i
    Return S
End Function

Dim As String S
S = "abracadabra"
Print S; " -> "; replaceChar(S)
S = "caarabadrab"
Print S; " -> "; replaceChar(S)
Sleep


package main

import (
    "fmt"
    "strings"
)

func main() {
    s := "abracadabra"
    ss := []byte(s)
    var ixs []int
    for ix, c := range s {
        if c == 'a' {
            ixs = append(ixs, ix)
        }
    }
    repl := "ABaCD"
    for i := 0; i < 5; i++ {
        ss[ixs[i]] = repl[i]
    }
    s = string(ss)
    s = strings.Replace(s, "b", "E", 1)
    s = strings.Replace(s, "r", "F", 2)
    s = strings.Replace(s, "F", "r", 1)
    fmt.Println(s)
}


   upd=: {{ x (n{I.y=m)} y }}
   'ABCD' 'a' upd 0 1 3 4 'E' 'b' upd 0 'F' 'r' upd 1 'abracadabra'
AErBcadCbFD


rep = Dict('a' => Dict(1 => 'A', 2 => 'B', 4 => 'C', 5 => 'D'), 'b' => Dict(1 => 'E'), 'r' => Dict(2 => 'F'))

function trstring(oldstring, repdict)
    seen, newchars = Dict{Char, Int}(), Char[]
    for c in oldstring
        i = get!(seen, c, 1)
        push!(newchars, haskey(repdict, c) && haskey(repdict[c], i) ? repdict[c][i] : c)
        seen[c] += 1
    end
    return String(newchars)
end

println("abracadabra -> ", trstring("abracadabra", rep))


the first  'a' with 'A'   -> aA1
...and so on


use strict;
use warnings;
use feature 'say';

sub transmogrify {
    my($str, %sub) = @_;
    for my $l (keys %sub) {
        $str =~ s/$l/$_/ for split '', $sub{$l};
        $str =~ s/_/$l/g;
    }
    $str
}

my $word = 'abracadabra';
say "$word -> " . transmogrify $word, 'a' => 'AB_CD', 'r' => '_F', 'b' => 'E';


with javascript_semantics
function replace_nth(string s, r)
    string res = s
    for i=1 to length(r) by 3 do
        res[find_all(r[i],s)[r[i+1]-'0']] = r[i+2]
    end for
    return res
end function
?replace_nth("abracadabra","a1Aa2Ba4Ca5Db1Er2F")

-- Alternative version
function replace_nths(string s, sequence r)
    for icr in r do
        {sequence idx, integer ch, string reps} = icr
        s = reinstate(s,extract(find_all(ch,s),idx),reps)
    end for
    return s
end function

constant r = {{{1,2,4,5},'a',"ABCD"},
              {{1},'b',"E"},
              {{2},'r',"F"}}
?replace_nths("abracadabra",r)


from collections import defaultdict

rep = {'a' : {1 : 'A', 2 : 'B', 4 : 'C', 5 : 'D'}, 'b' : {1 : 'E'}, 'r' : {2 : 'F'}}

def trstring(oldstring, repdict):
    seen, newchars = defaultdict(lambda:1, {}), []
    for c in oldstring:
        i = seen[c]
        newchars.append(repdict[c][i] if c in repdict and i in repdict[c] else c)
        seen[c] += 1
    return ''.join(newchars)

print('abracadabra ->', trstring('abracadabra', rep))


sub mangle ($str is copy) {
    $str.match(:ex, 'a')».from.map: { $str.substr-rw($_, 1) = 'ABaCD'.comb[$++] };
    $str.=subst('b', 'E');
    $str.substr-rw($_, 1) = 'F' given $str.match(:ex, 'r')».from[1];
    $str
}

say $_, ' -> ', .&mangle given 'abracadabra';

say $_, ' -> ', .&mangle given 'abracadabra'.comb.pick(*).join;


fn selectively_replace_chars(s string, char_map map[string]string) string {
    mut bytes := s.bytes()
    mut counts := {
        'a': 0
        'b': 0
        'r': 0
    }
    for i := s.len - 1; i >= 0; i-- {
        c := s[i].ascii_str()
        if c in ['a', 'b', 'r'] {
            bytes[i] = char_map[c][counts[c]]
            counts[c]++
        }
    }
    return bytes.bytestr()
}

fn main() {
    char_map := {
        'a': 'DCaBA'
        'b': 'bE'
        'r': 'Fr'
    }
    for old in ['abracadabra', 'caaarrbabad'] {
        new := selectively_replace_chars(old, char_map)
        println('$old -> $new')
    }
}


import "./seq" for Lst
import "./str" for Str

var s = "abracadabra"
var sl = s.toList
var ixs = Lst.indicesOf(sl, "a")[2]
var repl = "ABaCD"
for (i in 0..4) sl[ixs[i]] = repl[i]
s = sl.join()
s = Str.replace(s, "b", "E", 1)
s = Str.replace(s, "r", "F", 2, 1)
System.print(s)


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


[] 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


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;


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


# 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


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]


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
}


# 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)
}


      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$


( 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)
  )
);


#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;
}


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());
}


#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
}


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


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


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)


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);
}


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.


(lib 'struct)
(lib 'sql)
(lib 'words)

(lib 'dico.fr.no-accent) ;; load dictionary
(string-delimiter "")

;; check reverse r of w is a word
;; take only one pair : r < w
(define (semordnilap? w)
	    (define r (list->string (reverse (string->list w))))
	    (and (word? r) (string<? r w)))

;; to get longest first
(define (string-sort a b) (> (string-length a) (string-length b)))

(define (task)
;; select unique words into the list 'mots'
    (define mots (make-set (words-select #:any null 999999)))
    (define semordnilap
	    (list-sort string-sort (for/list ((w mots))
	    #:when (semordnilap? w)
	    w )))
   (writeln 'pairs '→ (length semordnilap))
   (writeln 'longest '→ (take semordnilap 5)))

{{out}}
(task)
    pairs       →     345
    longest     →     (rengager tresser strasse reveler retrace)


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


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)


#!/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).


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]


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 ] [email protected] ,, ] [ 2drop ] if
        ] each
    ]
] H{ } make >alist
[ length "%d semordnilap pairs.\n" printf ] [ 5 sample . ] bi


wordlist constant dict

: load-dict ( c-addr u -- )
    r/o open-file throw >r
    begin
	pad 1024 [email protected] 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 [email protected] u< while
	    over [email protected] over - x-size dup >r - 2dup [email protected] 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)
	[email protected] < 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


!-*- 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


' 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


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


def semordnilapWords(source) {
    def words = [] as Set
    def semordnilaps = []
    source.eachLine { word ->
        if (words.contains(word.reverse())) semordnilaps << word
        words << word
    }
    semordnilaps
}


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)


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


   isSemordnilap=: |.&.> (~: *. e.) ]
   unixdict=: <;._2 freads 'unixdict.txt'
   #semordnilaps=: ~. /:~"1 (,. |.&.>) (#~ isSemordnilap) unixdict
158


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);
    }
}


#!/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]]);
}


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


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


// 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))
}


#!/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.


local(
	words		= string(include_url('http://www.puzzlers.org/pub/wordlists/unixdict.txt')) -> split('\n'),
	semordnilaps	= array,
	found_size,
	example,
	haveexamples	= false,
	examples	= array
)

#words -> removeall('')

with word in #words do {
	local(reversed = string(#word) -> reverse&)
	if(not(#word == #reversed) and not(#semordnilaps >> #word) and not(#semordnilaps >> #reversed) and #words >> #reversed) => {
		#semordnilaps -> insert(#word = #reversed)
	}
}

#found_size = #semordnilaps -> size

while(not(#haveexamples)) => {
	#example = #semordnilaps -> get(integer_random(#found_size, 1))
	not(#examples >> #example -> name) ? #examples -> insert(#example)
	#examples -> size >= 5 ? #haveexamples = true
}
'Total found: '
#found_size
'<br />'
#examples


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


#!/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


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


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


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


/* 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


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


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]


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


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)


: 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) ]
      ] ;


while (<>) {
	chomp;
	my $r = reverse;
	$seen{$r}++ and $c++ < 5 and print "$_ $r\n" or $seen{$_}++;
}

print "$c\n"


with javascript_semantics
sequence words = unix_dict(), semordnilap={}
for i=1 to length(words) do
    string word = words[i]
    if rfind(reverse(word),words,i-1) then
        semordnilap = append(semordnilap,word)
    end if
end for
printf(1,"%d semordnilap found, the first five are:\n",length(semordnilap))
for i=1 to 5 do
    printf(1,"%s - %s\n",{semordnilap[i],reverse(semordnilap[i])})
end for


<?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";


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


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;


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


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


>>> with open('unixdict.txt') as f:
	wordset = set(f.read().strip().split())

>>> revlist = (''.join(word[::-1]) for word in wordset)
>>> pairs   = set((word, rev) for word, rev in zip(wordset, revlist)
                  if word < rev and rev in wordset)
>>> len(pairs)
158
>>> sorted(pairs, key=lambda p: (len(p[0]), p))[-5:]
[('damon', 'nomad'), ('lager', 'regal'), ('leper', 'repel'), ('lever', 'revel'), ('kramer', 'remark')]
>>>


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


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


/* 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      */


# 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


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


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),
    }
}


F is_self_describing(n)
   V s = String(n)
   R all(enumerate(Array(s)).map((i, ch) -> @s.count(String(i)) == Int(ch)))

print((0.<4000000).filter(x -> is_self_describing(x)))


val wordsAll =
  scala.io.Source.
    fromURL("http://wiki.puzzlers.org/pub/wordlists/unixdict.txt").
    getLines().map(_.toLowerCase).toIndexedSeq

/**
 * Given a sequence of lower-case words return a sub-sequence
 * of matches containing the word and its reverse if the two
 * words are different.
 */
def semordnilap( words:IndexedSeq[String] ) : IndexedSeq[(String,String)] = {

  words.
    zipWithIndex.                        // index will be needed to eliminate duplicate
    filter {
      case (w,i) =>
        val j = words.indexOf(w.reverse) // eg. (able,62) and (elba,7519)
        i < j && w != w.reverse          // save the matches which are not palindromes
    }.
    map {
      case (w,_) => (w,w.reverse)        // drop the index
    }
}

val ss = semordnilap(wordsAll)

{
println( s"${ss.size} matches, including: \n" )
println( ss.take(5).mkString( "\n" ) )
}


$ 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;


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


*        Self-describing numbers   26/04/2020
SELFDESC CSECT
         USING  SELFDESC,R13       base register
         B      72(R15)            skip savearea
         DC     17F'0'             savearea
         SAVE   (14,12)            save previous context
         ST     R13,4(R15)         link backward
         ST     R15,8(R13)         link forward
         LR     R13,R15            set addressability
         LA     R8,1               k=1
       DO WHILE=(C,R8,LE,=A(NN))   do k=1 to nn
         CVD    R8,DBLK              binary to packed decimal (PL8)
         MVC    CK,MAK               load mask
         EDMK   CK,DBLK+2            packed dec (PL5) to char (CL10)
         S      R1,=A(CK)            number of blanks
         LR     R3,R1                "
         LA     R9,L'CK              length(ck)
         SR     R9,R1                length of the number
         LA     R6,1                 i=1
       DO WHILE=(CR,R6,LE,R9)        do i=1 to l
         LA     R10,0                  n=0
         LA     R7,1                   j=1
       DO WHILE=(CR,R7,LE,R9)          do j=1 to l
         LA     R1,CK-1                  @ck
         AR     R1,R3                    +space(k)
         AR     R1,R7                    +j
         MVC    CJ,0(R1)                 substr(k,j,1)
         IC     R1,CJ                    ~
         SLL    R1,28                    shift left  28
         SRL    R1,28                    shift right 28
         LR     R2,R6                    i
         BCTR   R2,0                     i-1
       IF    CR,R1,EQ,R2 THEN            if substr(k,j,1)=i-1 then
         LA     R10,1(R10)                 n++
       ENDIF    ,                        endif
         LA     R7,1(R7)                 j++
       ENDDO    ,                      enddo j
         LA     R1,CK-1                @ck
         AR     R1,R3                  +space(k)
         AR     R1,R6                  +i
         MVC    CI,0(R1)               substr(k,i,1)
         IC     R1,CI                  ~
         SLL    R1,28                  shift left  28
         SRL    R1,28                  shift right 28
       IF    CR,R1,NE,R10 THEN         if substr(k,i,1)<>n then
         B      ITERK                    iterate k
       ENDIF    ,                      endif
         LA     R6,1(R6)               i++
       ENDDO    ,                    enddo i
         XPRNT  CK,L'CK              print ck
ITERK    LA     R8,1(R8)             k++
       ENDDO    ,                  enddo k
         L      R13,4(0,R13)       restore previous savearea pointer
         RETURN (14,12),RC=0       restore registers from calling save
NN       EQU    5000000            nn
DBLK     DS     PL8                double word 15num
MAK      DC     X'402020202020202020202020'  mask CL12 11num
CK       DS     CL12               ck 12num
CI       DS     C                  ci
CJ       DS     C                  cj
PG       DS     CL80               buffer
XDEC     DS     CL12               temp fo xdeco
         REGEQU
         END    SELFDESC


with Ada.Text_IO; use Ada.Text_IO;
procedure SelfDesc is
   subtype Desc_Int is Long_Integer range 0 .. 10**10-1;

   function isDesc (innum : Desc_Int) return Boolean is
      subtype S_Int is Natural range 0 .. 10;
      type S_Int_Arr is array (0 .. 9) of S_Int;
      ref, cnt : S_Int_Arr := (others => 0);
      n, digit : S_Int := 0;  num : Desc_Int := innum;
   begin
      loop
         digit := S_Int (num mod 10);
         ref (9 - n) := digit;  cnt (digit) := cnt (digit) + 1;
         num := num / 10; exit when num = 0; n := n + 1;
      end loop;
      return ref (9 - n .. 9) = cnt (0 .. n);
   end isDesc;

begin
   for i in Desc_Int range 1 .. 100_000_000 loop
      if isDesc (i) then
         Put_Line (Desc_Int'Image (i));
      end if;
   end loop;
end SelfDesc;


* Program: semordnilap.sbl
* To run: sbl semordnilap.sbl < unixdict.txt
* Description: A semordnilap is a word (or phrase) that spells
*              a different word (or phrase) backward. "Semordnilap"
*              is a word that itself is a semordnilap.
*              Example: lager and regal
*              Reads file unixdict.txt
* Comment: Tested using the Spitbol for Linux version of SNOBOL4

	output = "Some Semordnilap Pairs from File unixdict.txt"
	atable = table(25200,,-1)
	ntable = table(25200,,-2)

* Read dictionary file into memory
in1
	word = input :f(p1)
	count = count + 1
	atable[word] = word
	ntable[count] = word
	:(in1)

* Process dictionary to find unique semordnilaps
p1
	i = lt(i,count) i + 1 :f(p2)
 	newword = atable[reverse(ntable[i])]
	leq(newword,-1) :s(p1)
	ident(ntable[i],newword) :s(p1)
	output = lt(outcount,5) ntable[i] ', ' newword
	atable[ntable[i]] = atable[newword] = -1
	outcount = outcount + 1
	:(p1)
p2
	output = 'The number of semordnilap pairs is: ' outcount
END


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


(
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); };
)


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


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
}


BEGIN

    # return TRUE if number is self describing, FALSE otherwise #
    OP SELFDESCRIBING = ( INT number )BOOL:
       BEGIN

           [10]INT counts := ( 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 );
           INT n          := number;
           INT digits     := 0;

           # count the occurances of each digit #
           WHILE
               n /= 0
           DO
               digits +:= 1;
               counts[ ( n MOD 10 ) + 1 ] +:= 1;
               n OVERAB 10
           OD;

           # construct the number that the counts would describe, #
           # if the number was self describing                    #

           INT described number := 0;
           FOR i TO digits
           DO
               described number *:= 10;
               described number +:= counts[ i ]
           OD;

           # if the described number is the input number, #
           # it is self describing #
           ( number = described number )
       END; # SELFDESCRIBING #

main: (

    FOR i TO 100 000 000
    DO
        IF SELFDESCRIBING i
        THEN
            print( ( i, " is self describing", newline ) )
        FI
    OD
)

END


use AppleScript version "2.4"
use framework "Foundation"
use scripting additions

-- selfDescribes :: Int -> Bool
on selfDescribes(x)
    set s to str(x)
    set descripn to my str(|λ|(my groupBy(my eq, my sort(characters of s))) of my ¬
        described(characters of "0123456789"))
    1 = (offset of descripn in s) and ¬
        0 = ((items ((length of descripn) + 1) thru -1 of s) as string as integer)
end selfDescribes

-- described :: [Char] -> [[Char]] -> [Char]
on described(digits)
    script
        on |λ|(groups)
            if 0 < length of digits and 0 < length of groups then
                set grp to item 1 of groups
                set go to described(rest of digits)
                if item 1 of digits = item 1 of (item 1 of grp) then
                    {item 1 of my str(length of grp)} & |λ|(rest of groups) of go
                else
                    {"0"} & |λ|(groups) of go
                end if
            else
                {}
            end if
        end |λ|
    end script
end described

-------------------------- TEST ---------------------------
on run
    script test
        on |λ|(n)
            str(n) & " -> " & str(selfDescribes(n))
        end |λ|
    end script

    unlines(map(test, ¬
        {1210, 1211, 2020, 2022, 21200, 21203, 3211000, 3211004}))

end run

-------------------- GENERIC FUNCTIONS --------------------

-- True if every value in the list is true.
-- and :: [Bool] -> Bool
on |and|(xs)
    repeat with x in xs
        if not (contents of x) then return false
    end repeat
    return true
end |and|

-- enumFromTo :: Int -> Int -> [Int]
on enumFromTo(m, n)
    if m ≤ n then
        set lst to {}
        repeat with i from m to n
            set end of lst to i
        end repeat
        lst
    else
        {}
    end if
end enumFromTo

-- eq (==) :: Eq a => a -> a -> Bool
on eq(a, b)
    a = b
end eq

-- filter :: (a -> Bool) -> [a] -> [a]
on filter(p, xs)
    tell mReturn(p)
        set lst to {}
        set lng to length of xs
        repeat with i from 1 to lng
            set v to item i of xs
            if |λ|(v, i, xs) then set end of lst to v
        end repeat
        return lst
    end tell
end filter

-- foldl :: (a -> b -> a) -> a -> [b] -> a
on foldl(f, startValue, xs)
    tell mReturn(f)
        set v to startValue
        set lng to length of xs
        repeat with i from 1 to lng
            set v to |λ|(v, item i of xs, i, xs)
        end repeat
        return v
    end tell
end foldl

-- Typical usage: groupBy(on(eq, f), xs)
-- groupBy :: (a -> a -> Bool) -> [a] -> [[a]]
on groupBy(f, xs)
    set mf to mReturn(f)

    script enGroup
        on |λ|(a, x)
            if length of (active of a) > 0 then
                set h to item 1 of active of a
            else
                set h to missing value
            end if

            if h is not missing value and mf's |λ|(h, x) then
                {active:(active of a) & {x}, sofar:sofar of a}
            else
                {active:{x}, sofar:(sofar of a) & {active of a}}
            end if
        end |λ|
    end script

    if length of xs > 0 then
        set dct to foldl(enGroup, {active:{item 1 of xs}, sofar:{}}, rest of xs)
        if length of (active of dct) > 0 then
            sofar of dct & {active of dct}
        else
            sofar of dct
        end if
    else
        {}
    end if
end groupBy

-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
    -- The list obtained by applying f
    -- to each element of xs.
    tell mReturn(f)
        set lng to length of xs
        set lst to {}
        repeat with i from 1 to lng
            set end of lst to |λ|(item i of xs, i, xs)
        end repeat
        return lst
    end tell
end map

-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
    -- 2nd class handler function lifted into 1st class script wrapper.
    if script is class of f then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn

-- sort :: Ord a => [a] -> [a]
on sort(xs)
    ((current application's NSArray's arrayWithArray:xs)'s ¬
        sortedArrayUsingSelector:"compare:") as list
end sort

-- str :: a -> String
on str(x)
    x as string
end str

-- unlines :: [String] -> String
on unlines(xs)
    -- A single string formed by the intercalation
    -- of a list of strings with the newline character.
    set {dlm, my text item delimiters} to ¬
        {my text item delimiters, linefeed}
    set s to xs as text
    set my text item delimiters to dlm
    s
end unlines


#lang transd

MainModule: {
_start: (λ (with fs FileStream()
    (open-r fs "/mnt/vault/tmp/unixdict.txt") )
    (with v ( -|
        (read-text fs)
        (split)
        (group-by (λ s String() -> String()
            (ret (min s (reverse (cp s))))))
        (values)
        (filter where: (λ v Vector<String>() (ret (== (size v) 2))))
        (shuffle))

        (lout "Total number of semordnilaps: " (size v))
        (lout "Random five: " Range(in: v 0 5))))
)
}


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


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


selfDescribing?: function [x][
    digs: digits x
    loop.with:'i digs 'd [
        if d <> size select digs 'z [z=i]
            -> return false
    ]
    return true
]

print select 1..22000 => selfDescribing?


; The following directives and commands speed up execution:
#NoEnv
SetBatchlines -1
ListLines Off
Process, Priority,, high

MsgBox % 2020 ": " IsSelfDescribing(2020) "`n" 1337 ": " IsSelfDescribing(1337) "`n" 1210 ": " IsSelfDescribing(1210)
Loop 100000000
   If IsSelfDescribing(A_Index)
      list .= A_Index "`n"
MsgBox % "Self-describing numbers < 100000000 :`n" . list

CountSubstring(fullstring, substring){
   StringReplace, junk, fullstring, %substring%, , UseErrorLevel
   return errorlevel
}

IsSelfDescribing(number){
   Loop Parse, number
      If Not CountSubString(number, A_Index-1) = A_LoopField
         return false
   return true
}


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


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


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();


# syntax: GAWK -f SELF-DESCRIBING_NUMBERS.AWK
BEGIN {
    for (n=1; n<=100000000; n++) {
      if (is_self_describing(n)) {
        print(n)
      }
    }
    exit(0)
}
function is_self_describing(n,  i) {
    for (i=1; i<=length(n); i++) {
      if (substr(n,i,1) != gsub(i-1,"&",n)) {
        return(0)
      }
    }
    return(1)
}


DIM x, r, b, c, n, m AS INTEGER
DIM a, d AS STRING
DIM v(10), w(10) AS INTEGER
CLS
FOR x = 1 TO 5000000
   a$ = LTRIM$(STR$(x))
   b = LEN(a$)
   FOR c = 1 TO b
      d$ = MID$(a$, c, 1)
      v(VAL(d$)) = v(VAL(d$)) + 1
      w(c - 1) = VAL(d$)
   NEXT c
   r = 0
   FOR n = 0 TO 10
      IF v(n) = w(n) THEN r = r + 1
      v(n) = 0
      w(n) = 0
   NEXT n
   IF r = 11 THEN PRINT x; " Yes,is autodescriptive number"
NEXT x
PRINT
PRINT "End"
SLEEP
END


      FOR N = 1 TO 5E7
        IF FNselfdescribing(N) PRINT N
      NEXT
      END

      DEF FNselfdescribing(N%)
      LOCAL D%(), I%, L%, O%
      DIM D%(9)
      O% = N%
      L% = LOG(N%)
      WHILE N%
        I% = N% MOD 10
        D%(I%) += 10^(L%-I%)
        N% DIV=10
      ENDWHILE
      = O% = SUM(D%())


#include <stdio.h>

inline int self_desc(unsigned long long xx)
{
	register unsigned int d, x;
	unsigned char cnt[10] = {0}, dig[10] = {0};

	for (d = 0; xx > ~0U; xx /= 10)
		cnt[ dig[d++] = xx % 10 ]++;

	for (x = xx; x; x /= 10)
		cnt[ dig[d++] = x % 10 ]++;

	while(d-- && dig[x++] == cnt[d]);

	return d == -1;
}

int main()
{
	int i;
	for (i = 1; i < 100000000; i++) /* don't handle 0 */
		if (self_desc(i)) printf("%d\n", i);

	return 0;
}


(defun to-ascii (str) (mapcar #'char-code (coerce str 'list)))

(defun to-digits (n)
  (mapcar #'(lambda(v) (- v 48)) (to-ascii  (princ-to-string n))))

(defun count-digits (n)
  (do
      ((counts (make-array '(10) :initial-contents '(0 0 0 0 0 0 0 0 0 0)))
       (curlist (to-digits n) (cdr curlist)))
      ((null curlist) counts)
    (setf (aref counts (car curlist)) (+ 1 (aref counts (car curlist)))))))

(defun self-described-p (n)
  (if (not (numberp n))
      nil
  (do ((counts (count-digits n))
       (ipos 0 (+ 1 ipos))
       (digits (to-digits n) (cdr digits)))
      ((null digits) t)
    (if (not (eql (car digits) (aref counts ipos))) (return nil)))))


def self_describing?(n)
  digits = n.to_s.chars.map(&.to_i)         # 12345 => [1, 2, 3, 4, 5]
  digits.each_with_index.all? { |digit, idx| digits.count(idx) == digit }
end

t = Time.monotonic
600_000_000.times { |n| (puts "#{n} in #{(Time.monotonic - t).total_seconds} secs";\
                        t = Time.monotonic) if self_describing?(n) }


import std.stdio, std.algorithm, std.range, std.conv, std.string;

bool isSelfDescribing(in long n) pure nothrow @safe {
    auto nu = n.text.representation.map!q{ a - '0' };
    return nu.length.iota.map!(a => nu.count(a)).equal(nu);
}

void main() {
    4_000_000.iota.filter!isSelfDescribing.writeln;
}


defmodule Self_describing do
  def number(n) do
    digits = Integer.digits(n)
    Enum.map(0..length(digits)-1, fn s ->
      length(Enum.filter(digits, fn c -> c==s end))
    end) == digits
  end
end

m = 3300000
Enum.filter(0..m, fn n -> Self_describing.number(n) end)


sdn(N) -> lists:map(fun(S)->length(lists:filter(fun(C)->C-$0==S end,N))+$0 end,lists:seq(0,length(N)-1))==N.
gen(M) -> lists:filter(fun(N)->sdn(integer_to_list(N)) end,lists:seq(0,M)).


USING: kernel math.parser prettyprint sequences ;
IN: rosetta-code.self-describing-numbers

: digits ( n -- seq ) number>string string>digits ;

: digit-count ( seq n -- m ) [ = ] curry count ;

: self-describing-number? ( n -- ? )
    digits dup [ digit-count = ] with map-index [ t = ] all? ;

100,000,000 <iota> [ self-describing-number? ] filter .


\ where unavailable.
: third ( A b c -- A b c A )  >r over r> swap ;
: (.) ( u -- c-addr u )  0 <# #s #> ;

\ COUNT is a standard word with a very different meaning, so this
\ would typically be beheaded, or given another name, or otherwise
\ given a short lifespan, so to speak.
: count ( c-addr1 u1 c -- c-addr1 u1 c+1 u )
  0 2over bounds do
    over i [email protected] = if 1+ then
  loop swap 1+ swap ;

: self-descriptive? ( u -- f )
  (.) [char] 0 third third bounds ?do
    count i [email protected] [char] 0 - <> if drop 2drop false unloop exit then
  loop drop 2drop true ;


' FB 1.05.0 Win64

Function selfDescribing (n As UInteger) As Boolean
   If n = 0 Then Return False
   Dim ns As String = Str(n)
   Dim count(0 To 9) As Integer '' all elements zero by default
   While n > 0
     count(n Mod 10) += 1
     n \= 10
   Wend
   For i As Integer = 0 To Len(ns) - 1
     If ns[i] - 48 <> count(i) Then Return False '' numerals have ascii values from 48 to 57
   Next
   Return True
End Function

Print "The self-describing numbers less than 100 million are:"
For i As Integer = 0 To 99999999
  If selfDescribing(i) Then Print i; " ";
Next
Print
Print "Press any key to quit"
Sleep


package main

import (
    "fmt"
    "strconv"
    "strings"
)

// task 1 requirement
func sdn(n int64) bool {
    if n >= 1e10 {
        return false
    }
    s := strconv.FormatInt(n, 10)
    for d, p := range s {
        if int(p)-'0' != strings.Count(s, strconv.Itoa(d)) {
            return false
        }
    }
    return true
}

// task 2 code (takes a while to run)
func main() {
    for n := int64(0); n < 1e10; n++ {
        if sdn(n) {
            fmt.Println(n)
        }
    }
}


import Data.Char

count :: Int -> [Int] -> Int
count x = length . filter (x ==)

isSelfDescribing :: Integer -> Bool
isSelfDescribing n = nu == f
  where
    nu = digitToInt <$> show n
    f = (`count` nu) <$> [0 .. length nu - 1]

main :: IO ()
main = do
  print $
    isSelfDescribing <$>
    [1210, 2020, 21200, 3211000, 42101000, 521001000, 6210001000]
  print $ filter isSelfDescribing [0 .. 4000000]


procedure count (test_item, str)
  result := 0
  every item := !str do
    if test_item == item then result +:= 1
  return result
end

procedure is_self_describing (n)
  ns := string (n) # convert to a string
  every i := 1 to *ns do {
    if count (string(i-1), ns) ~= ns[i] then fail
  }
  return 1 # success
end

# generator for creating self_describing_numbers
procedure self_describing_numbers ()
  n := 1
  repeat {
    if is_self_describing(n) then suspend n
    n +:= 1
  }
end

procedure main ()
  # write the first 4 self-describing numbers
  every write (self_describing_numbers ()\4)
end


   digits   =: 10&#.^:_1
   counts   =: _1 + [: #/.~ [email protected]:# , ]
   selfdesc =: = counts&.digits"0       NB.  Note use of "under"


public class SelfDescribingNumbers{
    public static boolean isSelfDescribing(int a){
        String s = Integer.toString(a);
        for(int i = 0; i < s.length(); i++){
            String s0 = s.charAt(i) + "";
            int b = Integer.parseInt(s0); // number of times i-th digit must occur for it to be a self describing number
            int count = 0;
            for(int j = 0; j < s.length(); j++){
                int temp = Integer.parseInt(s.charAt(j) + "");
                if(temp == i){
                    count++;
                }
                if (count > b) return false;
            }
            if(count != b) return false;
        }
        return true;
    }

    public static void main(String[] args){
        for(int i = 0; i < 100000000; i++){
            if(isSelfDescribing(i)){
                System.out.println(i);
             }
        }
    }
}


function is_self_describing(n) {
    var digits = Number(n).toString().split("").map(function(elem) {return Number(elem)});
    var len = digits.length;
    var count = digits.map(function(x){return 0});

    digits.forEach(function(digit, idx, ary) {
        if (digit >= count.length)
            return false
        count[digit] ++;
    });

    return digits.equals(count);
}

Array.prototype.equals = function(other) {
    if (this === other)
        return true;  // same object
    if (this.length != other.length)
        return false;
    for (idx in this)
        if (this[idx] !== other[idx])
            return false;
    return true;
}

for (var i=1; i<=3300000; i++)
    if (is_self_describing(i))
        print(i);


# If your jq includes all/2 then comment out the following definition,
# which is slightly less efficient:
def all(generator; condition):
  reduce generator as $i (true; if . then $i | condition else . end);


function selfie(x::Integer)
	ds = reverse(digits(x))
	if sum(ds) != length(ds) return false end
	for (i, d) in enumerate(ds)
		if d != sum(ds .== i - 1) return false end
	end
	return true
end

@show selfie(2020)
@show selfie(2021)

selfies(x) = for i in 1:x selfie(i) && println(i) end
@time selfies(4000000)


// version 1.0.6

fun selfDescribing(n: Int): Boolean {
    if (n <= 0) return false
    val ns = n.toString()
    val count = IntArray(10)
    var nn = n
    while (nn > 0) {
        count[nn % 10] += 1
        nn /= 10
    }
    for (i in 0 until ns.length)
        if( ns[i] - '0' != count[i]) return false
    return true
}

fun main(args: Array<String>) {
    println("The self-describing numbers less than 100 million are:")
    for (i in 0..99999999) if (selfDescribing(i)) print("$i ")
    println()
}


'adapted from BASIC solution
FOR x = 1 TO 5000000
   a$ = TRIM$(STR$(x))
   b = LEN(a$)
   FOR c = 1 TO b
      d$ = MID$(a$, c, 1)
      v(VAL(d$)) = v(VAL(d$)) + 1
      w(c - 1) = VAL(d$)
   NEXT c
   r = 0
   FOR n = 0 TO 10
      IF v(n) = w(n) THEN r = r + 1
      v(n) = 0
      w(n) = 0
   NEXT n
   IF r = 11 THEN PRINT x; " is a self-describing number"
NEXT x
PRINT
PRINT "End"


function selfDescNumber n
    local tSelfD, tLen
    put len(n) into tLen
    repeat with x = 0 to (tLen - 1)
        put n into nCopy
        replace x with empty in nCopy
        put char (x + 1) of n = (tLen - len(nCopy)) into tSelfD
        if not tSelfD then exit repeat
    end repeat
    return tSelfD
end selfDescNumber


TO XX
BT
MAKE "AA (ARRAY 10 0)
MAKE "BB (ARRAY 10 0)
FOR [Z 0 9][SETITEM :Z :AA "0 SETITEM :Z :BB "0 ]
   FOR [A 1 50000][
      MAKE "B COUNT :A
      MAKE "Y 0
      MAKE "X 0
      MAKE "R 0
      MAKE "J 0
      MAKE "K 0

   FOR [C 1 :B][MAKE "D ITEM :C :A
      SETITEM :C - 1 :AA :D
      MAKE "X ITEM :D :BB
      MAKE "Y :X + 1
      SETITEM :D :BB :Y
      MAKE "R 0]
   FOR [Z 0 9][MAKE "J ITEM :Z :AA
      MAKE "K ITEM :Z :BB
      IF :J = :K [MAKE "R :R + 1]]
IF :R = 10 [PR :A]
FOR [Z 0 9][SETITEM :Z :AA "0 SETITEM :Z :BB "0 ]]
PR [END]
END


function Is_self_describing( n )
    local s = tostring( n )

    local t = {}
    for i = 0, 9 do t[i] = 0 end

    for i = 1, s:len() do
	local idx = tonumber( s:sub(i,i) )
        t[idx] = t[idx] + 1
    end

    for i = 1, s:len() do
        if t[i-1] ~= tonumber( s:sub(i,i) ) then return false end
    end

    return true
end

for i = 1, 999999999 do
    print( Is_self_describing( i ) )
end


isSelfDescribing[n_Integer] := (RotateRight[DigitCount[n]] == PadRight[IntegerDigits[n], 10])


function z = isSelfDescribing(n)
  s = int2str(n)-'0';    % convert to vector of digits
  y = hist(s,0:9);
  z = all(y(1:length(s))==s);
end;


numbers = [12, 1210, 1300, 2020, 21200, 5]

occurrences = function(test, values)
    count = 0
    for i in values
        if i.val == test then count = count + 1
    end for
    return count
end function

for number in numbers
    check = "" + number
    digits = check.values
    describing = true
    for digit in digits.indexes
        if digits[digit].val != occurrences(digit, digits) then
            describing = false
        end if
    end for
    if describing then
        print number + " is self describing"
    else
        print number + " is not self describing"
    end if
end for