Self-describing numbers

From Rosetta Code
Revision as of 21:13, 19 May 2011 by 79.53.134.141 (talk) (Added Haskell version)
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 xs = sum $ map (\y -> if x == y then 1 else 0) xs

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]

(Run time about 2.5 seconds, GHC -O3).

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>

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

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