[ factors
   0 over witheach +
   swap size mod 0 = ]            is arithmetic  ( n --> b )

 [ temp put [] 1
   [ over size temp share < while
     dup arithmetic if
       [ tuck join swap ]
     1+
     again ]
   drop
   temp release ]                 is arithmetics ( n --> [ )

  say "First 100 arithmetic numbers:"
  cr
  100 arithmetics echo
  cr cr
  say "1000th arithmetic number: "
  1000 arithmetics
  dup -1 peek
  echo cr
  say "Composites in first 1000: "
  behead drop
  0 swap witheach
     [ isprime not + ]
  echo
  cr cr
  say "10000th arithmetic number: "
  10000 arithmetics
  dup -1 peek
  echo cr
  say "Composites in first 10000: "
  behead drop
  0 swap witheach
     [ isprime not + ]
  echo
  cr