Self-describing numbers

From Rosetta Code
This task has been clarified. Its programming examples are in need of review to ensure that they still fit the requirements of the task.
Task
Self-describing numbers
You are encouraged to solve this task according to the task description, using any language you may know.

There are several integers numbers called "self-describing".

Integers with the property that, when digit positions are labeled 0 to N-1, the digit in each position is equal to the number of times that that digit appears in the number.

For example 2020 is a four digit self describing number.

Position "0" has value 2 and there is two 0 in the number. Position "1" has value 0 because there are not 1's in the number. Position "2" has value 2 and there is two 2. And the position "3" has value 0 and there are zero 3's.

Self-describing numbers < 100.000.000: 1210 - 2020 - 21200 - 3211000 - 42101000

Task Description
  1. Write a function/routine/method/... that will check whether a given positive integer is self-describing.
  2. As an optional stretch goal - generate and display the set of self-describing numbers.


BASIC

<lang qbasic>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</lang>

C

<lang c>#include <stdio.h>

  1. include <stdlib.h>
  2. include <stdbool.h>
  3. include <stdint.h>
  4. include <string.h>

bool is_self_describing(uint64_t n) { 

   uint8_t digits[10], i, k, d[10];
   
   if (n == 0) return false;

   memset(digits, 0, 10*sizeof(uint8_t));
   memset(d,      0, 10*sizeof(uint8_t));

   for(i = 0; n > 0 && i < 10; n /= 10, i++)
   {

d[i] = n % 10; digits[d[i]]++; 

   }
   if (n > 0) return false;
   for(k = 0; k < i; k++)
   {

if ( d[k] != digits[i - k - 1] ) return false; 

   } 

   return true;

}

int main() { 

   uint64_t sd[] = { 0, 1210, 1211, 2020, 2121, 21200, 3211000, 42101000 };
   uint64_t i;

   for(i = 0; i < sizeof(sd)/sizeof(uint64_t); i++)

printf("%llu is%s self-describing\n", sd[i], is_self_describing(sd[i]) ? "" : " NOT"); 

   // let's find them brute-force (not a good idea...)
   for(i = 521001001; i <= 9999999999LLU; i++)
   {

if (is_self_describing(i)) printf("%llu\n", i); 

   }

   return 0;

}</lang>

D

A functional version

Don't compile with -inline (DMD 2.053). <lang d>import std.stdio, std.algorithm, std.range, std.conv;

bool isSelfDescribing(long n) { 

 auto nu = map!q{a - '0'}(text(n));
 auto f = map!((a){ return count(nu, a); })(iota(walkLength(nu)));
 return equal(nu, f);

}

void main() { 

 writeln(filter!isSelfDescribing(iota(4_000_000)));

}</lang> Output: 

[1210, 2020, 21200, 3211000]

(About 5.2 seconds run time.)

A faster version

<lang d>import std.stdio;

bool isSelfDescribing2(long n) { 

 if (n <= 0)
   return false;

 __gshared static uint[10] digits, d;
 digits[] = 0;
 d[] = 0;
 int i;
 if (n < uint.max) {
   uint nu = cast(uint)n;
   for (i = 0; nu > 0 && i < digits.length; nu /= 10, i++) {
     d[i] = cast(ubyte)(nu % 10);
     digits[d[i]]++;
   }
   if (nu > 0)
     return false;
 } else {
   for (i = 0; n > 0 && i < digits.length; n /= 10, i++) {
     d[i] = cast(ubyte)(n % 10);
     digits[d[i]]++;
   }
   if (n > 0)
     return false;
 }

 foreach (k; 0 .. i)
   if (d[k] != digits[i - k - 1])
     return false;
 return true;

}

void main() { 

 foreach (x; [1210, 2020, 21200, 3211000,
              42101000, 521001000, 6210001000])
   assert(isSelfDescribing2(x));

 foreach (i; 0 .. 600_000_000)
   if (isSelfDescribing2(i))
     writeln(i);

}</lang> Output: 

1210
2020
21200
3211000
42101000
521001000

(About 0.5 seconds run time for 4 million tests.)

Haskell

<lang Haskell>import Data.Char

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

isSelfDescribing :: Integer -> Bool isSelfDescribing n = 

   nu == f where
           nu = map digitToInt (show n)
           f = map (\a -> count a nu) [0 .. ((length nu)-1)]

main = do 

   let tests = [1210, 2020, 21200, 3211000,
                42101000, 521001000, 6210001000]
   print $ map isSelfDescribing tests
   print $ filter isSelfDescribing [0 .. 4000000]</lang>

Output: 

[True,True,True,True,True,True,True]
[1210,2020,21200,3211000]

Here are functions for generating all the self-describing numbers of a certain length. We capitalize on the fact (from Wikipedia) that a self-describing number of length n is a base-n number (i.e. all digits are 0..n-1). <lang haskell>import Data.Char (intToDigit) import Control.Monad (replicateM, forM_)

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

-- all the combinations of n digits of base n -- a base-n number are represented as a list of ints, one per digit allBaseNNumsOfLength :: Int -> Int allBaseNNumsOfLength n = replicateM n [0..n-1]

isSelfDescribing :: [Int] -> Bool isSelfDescribing num = 

 all (\(i,x) -> x == count i num) $ zip [0..] num

-- translate it back into an integer in base-10 decimalize :: [Int] -> Int decimalize = read . map intToDigit

main = forM_ [1..7] $ 

 print . map decimalize . filter isSelfDescribing . allBaseNNumsOfLength</lang>

Icon and Unicon

The following program contains the procedure is_self_describing to test if a number is a self-describing number, and the procedure self_describing_numbers to generate them.

<lang Icon> 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

  1. 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 </lang> A slightly more concise solution can be derived from the above by taking more advantage of Icon's (and Unicon's) automatic goal-directed evaluation: <lang unicon> 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 n # on success, return the self-described number

end

procedure self_describing_numbers () 

 suspend is_self_describing(seq())

end</lang>

J

<lang j> NB. background material: 

  digits=: 10 #.inv ]
  digits 2020

2 0 2 0 

  (,~ i.@#@digits)2020

0 1 2 3 2020 

  (digits ,~ i.@#@digits)2020

0 1 2 3 2 0 2 0 

  (,~ i.@#)&digits 2020

0 1 2 3 2 0 2 0 

  _1 + #/.~@(,~ i.@#)&digits 2020

2 0 2 0

NB. task item 1: 

  (digits -: _1 + #/.~@(,~ i.@#)&digits) 2020

1 

  (digits -: _1 + #/.~@(,~ i.@#)&digits) 1210

1 

  (digits -: _1 + #/.~@(,~ i.@#)&digits) 21200

1 

  (digits -: _1 + #/.~@(,~ i.@#)&digits) 3211000

1 

  (digits -: _1 + #/.~@(,~ i.@#)&digits) 43101000

0 

  (digits -: _1 + #/.~@(,~ i.@#)&digits) 42101000

1

NB. task item 2: 

  I. (digits -: _1 + #/.~@(,~ i.@#)&digits)"0 i.1e6  NB. task item 2

1210 2020 21200</lang>

K

<lang k> sdn: {n~+/'n=/:!#n:0$'$x}' 

 sdn 1210 2020 2121 21200 3211000 42101000

1 1 0 1 1 1 

 &sdn@!:1e6

1210 2020 21200</lang>

<lang logo>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 :C - 1 :AA :D 
     MAKE "X ITEM :D :BB 
     MAKE "Y  .. i)
   if (d[k] != digit0
     MAKE "R 0
     MAKE "J 0
     MAKE "K 0

  FOR [C 1 :B][MAKE "D ITEM :C :A
     SETITEM :X + 1 
     SETITEM :D :BB :Y 
     MAKE "R 0]
  FOR [Z 0 9][MAKE "J ITEM :Z :AA:C - 1 :AA :D 
     MAKE "X ITEM :D :BB 
     MAKE "Y  .. i)
   if (d[k] != digits[i - k - 1])
     return false;
 return true;

}

void: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</lang>

Lua

<lang lua>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</lang>

PicoLisp

<lang PicoLisp>(de selfDescribing (N) 

  (not
     (find '((D I) (<> D (cnt = N (circ I))))
        (setq N (mapcar format (chop N)))
        (range 0 (length N)) ) ) )</lang>

Output: 

: (filter selfDescribing (range 1 4000000))
-> (1210 2020 21200 3211000)

Prolog

Works with SWI-Prolog and library clpfd written by Markus Triska. <lang Prolog>:- use_module(library(clpfd)).

self_describling :- forall(between(1, 10, I), (findall(N, self_describling(I,N), L), format('Len ~w, Numbers ~w~n', [I, L]))).

% search of the self_describling numbers of a given len self_describling(Len, N) :- length(L, Len), Len1 is Len - 1, L = [H|T],

% the first figure is greater than 0 H in 1..Len1,

% there is a least to figures so the number of these figures % is at most Len - 2 Len2 is Len - 2, T ins 0..Len2,

% the sum of the figures is equal to the len of the number sum(L, #=, Len),

% There is at least one figure corresponding to the number of zeros H1 #= H+1, element(H1, L, V), V #> 0,

% create the list label(L),

% test the list msort(L, LNS), packList(LNS,LNP), numlist(0, Len1, NumList), verif(LNP,NumList, L),

% list is OK, create the number maplist(atom_number, LA, L), number_chars(N, LA).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % testing a number (not use in this program) self_describling(N) :- number_chars(N, L), maplist(atom_number, L, LN), msort(LN, LNS), packList(LNS,LNP), !, length(L, Len), Len1 is Len - 1, numlist(0, Len1, NumList), verif(LNP,NumList, LN).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % verif(PackList, Order_of_Numeral, Numeral_of_the_nuber_to_test) % Packlist is of the form [[Number_of_Numeral, Order_of_Numeral]|_] % Test succeed when

% All lists are empty verif([], [], []).

% Packlist is empty and all lasting numerals are 0 verif([], [_N|S], [0|T]) :- verif([], S, T).

% Number of numerals N is V verif([[V, N]|R], [N|S], [V|T]) :- verif(R, S, T).

% Number of numerals N is 0 verif([[V, N1]|R], [N|S], [0|T]) :- N #< N1, verif([[V,N1]|R], S, T).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % ?- packList([a,a,a,b,c,c,c,d,d,e], L). % L = [[3,a],[1,b],[3,c],[2,d],[1,e]] . % ?- packList(R, [[3,a],[1,b],[3,c],[2,d],[1,e]]). % R = [a,a,a,b,c,c,c,d,d,e] . % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% packList([],[]).

packList([X],1,X) :- !.


packList([X|Rest],[XRun|Packed]):- 

   run(X,Rest, XRun,RRest),
   packList(RRest,Packed).


run(Var,[],[1, Var],[]).

run(Var,[Var|LRest],[N1, Var],RRest):- 

   N #> 0,
   N1 #= N + 1,
   run(Var,LRest,[N, Var],RRest).


run(Var,[Other|RRest], [1, Var],[Other|RRest]):- 

   dif(Var,Other).</lang>

Output 

 ?- self_describling.
Len 1, Numbers []
Len 2, Numbers []
Len 3, Numbers []
Len 4, Numbers [1210,2020]
Len 5, Numbers [21200]
Len 6, Numbers []
Len 7, Numbers [3211000]
Len 8, Numbers [42101000]
Len 9, Numbers [521001000]
Len 10, Numbers [6210001000]
true.

PureBasic

<lang PureBasic>Procedure isSelfDescribing(x.q) 

 ;returns 1 if number is self-describing, otherwise it returns 0
 Protected digitCount, digit, i, digitSum
 Dim digitTally(10)
 Dim digitprediction(10)
 
 If x <= 0
   ProcedureReturn 0 ;number must be positive and non-zero
 EndIf 
 
 While x > 0 And i < 10
   digit = x % 10
   digitSum + digit
   If digitSum > 10
     ProcedureReturn 0 ;sum of digits' values exceeds maximum possible
   EndIf 
   digitprediction(i) = digit 
   digitTally(digit) + 1
   x / 10
   i + 1 
 Wend 
 digitCount = i - 1
 
 If digitSum < digitCount Or x > 0
   ProcedureReturn 0  ;sum of digits' values is too small or number has more than 10 digits
 EndIf 
 
 For i = 0 To digitCount
   If digitTally(i) <> digitprediction(digitCount - i)
     ProcedureReturn 0 ;number is not self-describing
   EndIf
 Next
 ProcedureReturn 1 ;number is self-describing

EndProcedure

Procedure displayAll() 

 Protected i, j, t
 PrintN("Starting search for all self-describing numbers..." + #CRLF$)
 For j = 0 To 9
   PrintN(#CRLF$ + "Searching possibilites " + Str(j * 1000000000) + " -> " + Str((j + 1) * 1000000000 - 1)+ "...")
   t = ElapsedMilliseconds()
   For i = 0 To 999999999
     If isSelfDescribing(j * 1000000000 + i)
       PrintN(Str(j * 1000000000 + i))
     EndIf 
   Next
   PrintN("Time to search this range of possibilities: " + Str((ElapsedMilliseconds() - t) / 1000) + "s.")
 Next 
 PrintN(#CRLF$ + "Search complete.")

EndProcedure

If OpenConsole() 

 DataSection
   Data.q 1210, 2020, 21200, 3211000, 42101000, 521001000, 6210001000, 3214314
 EndDataSection
 
 Define i, x.q
 For i = 1 To 8
   Read.q x
   Print(Str(x) + " is ")
   If Not isSelfDescribing(x)
     Print("not ")
   EndIf
   PrintN("selfdescribing.")
 Next 
 PrintN(#CRLF$)
 
 displayAll()
 
 Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()
 CloseConsole()

EndIf</lang> Sample output: 

1210 is selfdescribing.
2020 is selfdescribing.
21200 is selfdescribing.
3211000 is selfdescribing.
42101000 is selfdescribing.
521001000 is selfdescribing.
6210001000 is selfdescribing.
3214314 is not selfdescribing.


Starting search for all self-describing numbers...


Searching possibilites 0 -> 999999999...
1210
2020
21200
3211000
42101000
521001000
Time to search this range of possibilities: 615s.

Searching possibilites 1000000000 -> 1999999999...
Time to search this range of possibilities: 614s.

Searching possibilites 2000000000 -> 2999999999...
Time to search this range of possibilities: 628s.

Searching possibilites 3000000000 -> 3999999999...
Time to search this range of possibilities: 631s.

Searching possibilites 4000000000 -> 4999999999...
Time to search this range of possibilities: 630s.

Searching possibilites 5000000000 -> 5999999999...
Time to search this range of possibilities: 628s.

Searching possibilites 6000000000 -> 6999999999...
6210001000
Time to search this range of possibilities: 629s.

Searching possibilites 7000000000 -> 7999999999...
Time to search this range of possibilities: 631s.

Searching possibilites 8000000000 -> 8999999999...
Time to search this range of possibilities: 629s.

Searching possibilites 9000000000 -> 9999999999...
Time to search this range of possibilities: 629s.

Search complete.

Python

<lang python>>>> def isSelfDescribing(n): s = str(n) return all(s.count(str(i)) == int(ch) for i, ch in enumerate(s))

>>> [x for x in range(4000000) if isSelfDescribing(x)] [1210, 2020, 21200, 3211000] >>> [(x, isSelfDescribing(x)) for x in (1210, 2020, 21200, 3211000, 42101000, 521001000, 6210001000)] [(1210, True), (2020, True), (21200, True), (3211000, True), (42101000, True), (521001000, True), (6210001000, True)]</lang>

Generator

From here. <lang python>def impl(d, c, m): 

   if m < 0: return
   if d == c[:len(d)]: print d
   for i in range(c[len(d)],m+1):
       dd = d+[i]
       if i<len(dd) and c[i]==dd[i]: continue
       impl(dd,c[:i]+[c[i]+1]+c[i+1:],m-i)

def self(n): impl([], [0]*(n+1), n)

self(10)</lang> Output: 

[]
[1, 2, 1, 0]
[2, 0, 2, 0]
[2, 1, 2, 0, 0]
[3, 2, 1, 1, 0, 0, 0]
[4, 2, 1, 0, 1, 0, 0, 0]
[5, 2, 1, 0, 0, 1, 0, 0, 0]
[6, 2, 1, 0, 0, 0, 1, 0, 0, 0]

Tcl

<lang tcl>package require Tcl 8.5 proc isSelfDescribing num { 

   set digits [split $num ""]
   set len [llength $digits]
   set count [lrepeat $len 0]
   foreach d $digits {

if {$d >= $len} {return false} lset count $d [expr {[lindex $count $d] + 1}] 

   }
   foreach d $digits c $count {if {$c != $d} {return false}}
   return true

}

for {set i 0} {$i < 100000000} {incr i} { 

   if {[isSelfDescribing $i]} {puts $i}

}</lang>

Retrieved from "https://rosettacode.org/wiki/Self-describing_numbers?oldid=179847"