aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data update

Browse source
This commit is contained in:
Ingy döt Net 2026-04-30 12:34:36 -04:00
parent 4bb20c9b71
commit cbaf4c4b64
12390 changed files with 318560 additions and 27248 deletions
Download patch file Download diff file Expand all files Collapse all files

44
Task/Arithmetic-numbers/ANSI-BASIC/arithmetic-numbers.basic Normal file
View file

@ -0,0 +1,44 @@
100 REM Arithmetic numbers
110 LET N = 1
120 LET ArithmCnt = 0
130 LET CompCnt = 0
140 PRINT "The first 100 arithmetic numbers are:";
150 PRINT
160 DO
170 LET Dv = 1
180 LET DvCnt = 0
190 LET Sum = 0
200 DO
210 LET Quot = INT(N / Dv)
220 IF Quot < Dv THEN EXIT DO
230 IF (Quot = Dv) AND (MOD(N, Dv) = 0) THEN
240 REM N is a square
250 LET Sum = Sum + Quot
260 LET DvCnt = DvCnt + 1
270 EXIT DO
280 END IF
290 IF MOD(N, Dv) = 0 THEN
300 LET Sum = Sum + Dv + Quot
310 LET DvCnt = DvCnt + 2
320 END IF
330 LET Dv = Dv + 1
340 LOOP
350 IF MOD(Sum, DvCnt) = 0 THEN
360 REM N is arithmetic
370 LET ArithmCnt = ArithmCnt + 1
380 IF ArithmCnt <= 100 THEN
390 PRINT USING "####": N;
400 IF MOD(ArithmCnt, 10) = 0 THEN PRINT
410 END IF
420 IF DvCnt > 2 THEN LET CompCnt = CompCnt + 1
430 IF (ArithmCnt = 1000) OR (ArithmCnt = 10000) THEN
440 PRINT
450 PRINT USING "The #####th arithmetic number is ##### ": ArithmCnt, N;
460 PRINT USING "up to which ##### ": CompCnt;
470 PRINT "are composite.";
480 END IF
490 END IF
500 LET N = N + 1
510 LOOP UNTIL ArithmCnt > 10001
520 PRINT
530 END

64
Task/Arithmetic-numbers/Ada/arithmetic-numbers.adb Normal file
View file

@ -0,0 +1,64 @@
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
procedure Main is
procedure divisor_count_and_sum
(n : Positive; divisor_count : out Natural; divisor_sum : out Natural)
is
I : Positive := 1;
J : Natural;
begin
divisor_count := 0;
divisor_sum := 0;
loop
J := n / I;
exit when J < I;
if I * J = n then
divisor_sum := divisor_sum + I;
divisor_count := divisor_count + 1;
if I /= J then
divisor_sum := divisor_sum + J;
divisor_count := divisor_count + 1;
end if;
end if;
I := I + 1;
end loop;
end divisor_count_and_sum;
arithmetic_count : Natural := 0;
composite_count : Natural := 0;
div_count : Natural;
div_sum : Natural;
mean : Natural;
n : Positive := 1;
begin
while arithmetic_count <= 1_000_000 loop
divisor_count_and_sum (n, div_count, div_sum);
mean := div_sum / div_count;
if mean * div_count = div_sum then
arithmetic_count := arithmetic_count + 1;
if div_count > 2 then
composite_count := composite_count + 1;
end if;
if arithmetic_count <= 100 then
Put (Item => n, Width => 4);
if arithmetic_count mod 10 = 0 then
New_Line;
end if;
end if;
if arithmetic_count = 1_000 or else arithmetic_count = 10_000
or else arithmetic_count = 100_000
or else arithmetic_count = 1_000_000
then
New_Line;
Put (Item => arithmetic_count, Width => 1);
Put_Line ("th arithmetic number is" & n'Image);
Put_Line
("Number of composite arithmetic numbers <=" & n'Image & ":" &
composite_count'Image);
end if;
end if;
n := n + 1;
end loop;
end Main;

127
Task/Arithmetic-numbers/COBOL/arithmetic-numbers.cob Normal file
View file

@ -0,0 +1,127 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. ARITHMETIC-NUMBERS.
AUTHOR. CONVERTED-FROM-JAVA.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 COUNTERS.
05 ARITHMETIC-COUNT PIC 9(7) VALUE 0.
05 COMPOSITE-COUNT PIC 9(7) VALUE 0.
05 N PIC 9(7) VALUE 1.
05 LINE-COUNT PIC 99 VALUE 0.
01 FACTOR-RELATED.
05 FACTOR-COUNT PIC 9(4) VALUE 0.
05 FACTOR-SUM PIC 9(9) VALUE 0.
05 I PIC 9(7).
05 J PIC 9(7).
05 PRODUCT PIC 9(9).
05 DIV-REMAINDER PIC 9(9).
05 MOD-RESULT PIC 9(9).
05 TEMP-FACTOR PIC 9(7).
05 FOUND-FLAG PIC X VALUE 'N'.
01 FACTOR-TABLE.
05 FACTORS OCCURS 1000 TIMES INDEXED BY FX.
10 FACTOR-VALUE PIC 9(7) VALUE 0.
01 OUTPUT-FIELDS.
05 N-FORMATTED PIC ZZZ.
PROCEDURE DIVISION.
MAIN-PROCEDURE.
PERFORM UNTIL ARITHMETIC-COUNT > 1000000
PERFORM FIND-FACTORS
PERFORM CALCULATE-SUM
DIVIDE FACTOR-SUM BY FACTOR-COUNT
GIVING MOD-RESULT REMAINDER DIV-REMAINDER
IF DIV-REMAINDER = 0
ADD 1 TO ARITHMETIC-COUNT
IF FACTOR-COUNT > 2
ADD 1 TO COMPOSITE-COUNT
END-IF
IF ARITHMETIC-COUNT <= 100
PERFORM DISPLAY-NUMBER
END-IF
EVALUATE ARITHMETIC-COUNT
WHEN 1000
WHEN 10000
WHEN 100000
WHEN 1000000
PERFORM DISPLAY-MILESTONE
END-EVALUATE
END-IF
ADD 1 TO N
END-PERFORM
STOP RUN.
FIND-FACTORS.
INITIALIZE FACTOR-TABLE
MOVE 0 TO FACTOR-COUNT
MOVE 1 TO TEMP-FACTOR
PERFORM ADD-UNIQUE-FACTOR
MOVE N TO TEMP-FACTOR
PERFORM ADD-UNIQUE-FACTOR
MOVE 2 TO I
PERFORM UNTIL I * I > N
DIVIDE N BY I GIVING J REMAINDER DIV-REMAINDER
IF DIV-REMAINDER = 0
MOVE I TO TEMP-FACTOR
PERFORM ADD-UNIQUE-FACTOR
MOVE J TO TEMP-FACTOR
PERFORM ADD-UNIQUE-FACTOR
END-IF
ADD 1 TO I
END-PERFORM.
ADD-UNIQUE-FACTOR.
MOVE 'N' TO FOUND-FLAG
PERFORM VARYING FX FROM 1 BY 1 UNTIL FX > FACTOR-COUNT
IF FACTOR-VALUE(FX) = TEMP-FACTOR
MOVE 'Y' TO FOUND-FLAG
EXIT PERFORM
END-IF
END-PERFORM
IF FOUND-FLAG = 'N'
ADD 1 TO FACTOR-COUNT
MOVE TEMP-FACTOR TO FACTOR-VALUE(FACTOR-COUNT)
END-IF.
CALCULATE-SUM.
MOVE 0 TO FACTOR-SUM
PERFORM VARYING FX FROM 1 BY 1 UNTIL FX > FACTOR-COUNT
ADD FACTOR-VALUE(FX) TO FACTOR-SUM
END-PERFORM.
DISPLAY-NUMBER.
MOVE N TO N-FORMATTED
DISPLAY N-FORMATTED WITH NO ADVANCING
ADD 1 TO LINE-COUNT
IF LINE-COUNT = 10
DISPLAY " "
MOVE 0 TO LINE-COUNT
ELSE
DISPLAY " " WITH NO ADVANCING
END-IF.
DISPLAY-MILESTONE.
DISPLAY " "
DISPLAY ARITHMETIC-COUNT "th arithmetic number is " N
DISPLAY "Number of composite arithmetic numbers <= "
N ": " COMPOSITE-COUNT.

45
Task/Arithmetic-numbers/Crystal/arithmetic-numbers.cr Normal file
View file

@ -0,0 +1,45 @@
struct Int
def arith_compo
return {false, false} unless self > 0
return {true, false} if self == 1
n = self
sum = n + 1
count = 2
i = 2
loop do
j = n // i
break if j < i
if i * j == n
sum += i; count += 1
(sum += j; count += 1) unless i == j
end
i += 1
end
{ sum % count == 0, count > 2 }
end
end
def arithmetic_numbers
(1..).each.compact_map {|n|
arith, compo = n.arith_compo
if arith
{n, compo}
end
}
end
arithmetic_numbers.first(100).each_slice(20) do |row|
puts row.map {|n| "%3d" % n }.join(" ")
end
milestones = [1_000, 10_000, 100_000, 1_000_000]
ncompos = 0
arithmetic_numbers.each_with_index do |(n, compo), i|
ncompos += 1 if compo
if (i+1).in? milestones
puts "The #{i+1}th arithmetic number: #{n}"
puts " #{ncompos} composite numbers in the first #{i+1} arithmetic numbers."
end
break if i > milestones.last
end

88
Task/Arithmetic-numbers/Fortran/arithmetic-numbers.f Normal file
View file

@ -0,0 +1,88 @@
!
! Arithmetic numbers
! tested with Intel ifx (IFX) 2025.2.1 20250806 on Kubuntu 25.04
! GNU Fortran (Ubuntu 14.2.0-19ubuntu2) 14.2.0 on Kubuntu 25.04
! VSI Fortran x86-64 V8.6-001 on OpenVMS x86_64 V9.2-3
! No Non-standard features used, should compile on any fairly recent Fortran.
! straight copy of the algorithm presented in the C solution
! U.B., September 2025
program ArithmeticNumbers
implicit none
integer :: arithmetic_count=0, composite_count = 0
integer :: divisor_count, divisor_sum
integer :: n=0
do while (arithmetic_count .le. 1000000)
n = n + 1
call divisor_count_and_sum (n)
if (mod (divisor_sum, divisor_count) .ne. 0) then
cycle
end if
arithmetic_count = arithmetic_count + 1;
if (divisor_count .gt. 2) &
composite_count = composite_count + 1
if (arithmetic_count .le. 100) then
write (*, '(I3,X)', advance='no') n
if (mod (arithmetic_count, 10) .eq. 0) &
write (*,*)
end if
if (arithmetic_count .eq. 1000 .or. arithmetic_count .eq. 10000 .or. &
arithmetic_count .eq. 100000 .or. arithmetic_count .eq. 1000000) then
write (*,'(/i0, "th arithmetic number is ", I0 )') arithmetic_count, n
write (*,'("Number of composite arithmetic numbers <= ", i0, ": ", i0)' ) &
n, composite_count
endif
end do
contains
subroutine divisor_count_and_sum (arg_n)
integer, intent(in) :: arg_n
integer :: n
integer :: power
integer :: p, count, sum
n = arg_n ! need to modify n.
divisor_count = 1
divisor_sum = 1
power = 2
do while (iand (n,1) .eq. 0)
divisor_count = divisor_count + 1
divisor_sum = divisor_sum + power
power = power * 2
n = n / 2
end do
p = 3
do while (p*p .le. n)
count = 1
sum = 1
power = p
do while (mod(n,p) .eq. 0)
count = count + 1
sum = sum + power
power = power * p
n = n / p
end do
divisor_count = divisor_count*count
divisor_sum = divisor_sum *sum
p = p + 2
end do
if (n .gt. 1) then
divisor_count = divisor_count * 2
divisor_sum = divisor_sum * (n + 1)
end if
end subroutine divisor_count_and_sum
end program

31
Task/Arithmetic-numbers/Haskell/arithmetic-numbers.hs Normal file
View file

@ -0,0 +1,31 @@
import Data.Numbers.Primes
import Data.List
import Text.Printf
import Data.List.Split
import Control.Monad
isArithCompo :: Int -> (Bool, Bool)
isArithCompo n = (mod sumFs numFs == 0, numFs > 2)
where
pks = map (\xs -> (head xs, length xs)) $ group $ primeFactors n
sumFs = product [div (pred $ p ^ succ k) (pred p) | (p,k) <- pks]
numFs = product $ map (succ . snd) pks
task1 :: [Int]
task1 = take 100 [i | i <- [1 ..], fst $ isArithCompo i]
task23 :: [(Int, Int, Int)]
task23 = map sub [10^3,10^4,10^5,10^6]
where
sub cnt = (cnt, fst $ ics !! pred cnt, length $ filter snd $ take cnt ics)
ics = [(i, c) | i <- [1 ..], let (a, c) = isArithCompo i, a]
main :: IO ()
main = do
forM_ (chunksOf 10 $ map (printf "%4d") task1) (\as -> sequence_ as >> putChar '\n')
putChar '\n'
forM_ task23 (\(i,a,c) -> do
printf "%dth arithmetic number is %d\n" i a
printf "Number of composite arithmetic numbers <= %d: %d\n\n" a c
)

50
Task/Arithmetic-numbers/JavaScript/arithmetic-numbers.js Normal file
View file

@ -0,0 +1,50 @@
// Arithmetic numbers
var n = 1;
var arithmCnt = 0;
var composCnt = 0;
var outStr = new String();
console.log("The first 100 arithmetic numbers are:");
while (arithmCnt < 1000001) {
let dv = 1;
let dvCnt = 0;
let sum = 0;
while (true) {
quot = Math.floor(n / dv);
if (quot < dv)
break;
if (quot == dv && n % dv == 0) {
// n is a square
sum += quot;
dvCnt++;
break;
}
if (n % dv == 0) {
sum += dv + quot;
dvCnt += 2;
}
dv++;
}
if (sum % dvCnt == 0) {
// n is arithmetic
arithmCnt++;
if (arithmCnt <= 100) {
outStr += n.toString().padStart(4, ' ');
if (arithmCnt % 10 == 0) {
console.log(outStr);
outStr = "";
}
}
if (dvCnt > 2)
composCnt++;
if (arithmCnt == 1000 || arithmCnt == 10000 || arithmCnt == 100000 || arithmCnt == 1000000) {
console.log(outStr);
outStr = "The " + arithmCnt.toString().padStart(7, ' ') +
"th arithmetic number is " + n.toString().padStart(8, ' ') +
" up to which " + composCnt.toString().padStart(6, ' ') +
" are composite.";
}
}
n++;
}
console.log(outStr);

50
Task/Arithmetic-numbers/PHP/arithmetic-numbers.php Normal file
View file

@ -0,0 +1,50 @@
<?php
// Arithmetic numbers
$n = 1;
$arithm_cnt = 0;
$comp_cnt = 0;
echo 'The first 100 arithmetic numbers are:'.PHP_EOL;
while ($arithm_cnt < 1000001) {
$dv = 1;
$dv_cnt = 0;
$sum = 0;
while (true) {
$quot = intdiv($n, $dv);
if ($quot < $dv)
break;
if ($quot == $dv && $n % $dv == 0) {
// $n is a square
$sum += $quot;
$dv_cnt++;
break;
}
if ($n % $dv == 0) {
$sum += $dv + $quot;
$dv_cnt += 2;
}
$dv++;
}
if ($sum % $dv_cnt == 0) {
// $n is arithmetic
$arithm_cnt++;
if ($arithm_cnt <= 100) {
echo str_pad($n, 4, ' ', STR_PAD_LEFT);
if ($arithm_cnt % 10 == 0)
echo PHP_EOL;
}
if ($dv_cnt > 2)
$comp_cnt++;
if ($arithm_cnt == 1000 || $arithm_cnt == 10000 ||
$arithm_cnt == 100000 || $arithm_cnt == 1000000) {
echo PHP_EOL;
echo 'The '.str_pad($arithm_cnt, 7, ' ', STR_PAD_LEFT).
'th arithmetic number is '.
str_pad($n, 8, ' ', STR_PAD_LEFT) .
' up to which ', str_pad($comp_cnt, 6, ' ', STR_PAD_LEFT).
' are composite.';
}
}
$n++;
}
echo PHP_EOL;
?>

51
Task/Arithmetic-numbers/PL-I/arithmetic-numbers.pli Normal file
View file

@ -0,0 +1,51 @@
/* Arithmetic numbers */
arithm_nums:
procedure options(main);
declare
(n, arithm_cnt, comp_cnt) fixed binary(15),
(dv, dv_cnt, sum, quot) fixed binary(15);
n = 1;
arithm_cnt = 0;
comp_cnt = 0;
put list('The first 100 arithmetic numbers are:');
put skip;
do while (arithm_cnt < 1001);
dv = 1;
dv_cnt = 0;
sum = 0;
do while ('1'b);
quot = n / dv;
if quot < dv then
goto done;
if quot = dv & mod(n, dv) = 0 then do; /* n is a square */
sum = sum + quot;
dv_cnt = dv_cnt + 1;
goto done;
end;
if mod(n, dv) = 0 then do;
sum = sum + dv + quot;
dv_cnt = dv_cnt + 2;
end;
dv = dv + 1;
end;
done:
if mod(sum, dv_cnt) = 0 then do; /* n is arithmetic */
arithm_cnt = arithm_cnt + 1;
if arithm_cnt <= 100 then do;
put edit(n)(f(4));
if mod(arithm_cnt, 10) = 0 then
put skip;
end;
if dv_cnt > 2 then
comp_cnt = comp_cnt + 1;
if arithm_cnt = 1000 then do;
put skip edit('The ', arithm_cnt, 'th arithmetic number is ',
n, ' up to which ', comp_cnt, ' are composite.')
(a, f(4), a, f(4), a, f(3), a);
put skip;
end;
end;
n = n + 1;
end;
end;

66
Task/Arithmetic-numbers/Pascal-P/arithmetic-numbers.pas Normal file
View file

@ -0,0 +1,66 @@
program arithmnums(output);
(* Arithmetic numbers *)
var
n, arithmcnt, compcnt: integer;
dv, dvcnt, sum, quot: integer;
isdone: boolean;
begin
n := 1;
arithmcnt := 0;
compcnt := 0;
writeln('The first 100 arithmetic numbers are:');
while arithmcnt < 10001 do
(* in the case of 16-bit integers set condition arithmcnt < 1001 *)
begin
dv := 1;
dvcnt := 0;
sum := 0;
isdone := false;
while not isdone do
begin
quot := n div dv;
if quot < dv then
isdone := true
else
begin
if (quot = dv) and (n mod dv = 0) then
begin (* n is a square *)
sum := sum + quot;
dvcnt := dvcnt + 1;
isdone := true;
end
else
begin
if n mod dv = 0 then
begin
sum := sum + dv + quot;
dvcnt := dvcnt + 2;
end;
dv := dv + 1;
end;
end;
end;
if sum mod dvcnt = 0 then
begin (* n is arithmetic *)
arithmcnt := arithmcnt + 1;
if arithmcnt <= 100 then
begin
write(n: 4);
if arithmcnt mod 10 = 0 then
writeln;
end;
if dvcnt > 2 then
compcnt := compcnt + 1;
if (arithmcnt = 1000) or (arithmcnt = 10000) then
begin
writeln;
write('The ', arithmcnt: 5, 'th arithmetic number is ',
n: 5, ' up to which ', compcnt: 5, ' are composite.');
end;
end;
n := n + 1;
end;
writeln;
(* readln; *)
end.

49
Task/Arithmetic-numbers/PascalABC.NET/arithmetic-numbers.pas Normal file
View file

@ -0,0 +1,49 @@
function Factors(n: integer): set of integer;
begin
Result := SetOf(1, n);
var i := 2;
while True do
begin
var j := n div i;
if j < i then
break;
if i * j = n then
Result += SetOf(i,j);
i += 1;
end;
end;
begin
var arithmeticCount := 0;
var compositeCount := 0;
var n := 1;
while arithmeticCount <= 1000000 do
begin
var f := Factors(n);
var avg := f.Average;
if frac(avg) = 0 then
begin
arithmeticCount += 1;
if f.Count > 2 then
compositeCount += 1;
if arithmeticCount <= 100 then
begin
Print($'{n,3} ');
if arithmeticCount mod 10 = 0 then
Println;
end;
if arithmeticCount in [1000, 10000, 100000, 1000000] then
begin
Println(NewLine + $'{arithmeticCount}th arithmetic number is {n}');
Println($'Number of composite arithmetic numbers <= {n}: {compositeCount}');
end;
end;
n += 1;
end;
end.

34
Task/Arithmetic-numbers/Pluto/arithmetic-numbers.pluto Normal file
View file

@ -0,0 +1,34 @@
local int = require "int"
local fmt = require "fmt"
require "table2"
local arithmetic = {1}
local primes = {}
local limit = 1e6
local n = 3
while #arithmetic < limit do
local divs = int.divisors(n)
if #divs == 2 then
primes:insert(n)
arithmetic:insert(n)
else
local mean = divs:mean()
if mean % 1 == 0 then arithmetic:insert(n) end
end
n += 1
end
print("The first 100 arithmetic numbers are:")
fmt.tprint("%3d", arithmetic:slice(1, 100), 10)
for {1e3, 1e4, 1e5, 1e6} as x do
local last = arithmetic[x]
fmt.print("\nThe %,sth arithmetic number is: %,s", x, last)
local pcount = primes:findindex(|p| -> p >= last, 1, true)
if !pcount then
pcount = #primes
elseif !int.isprime(last) then
pcount -= 1;
end
local comp = x - pcount - 1 -- 1 is not composite
fmt.print("The count of such numbers <= %,s which are composite is %,s.", last, comp)
end

44
Task/Arithmetic-numbers/QuickBASIC/arithmetic-numbers.basic Normal file
View file

@ -0,0 +1,44 @@
' Arithmetic numbers
DIM N AS LONG, ArithmCnt AS LONG, ComposCnt AS LONG
DIM Dv AS LONG, DvCnt AS LONG, Sum AS LONG, Quot AS LONG
N = 1
ArithmCnt = 0
ComposCnt = 0
PRINT "The first 100 arithmetic numbers are:"
DO WHILE ArithmCnt < 1000001
Dv = 1
DvCnt = 0
Sum = 0
DO
Quot = N \ Dv
IF Quot < Dv THEN EXIT DO
IF Quot = Dv AND N MOD Dv = 0 THEN ' N is a square
Sum = Sum + Quot
DvCnt = DvCnt + 1
EXIT DO
END IF
IF N MOD Dv = 0 THEN
Sum = Sum + Dv + Quot
DvCnt = DvCnt + 2
END IF
Dv = Dv + 1
LOOP
IF Sum MOD DvCnt = 0 THEN ' N is arithmetic
ArithmCnt = ArithmCnt + 1
IF ArithmCnt <= 100 THEN
PRINT USING "####"; N;
IF ArithmCnt MOD 10 = 0 THEN PRINT
END IF
IF DvCnt > 2 THEN ComposCnt = ComposCnt + 1
IF ArithmCnt = 1000 OR ArithmCnt = 10000 OR ArithmCnt = 100000 OR ArithmCnt = 1000000 THEN
PRINT
PRINT USING "The #######th arithmetic number is ########"; ArithmCnt; N;
PRINT USING " up to which ######"; ComposCnt;
PRINT " are composite.";
END IF
END IF
N = N + 1
LOOP
PRINT
END

10
Task/Arithmetic-numbers/Uiua/arithmetic-numbers.uiua Normal file
View file

@ -0,0 +1,10 @@
Lim ← 20000
Primes ← ▽⊸≡(=⊣⊸(°/×))+2⇡Lim
Divisors ← ▽⤚(=₀◿)⊸(↘1⇡) # Divisors < n
AllDivisors ← ˜⊂⟜Divisors
▽⊸≡(=⊸⌊÷⊃⧻/+AllDivisors)+1⇡Lim
Comps ← -1/+≡(¬∊Primes)
⊃(&p$"Comps in first 10000: _"Comps↙10000
| &p$"10000th: _"⊡9999
| &p$"Comps in first 1000: _"Comps↙1000
| &p$"1000th: _"⊡999 | &p$"First 100: _"↙100)

46
Task/Arithmetic-numbers/VBScript/arithmetic-numbers.vbs Normal file
View file

@ -0,0 +1,46 @@
'arithmetic numbers
'run with CScript
function isarit_compo(i)
cnt=0
sum=0
for j=1 to sqr(i)
if (i mod j)=0 then
k=i\j
if k=j then
cnt=cnt+1:sum=sum+j
else
cnt=cnt+2:sum=sum+j+k
end if
end if
next
avg= sum/cnt
isarit_compo= array((fix(avg)=avg),-(cnt>2))
end function
function rpad(a,n) rpad=right(space(n)&a,n) :end function
dim s1
sub print(s)
s1=s1& rpad(s,4)
if len(s1)=40 then wscript.stdout.writeline s1:s1=""
end sub
'main program
cntr=0
cntcompo=0
i=1
wscript.stdout.writeline "the first 100 arithmetic numbers are:"
do
a=isarit_compo(i)
if a(0) then
cntcompo=cntcompo+a(1)
cntr=cntr+1
if cntr<=100 then print i
if cntr=1000 then wscript.stdout.writeline vbcrlf&"1000th : "&rpad(i,6) & " nr composites " &rpad(cntcompo,6)
if cntr=10000 then wscript.stdout.writeline vbcrlf& "10000th : "&rpad(i,6) & " nr composites " &rpad(cntcompo,6)
if cntr=100000 then wscript.stdout.writeline vbcrlf &"100000th : "&rpad(i,6) & " nr composites " &rpad(cntcompo,6):exit do
end if
i=i+1
loop