Self-describing numbers

From Rosetta Code

Self-describing numbers:

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


The following example is written in Basic .........................................................................

  1. lang "qb"

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


This example is written in another language Logo (FMSLogo)

........................................................................


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