Strange numbers: Difference between revisions

From Rosetta Code
Content added Content deleted
Line 125: Line 125:
{ 1 8 6 9 7 9 7 9 7 9 }
{ 1 8 6 9 7 9 7 9 7 9 }
</pre>
</pre>

=={{header|Haskell}}==
<lang haskell>import Data.List (intercalate)
import Data.List.Split (chunksOf)

--------------------- STRANGE NUMBERS --------------------

isStrange :: Int -> Bool
isStrange n =
all
(\(a, b) -> abs (a - b) `elem` [2, 3, 5, 7])
$ (zip <*> tail) (digits n)

digits :: Int -> [Int]
digits = fmap (read . return) . show

--------------------------- TEST -------------------------
main =
let xs = filter isStrange [100 .. 500]
in (putStrLn . intercalate "\n\n")
[ "Strange numbers found in range [100..500]",
"(total " <> (show . length) xs <> ")",
"Full list:",
unlines
(unwords <$> chunksOf 10 (show <$> xs))
]</lang>
{{Out}}
<pre></pre>


=={{header|Julia}}==
=={{header|Julia}}==

Revision as of 19:05, 24 February 2021

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

n   is a strange number if every adjacent decimal digit differs from its neighbour by a prime number.

Show all strange numbers for   100   <   n   <   500

Stretch goal

Show the number of 10-digit strange numbers that begin with 1

ALGOL W

<lang algolw>begin % find "strange numbers" - numbers where digits differ from the next % 

     % by a prime                                                         %
   % returns true if n is strange, false otherwise                        %
   logical procedure isStrange( integer value n ) ;
   begin
       integer rest;
       rest    := abs( n );
       if rest < 10 then false
       else begin
           logical strange;
           integer d0;
           strange := true;
           d0      := rest rem 10;
           rest    := rest div 10;   
           while strange and rest > 0 do begin
               integer d1, diff;
               d1      := rest rem 10;
               rest    := rest div 10;
               diff    := abs( d1 - d0 );
               strange := diff = 2 or diff = 3 or diff = 5 or diff = 7;
               d0      := d1
           end while_strange_and_rest_gt_0 ;
           strange
       end if_rest_lt_10__
   end isStrange ;
   % test the isStrange procedure on values 100-499                       %
   begin
       integer strangeCount;
       strangeCount := 0;
       for n := 100 until 499 do begin;
           if isStrange( n ) then begin
               strangeCount := strangeCount + 1;
               if strangeCount rem 20 = 1
               then write(   i_w := 4, s_w := 0, n )
               else writeon( i_w := 4, s_w := 0, n )
           end if_isStrange_n
       end for_n
   end

end.</lang>

Output:
 130 131 135 136 138 141 142 146 147 149 161 163 164 168 169 181 183 185 186 202
 203 205 207 241 242 246 247 249 250 252 253 257 258 270 272 274 275 279 292 294
 296 297 302 303 305 307 313 314 316 318 350 352 353 357 358 361 363 364 368 369
 381 383 385 386 413 414 416 418 420 424 425 427 429 461 463 464 468 469 470 472
 474 475 479 492 494 496 497

Factor

Identifying and filtering

Works with: Factor version 0.99 2020-08-14

<lang factor>USING: grouping io kernel math.ranges math.statistics math.text.utils math.vectors prettyprint sequences ;

strange? ( n -- ? )
   1 digit-groups differences vabs
   [ { 2 3 5 7 } member? ] all? ;

"Strange numbers in (100, 500):" print nl 100 500 (a,b) [ strange? ] filter dup 10 group [ [ pprint bl ] each nl ] each nl length pprint " strange numbers found." print</lang>

Output:
Strange numbers in (100, 500):

130 131 135 136 138 141 142 146 147 149 
161 163 164 168 169 181 183 185 186 202 
203 205 207 241 242 246 247 249 250 252 
253 257 258 270 272 274 275 279 292 294 
296 297 302 303 305 307 313 314 316 318 
350 352 353 357 358 361 363 364 368 369 
381 383 385 386 413 414 416 418 420 424 
425 427 429 461 463 464 468 469 470 472 
474 475 479 492 494 496 497 

87 strange numbers found.

Generating

Since we know the next possible digits based on the current last digit, we can construct strange numbers with a backtracking algorithm.

Works with: Factor version 0.99 2020-08-14

<lang factor>USING: backtrack compiler.tree.propagation.call-effect formatting io kernel sequences sequences.generalizations tools.memory.private tools.time ;

d ( digit -- digit next-digit )
   dup {
       { 2 3 5 7 }         ! from 0 we can get to these digits
       { 3 4 6 8 }         ! from 1 we can get to these
       { 0 4 5 7 9 }       ! etc...
       { 0 1 5 6 8 }
       { 1 2 6 7 9 }
       { 0 2 3 7 8 }
       { 1 3 4 8 9 }
       { 0 2 4 5 9 }
       { 1 3 5 6 }
       { 2 4 6 7 }
   } nth amb-lazy ;

[ [ 1 d d d d d d d d d 10 narray ] bag-of ] time

dup length commas write " 10-digit strange numbers beginning with 1:" print [ first2 ] [ last2 ] bi "%u\n%u\n...\n%u\n%u\n" printf</lang>

Output:
Running time: 1.904245898 seconds

853,423 10-digit strange numbers beginning with 1:
{ 1 3 0 2 0 2 0 2 0 2 }
{ 1 3 0 2 0 2 0 2 0 3 }
...
{ 1 8 6 9 7 9 7 9 7 5 }
{ 1 8 6 9 7 9 7 9 7 9 }

Haskell

<lang haskell>import Data.List (intercalate) import Data.List.Split (chunksOf)

STRANGE NUMBERS --------------------

isStrange :: Int -> Bool isStrange n = 

 all
   (\(a, b) -> abs (a - b) `elem` [2, 3, 5, 7])
   $ (zip <*> tail) (digits n)

digits :: Int -> [Int] digits = fmap (read . return) . show

TEST -------------------------

main = 

 let xs = filter isStrange [100 .. 500]
  in (putStrLn . intercalate "\n\n")
       [ "Strange numbers found in range [100..500]",
         "(total " <> (show . length) xs <> ")",
         "Full list:",
         unlines
           (unwords <$> chunksOf 10 (show <$> xs))
       ]</lang>
Output:


Julia


Filter method


<lang julia>isstrange(n::Integer) = (d = digits(n); all(i -> abs(d[i] - d[i + 1]) ∈ [2, 3, 5, 7], 1:length(d)-1))

function filter_open_interval(start, stop, f, doprint=true, rowlength=92)



   colsize = length(string(stop)) + 1
   columns, ncount = rowlength ÷ colsize, 0
   println("Finding numbers matching $f for open interval ($start, $stop):\n")
   for n in start+1:stop-1
       if isstrange(n)
           ncount += 1
           doprint && print(rpad(n, colsize), ncount % columns == 0 ? "\n" : "")
       end
   end
   println("\n\nThe total found was $ncount\n\n")



end

filter_open_interval(100, 500, isstrange)


</lang>


Output:


Finding numbers matching isstrange for open interval (100, 500):

130 131 135 136 138 141 142 146 147 149 161 163 164 168 169 181 183 185 186 202 203 205 207
241 242 246 247 249 250 252 253 257 258 270 272 274 275 279 292 294 296 297 302 303 305 307
313 314 316 318 350 352 353 357 358 361 363 364 368 369 381 383 385 386 413 414 416 418 420
424 425 427 429 461 463 464 468 469 470 472 474 475 479 492 494 496 497

The total found was 87



Generator method


HT: Factor for the table.
<lang julia>function countstrange(places, fixedstart=1)



   possibles = [
       [2, 3, 5, 7],
       [3, 4, 6, 8],
       [0, 4, 5, 7, 9],
       [0, 1, 5, 6, 8],
       [1, 2, 6, 7, 9],
       [0, 2, 3, 7, 8],
       [1, 3, 4, 8, 9],
       [0, 2, 4, 5, 9],
       [1, 3, 5, 6],
       [2, 4, 6, 7],
   ]
   strangeones = [fixedstart]
   for _ in 2:places
       newones = Int[]
       for n in strangeones, nextn in possibles[n % 10 + 1]
           push!(newones, n * 10 + nextn)
       end
       strangeones = newones
   end
   println("Found ", length(strangeones), " $places-digit strange numbers with the most significant digit $fixedstart.\n")



end

countstrange(10)
@time countstrange(10)


</lang>


Output:


Found 853423 10-digit strange numbers with the most significant digit 1.

Found 853423 10-digit strange numbers with the most significant digit 1.
  0.014545 seconds (139 allocations: 13.298 MiB, 29.39% gc time)



Pascal


modified recursive version like Julia/Factor using the digits that can follow.

Not dynamically memorizing of all numbers saves much time 200ms -> 4ms.

Count is about 4.6 to the power of Digitscount -> first digit 1 followed by 9 digit -> 4.6^9 = 922190
<lang pascal>program strangenumbers;

const



 dgtMaxCnt = 10;
 deltaDgtCnt: array[0..9] of Int32 =(4,4,5,5,5,5,5,5,4,4); // (4*4+6*5)/10 =>  4.6 
 // digits that can follow 
 DPrmNxtDgt : array[0..9,0..4] of Int32 =((2,3,5,7,0),  //0 +2,+3,+5,+7
                                          (3,4,6,8,0),  //1 +2,+3,+5,+7
                                          (0,4,5,7,9),  //2 -2,+2,+3,+5,+7  
                                          (0,1,5,6,8),  //3 -3,-2,+2,+3,+5
                                          (1,2,6,7,9),  //4 -3,-2,+2,+3,+5
                                          (0,2,3,7,8),  //5 -5,-3,-2,+2,+3
                                          (1,3,4,8,9),  //6 -5,-3,-2,+2,+3
                                          (0,2,4,5,9),  //7 -7,-5,-3,-2,+2  
                                          (1,3,5,6,0),  //8 -7,-5,-3,-2
                                          (2,4,6,7,0)); //9 -7,-5,-3,-2



type 



 tDigits = array[0..dgtMaxCnt-1] of Int32;                                           
                                      



//globals are set to 0
var



 Digits : tDigits;
 i,Cnt,dgtCnt : Int32;  



procedure OutPut(const Digits:tDigits);
var



 i : Int32;



Begin



 For i := 0 to dgtcnt-1 do
   write(Digits[i]);
 write(' ');  



end;

procedure NextDigit(var Digits:TDigits;DgtIdx:Int32);
var



 idx,dgt :Int32;



Begin



 dgt := Digits[DgtIdx];
 inc(DgtIdx);
 IF DgtIdx < dgtCnt-1 then
 Begin
   For idx := 0 to deltaDgtCnt[dgt]-1 do
   Begin
     Digits[DgtIdx]:= DPrmNxtDgt[dgt,idx];
     NextDigit(Digits,DgtIdx);
   end;  
 end
 else
 Begin
   For idx := 0 to deltaDgtCnt[dgt]-1 do
   Begin
     Digits[DgtIdx]:= DPrmNxtDgt[dgt,idx];
     inc(cnt);   
     IF dgtCnt<5 then
     Begin
       OutPut(Digits);
       If cnt mod 16 = 0 then
         Writeln;
     end;         
   end;
 end;    



end;

Begin



 cnt := 0;
 dgtCnt := 3;
 Writeln('Count of digits : ', dgtCnt,' in 100..499');
 For i := 1 to 4 do
 Begin
   Digits[0] := i;
   NextDigit(Digits,0);    
 end;
 Writeln;
 Writeln('Count : ',cnt);
 Writeln;
 
 cnt := 0;
 dgtCnt := 10;
 Writeln('Count of digits : ', dgtCnt);  
 For i := 1 to 1 do
 Begin
   Digits[0] := i;
   NextDigit(Digits,0);    
 end;
 Writeln;
 Writeln('Count : ',cnt);  



end.</lang>





Output:



Count of digits : 3 in 100..499
130 131 135 136 138 141 142 146 147 149 161 163 164 168 169 181 
183 185 186 202 203 205 207 241 242 246 247 249 250 252 253 257 
258 270 272 274 275 279 292 294 296 297 302 303 305 307 313 314 
316 318 350 352 353 357 358 361 363 364 368 369 381 383 385 386 
413 414 416 418 420 424 425 427 429 461 463 464 468 469 470 472 
474 475 479 492 494 496 497 
Count : 87

Count of digits : 10

Count : 853423


Perl


<lang perl>use strict;
use warnings;
use feature 'say';
use Quantum::Superpositions;

sub is_strange {



   my @digits = split , $_;
   my @deltas = map { abs $digits[$_-1] - $digits[$_] } 1..$#digits;
   all(@deltas) == any(2, 3, 5, 7);



}

my($low, $high) = (100, 500);
my $cnt = my @strange = grep { is_strange($_) } $low+1 .. $high-1;
say "Between $low and $high there are $cnt strange numbers:\n" .



   (sprintf "@{['%5d' x $cnt]}", @strange[0..$cnt-1]) =~ s/(.{80})/$1\n/gr;</lang>





Output:


Between 100 and 500 there are 87 strange numbers:
  130  131  135  136  138  141  142  146  147  149  161  163  164  168  169  181
  183  185  186  202  203  205  207  241  242  246  247  249  250  252  253  257
  258  270  272  274  275  279  292  294  296  297  302  303  305  307  313  314
  316  318  350  352  353  357  358  361  363  364  368  369  381  383  385  386
  413  414  416  418  420  424  425  427  429  461  463  464  468  469  470  472
  474  475  479  492  494  496  497


Phix


<lang Phix>constant diff = {-7,-5,-3,-2,2,3,5,7},



        poss = apply(true,sq_add,{tagset(9,0),{diff}}),
        nxts = apply(true,filter,{poss,{"in"},Template:0,9,{"[]"}})



--       nxts is {{2,3,5,7},{3,4,6,8}..., as per the factor and other entries

function strange(integer left, sequence digits, res={}, part={})



   for i=1 to length(digits) do
       integer di = digits[i]
       if left=1 then
           string fmt = join(repeat("%d",length(part)+1),"")
           res = append(res,sprintf(fmt,part&di))
       else
           res = strange(left-1,nxts[di+1],res,part&di)
       end if
   end for
   return res



end function

sequence res = strange(3,tagset(4)) -- (3 digit numbers beginning 1..4)
printf(1,"%d strange numbers found: %v\n",{length(res),shorten(res,"",5)})</lang>





Output:


87 strange numbers found: {"130","131","135","136","138","...","479","492","494","496","497"}



stretch goal


Dunno when to quit, me.
<lang Phix>constant diff = {-7,-5,-3,-2,2,3,5,7},



        poss = apply(true,sq_add,{tagset(9,0),{diff}}),
        nxts = apply(true,filter,{poss,{"in"},Template:0,9,{"[]"}}),



--       nxts is {{2,3,5,7},{3,4,6,8}..., as per the factor and other entries



        ones = columnize({columnize({repeat(0,10),tagset(9,0)}),repeat(1,10)}),
        twos = columnize({columnize({repeat(1,10),tagset(9,0)}),apply(nxts,length)}),
        dict = new_dict(ones&twos)



function count_strange(integer left, sequence digits, atom res=0)



   for i=1 to length(digits) do
       integer di = digits[i]
       if getd_index({left-1,di},dict)!=NULL then
           res += getd({left-1,di},dict)
       else
           atom prev = res
           res = count_strange(left-1,nxts[di+1],res)
           setd({left-1,di},res-prev,dict)
       end if
   end for
   return res



end function
atom t0 = time()

atom count = count_strange(10,tagset(1))
printf(1,"There are %,d %d-digit strange numbers beginning with 1\n\n",{count,10})

-- assumes "0" is a strange number
for n=1 to iff(machine_bits()=32?23:28) do



   printf(1,"Total %d-digit strange numbers: %,d\n",{n,count_strange(n,tagset(9,n>1))})



end for

printf(1,"(%s)\n",elapsed(time()))</lang>





Output:


There are 853,423 10-digit strange numbers beginning with 1

Total 1-digit strange numbers: 10
Total 2-digit strange numbers: 42
Total 3-digit strange numbers: 194
Total 4-digit strange numbers: 901
Total 5-digit strange numbers: 4,178
Total 6-digit strange numbers: 19,395
Total 7-digit strange numbers: 90,011
Total 8-digit strange numbers: 417,837
Total 9-digit strange numbers: 1,939,540
Total 10-digit strange numbers: 9,003,578
Total 11-digit strange numbers: 41,795,409
Total 12-digit strange numbers: 194,020,644
Total 13-digit strange numbers: 900,672,711
Total 14-digit strange numbers: 4,181,070,893
Total 15-digit strange numbers: 19,409,220,279
Total 16-digit strange numbers: 90,100,876,862
Total 17-digit strange numbers: 418,263,512,702
Total 18-digit strange numbers: 1,941,650,412,637
Total 19-digit strange numbers: 9,013,471,997,782
Total 20-digit strange numbers: 41,842,075,002,263
Total 21-digit strange numbers: 194,238,054,320,527
Total 22-digit strange numbers: 901,686,217,399,477
Total 23-digit strange numbers: 4,185,781,417,010,380
Total 24-digit strange numbers: 19,431,112,295,670,526
Total 25-digit strange numbers: 90,202,542,361,448,337
Total 26-digit strange numbers: 418,735,609,894,371,624
Total 27-digit strange numbers: 1,943,842,229,729,877,443
Total 28-digit strange numbers: 9,023,647,681,353,485,161
(0.0s)



Raku


<lang perl6>sub infix:<′>(\x,\y) { abs(x - y) ∈ (2, 3, 5, 7) }

my ($low,$high) = 100, 500;
my @strange.push: $_ if so all .comb.rotor(2 => -1).map: { .[0] ′ .[1] } for $low ^..^ $high;

say "Between $low and $high there are {+@strange} strange numbers:\n";
print @strange.batch(20)».fmt("%4d").join: "\n";</lang>





Output:


Between 100 and 500 there are 87 strange numbers:

 130  131  135  136  138  141  142  146  147  149  161  163  164  168  169  181  183  185  186  202
 203  205  207  241  242  246  247  249  250  252  253  257  258  270  272  274  275  279  292  294
 296  297  302  303  305  307  313  314  316  318  350  352  353  357  358  361  363  364  368  369
 381  383  385  386  413  414  416  418  420  424  425  427  429  461  463  464  468  469  470  472
 474  475  479  492  494  496  497


REXX


Some optimization was added to bypass calculating the absolute value of adjacent decimal digit differences,  

as well as parsing of a number to determine the differences. 
<lang rexx>/*REXX pgm lists strange integers (within a range) whose decimal digs differ by a prime.*/
numeric digits 20                                /*allow processing of larger numbers.  */
parse arg LO HI bd .                             /*obtain optional arguments from the CL*/
if LO== | LO==","  then LO= 101                /*Not specified?  Then use the default.*/
if HI== | HI==","  then HI= 499                /* "       "        "   "   "     "    */
if bd== | bd==","  then bd=                    /* "       "        "   "   "     "    */
begDig= bd\==                                  /*look for numbers that start with:" BD*/
show= LO>0                                       /*indicator if the list is to be shown.*/
!.= 0;    !.2= 1;    !.3= 1;    !.5= 1;   !.7= 1 /*build array of digits that are prime.*/
LO = abs(LO)                                     /*use the absolute value for the search*/



             do p=1  for 9;  _= -p;  if !.p  then !._= 1   /*extend array for negatives*/
             end   /*p*/



$=                                               /*the  list of strange numbers (so far)*/



  1. = 0                                             /* "  number "    "       "      "  "  */


    do j=LO  to  HI;       L= length(j)         /*find for strange numbers in the range*/
    if L==1  then iterate                       /*Number too short?   Then skip it.    */
    if bd\==  then if left(j, 1)\==bd  then iterate   /*Need leading dig? Maybe skip.*/



             do k=1  for L-1                    /*examine the difference in the digits.*/
             parse var  j   =(k)  y  +1  z  +1  /*get two adjacent decimal digits: Y Z */
             dif= y - z                         /*difference between any adjacent digs.*/
             if \!.dif  then iterate j          /*Difference not prime?  Then skip it. */
             end   /*k*/
    #= # + 1                                    /*bump the number of "strange" numbers.*/
    if show  then $= $ j                        /*maybe add the number to the  $  list.*/
    end   /*j*/
                                                /*stick a fork in it,  we're all done. */



say commas(#)      ' strange numbers found between '      commas(LO)       " and "  ,



                                                         commas(HI)       ' (inclusive)'



say
if show  then say strip($)</lang>





output   when using the default inputs:


87  strange numbers found between  101  and  499  (inclusive)

130 131 135 136 138 141 142 146 147 149 161 163 164 168 169 181 183 185 186 202 203 205 207 241 242 246 247 249 250 252 253 257 258
270 272 274 275 279 292 294 296 297 302 303 305 307 313 314 316 318 350 352 353 357 358 361 363 364 368 369 381 383 385 386 413 414
416 418 420 424 425 427 429 461 463 464 468 469 470 472 474 475 479 492 494 496 497





output   when using the inputs of:      -1000000000   2000000000   1 


853,423  strange numbers found between  1,000,000,000  and  2,000,000,000  (inclusive)



Ring


<lang ring>
load "stdlib.ring"

row = 0
see "Strange numbers are:"

for n = 100 to 500



   flag = 1
   str = string(n)
   for m = 1 to len(str)-1
       num1 = number(str[m])
       num2 = number(str[m+1])
       pr = fabs(num1-num2)
       if not isprime(pr)
          flag = 0
          exit
       ok
    next
    if flag = 1
       row = row + 1
       if (row-1) % 11 = 0
          see nl
       else
          see " " + str
       ok
    ok



next
</lang>





Output:


Strange numbers are:
 131 135 136 138 141 142 146 147 149 161
 164 168 169 181 183 185 186 202 203 205
 241 242 246 247 249 250 252 253 257 258
 272 274 275 279 292 294 296 297 302 303
 307 313 314 316 318 350 352 353 357 358
 363 364 368 369 381 383 385 386 413 414
 418 420 424 425 427 429 461 463 464 468
 470 472 474 475 479 492 494 496 497



Wren


Basic task


<lang ecmascript>var primes = [2, 3, 5, 7]
var count = 0
var d = []
System.print("Strange numbers in the open interval (100, 500) are:\n")
for (i in 101..499) {



   d.clear()
   var j = i
   while (j > 0) {
      d.add(j % 10)
      j = (j/10).floor
   }
   if (primes.contains((d[0] - d[1]).abs) && primes.contains((d[1] - d[2]).abs)) {
       System.write("%(i) ")
       count = count + 1
       if (count % 10 == 0) System.print()
   }



}
if (count % 10 != 0) System.print()
System.print("\n%(count) strange numbers in all.")</lang>





Output:


Strange numbers in the open interval (100, 500) are:

130 131 135 136 138 141 142 146 147 149 
161 163 164 168 169 181 183 185 186 202 
203 205 207 241 242 246 247 249 250 252 
253 257 258 270 272 274 275 279 292 294 
296 297 302 303 305 307 313 314 316 318 
350 352 353 357 358 361 363 364 368 369 
381 383 385 386 413 414 416 418 420 424 
425 427 429 461 463 464 468 469 470 472 
474 475 479 492 494 496 497 

87 strange numbers in all.



Stretch goal


Translation of: Julia


... though I've generated the 'possibles' table rather than hard-code it.
Runtime about 0.085 seconds which is quick for Wren.
<lang ecmascript>var diffs = [-7, -5, -3, -2, 2, 3, 5, 7]
var possibles = List.filled(10, null)
for (i in 0..9) {



   possibles[i] = []
   for (d in diffs) {
       var sum = i + d
       if (sum >= 0 && sum < 10) possibles[i].add(sum)
   }



}

var places = 10
var start = 1
var strangeOnes = [start]
for (i in 2..places) {



   var newOnes = []
   for (n in strangeOnes) {
       for (nextN in possibles[n%10]) newOnes.add(n*10 + nextN)
   }
   strangeOnes = newOnes



}

System.print("Found %(strangeOnes.count) %(places)-digit strange numbers beginning with %(start).")</lang>





Output:


Found 853423 10-digit strange numbers beginning with 1



Retrieved from "https://rosettacode.org/wiki/Strange_numbers?oldid=308319"