Data commit

Task/Weird-numbers/XPL0/weird-numbers.xpl0

@@ -0,0 +1,99 @@
+def SizeOfInt = 4;
+def \IntA\ Ptr, Size;
+int  Array(2);
+
+func Divisors(N);               \Returns a list of proper divisors for N
+int  N;
+int  Divs, Divs2, Out;
+int  I, J, C1, C2;
+[C1:= 0;  C2:= 0;
+Divs:=  MAlloc(N * SizeOfInt / 2);
+Divs2:= MAlloc(N * SizeOfInt / 2);
+Divs(C1):= 1;  C1:= C1+1;
+I:= 2;
+while I*I <= N do
+    [if rem(N/I) = 0 then
+        [J:= N/I;
+        Divs(C1):= I;  C1:= C1+1;
+        if I # J then
+            [Divs2(C2):= J;  C2:= C2+1];
+        ];
+    I:= I+1;
+    ];
+Out:= MAlloc((C1+C2) * SizeOfInt);
+for I:= 0 to C2-1 do
+    Out(I):= Divs2(I);
+for I:= 0 to C1-1 do
+    Out(C2+I):= Divs(C1-I-1);
+Array(Ptr):= Out;
+Array(Size):= C1 + C2;
+Release(Divs);
+Release(Divs2);
+return Array;
+];
+
+func Abundant(N, Divs);         \Returns 'true' if N is abundant
+int  N, Divs;
+int  Sum, I;
+[Sum:= 0;
+for I:= 0 to Divs(Size)-1 do
+    Sum:= Sum + Divs(Ptr,I);
+return Sum > N;
+];
+
+func Semiperfect(N, Divs);      \Returns 'true' if N is semiperfect
+int  N, Divs;
+int  H, T, TA(2);
+[if Divs(Size) > 0 then
+    [H:= Divs(Ptr,0);
+     T:= Divs(Ptr)+SizeOfInt;
+    TA(Ptr):= T;
+    TA(Size):= Divs(Size)-1;
+    if N < H then
+         return Semiperfect(N, TA)
+    else return N = H or Semiperfect(N-H, TA) or Semiperfect(N, TA);
+    ]
+else    return false;
+];
+
+func Sieve(Limit);              \Return array of weird number indexes set 'false'
+int  Limit;                     \i.e. non-abundant and non-semiperfect
+int  W, Divs(2), I, J;
+[W:= MAlloc(Limit * SizeOfInt);
+for I:= 0 to Limit-1 do W(I):= 0;       \for safety
+I:= 2;
+while I < Limit do
+    [if W(I) = 0 then
+        [Divs:= Divisors(I);
+        if not Abundant(I, Divs) then
+            W(I):= true
+        else if Semiperfect(I, Divs) then
+            [J:= I;
+            while J < Limit do
+                [W(J):= true;
+                J:= J+I;
+                ];
+            ];
+        ];
+    I:= I+2;
+    ];
+Release(Divs(Ptr));
+return W;
+];
+
+int W, Count, Max, N;
+[W:= Sieve(17000);
+Count:= 0;
+Max:= 25;
+Text(0, "The first 25 weird numbers:^m^j");
+N:= 2;
+while Count < Max do
+    [if not W(N) then
+        [IntOut(0, N);  ChOut(0, ^ );
+        Count:= Count+1;
+        ];
+    N:= N+2;
+    ];
+CrLf(0);
+Release(W);
+]