Self-describing numbers

This task has been clarified. Its programming examples are in need of review to ensure that they still fit the requirements of the task.

Self-describing numbers is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.

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]

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>

Logo

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

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>

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>