Data update

Task/Arithmetic-derivative/ABC/arithmetic-derivative.abc

@@ -0,0 +1,15 @@
+HOW TO RETURN lagarias n:
+    SELECT:
+        n<0: RETURN -lagarias -n
+        n in {0;1}: RETURN 0
+        NO d IN {2..floor root n} HAS n mod d=0: RETURN 1
+        ELSE: RETURN ((n/d) * lagarias d) + (d * lagarias (n/d))
+
+PUT 0 IN col
+FOR n IN {-99..100}:
+    WRITE (lagarias n)>>6
+    PUT col+1 IN col
+    IF col mod 10 = 0: WRITE/
+
+FOR m IN {1..20}:
+    WRITE "D(10^`m>>2`) = `(lagarias (10**m))/7`"/

Task/Arithmetic-derivative/ALGOL-68/arithmetic-derivative-2.alg

@@ -0,0 +1,12 @@
+FOR n FROM -99 TO 100 DO
+    INT l := 0, f := 3, z := ABS n;
+    WHILE z >= 2 DO
+        WHILE z MOD 2 = 0 DO     l +:= n OVER 2; z OVERAB 2 OD;
+        IF f <= z THEN
+            WHILE z MOD f = 0 DO l +:= n OVER f; z OVERAB f OD;
+            f +:= 2
+        FI
+    OD;
+    print( ( whole( l, -8 ) ) );
+    IF ( n + 100 ) MOD 10 = 0 THEN print( ( newline ) ) FI
+OD

Task/Arithmetic-derivative/APL/arithmetic-derivative.apl

@@ -0,0 +1,7 @@
+lagarias←{
+   ⍵<0:-∇-⍵
+   ⍵∊0 1:0
+   0=d←⊃1+⍸0=(1↓⍳⌊⍵*÷2)|⍵:1
+   (n×∇d)+d×∇n←⍵÷d
+}
+lagarias¨ 20 10⍴¯100+⍳200

Task/Arithmetic-derivative/Action-/arithmetic-derivative.action

@@ -0,0 +1,15 @@
+PROC Main()
+  INT n, f, l, z
+  FOR n = -99 TO 100 DO
+    l = 0  f = 3  IF n < 0 THEN z = - n ELSE z = n FI
+    WHILE z >= 2 DO
+      WHILE z MOD 2 = 0 DO l ==+ n / 2     z ==/ 2 OD
+      IF f <= z THEN
+        WHILE z MOD f = 0 DO l ==+ n / f   z ==/ f OD
+        f ==+ 2
+      FI
+    OD
+    PrintF( "%8I", l )
+    IF ( n + 100 ) MOD 10 = 0 THEN PutE() FI
+  OD
+RETURN

Task/Arithmetic-derivative/Ada/arithmetic-derivative.ada

@@ -0,0 +1,55 @@
+with Ada.Text_IO; use Ada.Text_IO;
+with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
+with Ada.Numerics.Big_Numbers.Big_Integers; use Ada.Numerics.Big_Numbers.Big_Integers;
+
+procedure Arithmetic_Derivative is
+
+	function D (N : Big_Integer) return Big_Integer is
+		Inc : Constant array (1 .. 8) of Big_Integer := (4, 2, 4, 2, 4, 6, 2, 6);
+		I : Integer := 1;
+		Num : Big_Integer := N;
+		P : Big_Integer := 2;
+		PCount : Big_Integer;
+		Result : Big_Integer := 0;
+	begin
+		if N < 0 then return -D(-N); end if;
+		if N = 0 or N = 1 then return 0; end if;
+
+		while P <= N / 2 loop
+			if Num mod P = 0 then
+				PCount := 0;
+				while Num mod P = 0 loop
+					Num := Num / P;
+					PCount := PCount + 1;
+				end loop;
+				Result := Result + (PCount * N) / P;
+			end if;
+			if Num = 1 then exit; end if;
+			if P >= 7 then
+				P := P + Inc(I);
+				I := (I mod 8) + 1;
+			end if;
+			if P = 3 or P = 5 then P := P + 2; end if;
+			if P = 2 then P := P + 1; end if;
+		end loop;
+		
+		if Num > 1 then return 1; end if;
+
+		return result;
+	end D;
+
+	P : Big_Integer;
+
+begin
+	for I in Integer range -99 .. 100 loop
+		P := To_Big_Integer(I);
+		Put(To_String(Arg => D(P), Width => 5));
+		if I mod 10 = 0 then New_Line; end if;
+	end loop;
+
+	for I in Integer range 1 .. 20 loop
+		P := 10 ** I;
+		Put("D(10^"); Put(Item => I, Width => 2); Put(") / 7 = ");
+		Put(Big_Integer'Image(D(P) / 7)); New_Line;
+	end loop;
+end Arithmetic_Derivative;

Task/Arithmetic-derivative/BASIC/arithmetic-derivative.basic

@@ -0,0 +1,12 @@
+10 DEFINT A-Z
+20 FOR N=-99 TO 100
+30 GOSUB 100: PRINT USING "########";L;
+40 NEXT
+50 END
+100 L=0: F=3: Z=ABS(N)
+110 IF Z<2 THEN RETURN
+120 IF Z MOD 2=0 THEN L=L+N\2: Z=Z\2: GOTO 120
+130 IF F>Z THEN RETURN
+140 IF Z MOD F=0 THEN L=L+N\F: Z=Z\F: GOTO 140
+150 F=F+2
+160 GOTO 130

Task/Arithmetic-derivative/CLU/arithmetic-derivative.clu

@@ -0,0 +1,44 @@
+factors = iter (n: bigint) yields (bigint)
+    own zero: bigint := bigint$i2bi(0)
+    own two: bigint := bigint$i2bi(2)
+    own three: bigint := bigint$i2bi(3)
+
+    while n>zero cand n//two = zero do yield(two) n := n/two end
+
+    fac: bigint := three
+    while fac<=n do
+        while n//fac = zero do yield(fac) n := n/fac end
+        fac := fac + two
+    end
+end factors
+
+lagarias = proc (n: bigint) returns (bigint)
+    own zero: bigint := bigint$i2bi(0)
+    if n < zero then return(-lagarias(-n)) end
+
+    sum: bigint := zero
+    for fac: bigint in factors(n) do
+        sum := sum + n / fac
+    end
+    return(sum)
+end lagarias
+
+start_up = proc ()
+    own po: stream := stream$primary_output()
+    own seven: bigint := bigint$i2bi(7)
+    own ten: bigint := bigint$i2bi(10)
+
+    for n: int in int$from_to(-99, 100) do
+        stream$putright(po, bigint$unparse(lagarias(bigint$i2bi(n))), 7)
+        if (n + 100)//10 = 0 then stream$putl(po, "") end
+    end
+
+    for m: int in int$from_to(1, 20) do
+        d: bigint := lagarias(ten ** bigint$i2bi(m)) / seven
+        stream$puts(po, "D(10^")
+        stream$putright(po, int$unparse(m), 2)
+        stream$puts(po, ") / 7 = ")
+        stream$putright(po, bigint$unparse(d), 25)
+        stream$putl(po, "")
+    end
+end start_up

Task/Arithmetic-derivative/Cowgol/arithmetic-derivative.cowgol

@@ -0,0 +1,43 @@
+include "cowgol.coh";
+
+sub abs(n: int32): (r: uint32) is
+    if n<0 then
+        r := (-n) as uint32;
+    else
+        r := n as uint32;
+    end if;
+end sub;
+
+sub printcol(n: int32, s: uint8) is
+    var buf: uint8[12];
+    var ptr := IToA(n, 10, &buf[0]);
+    s := s - (ptr - &buf[0]) as uint8;
+    while s>0 loop
+        print_char(' ');
+        s := s-1;
+    end loop;
+    print(&buf[0]);
+end sub;
+
+sub lagarias(n: int32): (r: int32) is
+    var nn := abs(n);
+    r := 0;
+    if nn<2 then return; end if;
+    var f: uint32 := 2;
+    while f<=nn loop
+        while nn%f == 0 loop
+            r := r + n/f as int32;
+            nn := nn/f;
+        end loop;
+        f := f+1;
+    end loop;
+end sub;
+
+var i: int32 := -99;
+var c: uint8 := 0;
+while i <= 100 loop
+    printcol(lagarias(i), 7);
+    i := i+1;
+    c := c+1;
+    if c%10 == 0 then print_nl(); end if;
+end loop;

Task/Arithmetic-derivative/Draco/arithmetic-derivative.draco

@@ -0,0 +1,32 @@
+proc lagarias(int n) int:
+    int f, r, s;
+    if n<0 then
+        -lagarias(-n)
+    elif n<2 then
+        0
+    else
+        s := 0;
+        r := n;
+        while r % 2 = 0 do
+            r := r / 2;
+            s := s + n / 2
+        od;
+        f := 3;
+        while f <= r do
+            while r % f = 0 do
+                r := r / f;
+                s := s + n / f
+            od;
+            f := f + 2
+        od;
+        s
+    fi
+corp
+
+proc main() void:
+    int n;
+    for n from -99 upto 100 do
+        write(lagarias(n):7);
+        if (n+100) % 10=0 then writeln() fi
+    od
+corp

Task/Arithmetic-derivative/FreeBASIC/arithmetic-derivative.basic

@@ -0,0 +1,46 @@
+Function aDerivative(Byval n As Longint) As Longint
+    If n < 0 Then Return -aDerivative(-n)
+    If n = 0 Or n = 1 Then Return 0
+    If n = 2 Then Return 1
+
+    Dim As Longint q, d = 2
+    Dim As Longint result = 1
+
+    While d * d <= n
+        If n Mod d = 0 Then
+            q = n \ d
+            result = q * aDerivative(d) + d * aDerivative(q)
+            Exit While
+        End If
+        d += 1
+    Wend
+
+    Return result
+End Function
+
+'Main program
+Print "Arithmetic derivatives for -99 through 100:"
+
+Dim As Integer col, n
+col = 0
+For n = -99 To 100
+    col += 1
+    Print Using "####"; aDerivative(n);
+    If col = 10 Then
+        Print
+        col = 0
+    Else
+        Print " ";
+    End If
+Next
+
+'Stretch task
+Print !"\n\nPowers of 10 derivatives divided by 7:"
+Dim As Double m = 1
+For n = 1 To 18 ' LongInt limit in FreeBASIC
+    m *= 10
+    Dim As Longint a = aDerivative(Clngint(m))
+    Print Using "D(10^&) / 7 = &"; n; a \ 7
+Next
+
+Sleep

Task/Arithmetic-derivative/FutureBasic/arithmetic-derivative.basic

@@ -0,0 +1,30 @@
+// Arithmetic Derivative
+//  https://rosettacode.org/wiki/Arithmetic_derivative#
+
+local fn DoIt( N as short) as short
+  short L,F,Z
+  L = 0: F = 3: Z = ABS(N)
+  IF Z<2 THEN exit fn
+
+  1 IF Z MOD 2 = 0 THEN L=L+N\2: Z=Z\2: GOTO 1
+  2  IF F>Z THEN exit fn
+  3 IF Z MOD F = 0 THEN L=L+N\F: Z=Z\F: GOTO 2
+
+  F=F+2
+  goto 1
+
+end fn = L
+
+_Window = 1
+
+window _Window,@"Arithmetic Derivative",fn cgrectmake(0,0,640,400)
+windowcenter(_Window)
+
+short N,L,LineCount
+FOR N = -99 TO 100
+L = fn DoIt(N): PRINT USING "########";L;
+LineCount ++
+if LineCount = 10 then print : LineCount = 0
+NEXT
+
+handleevents

Task/Arithmetic-derivative/MAD/arithmetic-derivative.mad

@@ -0,0 +1,42 @@
+            NORMAL MODE IS INTEGER
+
+            INTERNAL FUNCTION(X,Y)
+            ENTRY TO REM.
+            FUNCTION RETURN X-(X/Y)*Y
+            END OF FUNCTION
+
+            INTERNAL FUNCTION(N)
+            ENTRY TO DERIV.
+            R = N
+            WHENEVER R.L.0, R = -R
+            WHENEVER R.L.2, FUNCTION RETURN 0
+            S = 0
+FAC2        WHENEVER REM.(R,2).E.0
+                S = S + N/2
+                R = R/2
+                TRANSFER TO FAC2
+            END OF CONDITIONAL
+            THROUGH FAC, FOR F=3, 2, F.G.R
+FACF        WHENEVER REM.(R,F).E.0
+                S = S + N/F
+                R = R/F
+                TRANSFER TO FACF
+            END OF CONDITIONAL
+FAC         CONTINUE
+            FUNCTION RETURN S
+            END OF FUNCTION
+
+            VECTOR VALUES LINEF = $10(I6)*$
+            DIMENSION LINE(10)
+            C = 0
+            THROUGH ITEM, FOR I=-99, 1, I.G.100
+            LINE(C) = DERIV.(I)
+            C = C+1
+            WHENEVER C.E.10
+                PRINT FORMAT LINEF,
+          0           LINE(0),LINE(1),LINE(2),LINE(3),LINE(4),
+          1           LINE(5),LINE(6),LINE(7),LINE(8),LINE(9)
+                C = 0
+            END OF CONDITIONAL
+ITEM        CONTINUE
+            END OF PROGRAM

Task/Arithmetic-derivative/MiniScript/arithmetic-derivative.mini

@@ -37,7 +37,7 @@ for n in range( -99, 100 )
     end if
 end for
 print()
-for n in range( 1, 17 )    // 18, 19 and 20 would overflow ????? TODO: check
+for n in range( 1, 17 )
     m = 10 ^ n
     print( "D(" + str(m) + ") / 7 = " + str( floor (lagarias (m) / 7) ) )
 end for

Task/Arithmetic-derivative/Miranda/arithmetic-derivative.miranda

@@ -0,0 +1,24 @@
+main :: [sys_message]
+main = [Stdout (table 10 7 (map (show . lagarias) [-99..100])),
+        Stdout (lay (map ten_pow_m_div_7 [1..20]))]
+
+ten_pow_m_div_7 :: num->[char]
+ten_pow_m_div_7 m = "D(10^" ++ rjustify 2 (show m) ++ ") / 7 = " ++
+                    show (lagarias (10^m) div 7)
+
+table :: num->num->[[char]]->[char]
+table w cw ls = lay [concat (map (rjustify cw) l) | l <- group w ls]
+
+group :: num->[*]->[[*]]
+group n [] = []
+group n ls = take n ls : group n (drop n ls)
+
+lagarias :: num->num
+lagarias n = -lagarias (-n), if n<0
+           = sum [n div f | f <- factors n], otherwise
+
+factors :: num->[num]
+factors n = f n 2
+            where f n d = [], if d > n
+                        = d : f (n div d) d, if n mod d = 0
+                        = f n (d+1), otherwise

Task/Arithmetic-derivative/PL-I/arithmetic-derivative.pli

@@ -0,0 +1,27 @@
+arithmeticDerivative: procedure options(main);
+    lagarias: procedure(n) returns(fixed);
+        declare (n, res, fac, rem) fixed;
+        rem = abs(n);
+        if rem<2 then return(0);
+
+        res = 0;
+        do while(mod(rem,2) = 0);
+            res = res + n/2;
+            rem = rem/2;
+        end;
+
+        do fac=3 repeat(fac+2) while(fac<=rem);
+            do while(mod(rem,fac) = 0);
+                res = res + n/fac;
+                rem = rem/fac;
+            end;
+        end;
+        return(res);
+    end lagarias;
+
+    declare n fixed;
+    do n=-99 to 100;
+        put edit(lagarias(n)) (F(7));
+        if mod(n+100, 10)=0 then put skip;
+    end;
+end arithmeticDerivative;

Task/Arithmetic-derivative/PL-M/arithmetic-derivative.plm

@@ -0,0 +1,66 @@
+100H: /* ARITHMETIC DERIVATIVE - BASED ON THE BASIC SAMPLE                   */
+
+   /* RETURNS TRUE IF A < B, FALSE OTHERWISE WITH A AND B TREATED AS SIGNED  */
+   SIGNED$LT: PROCEDURE( A, B )BYTE;
+      DECLARE ( A, B ) ADDRESS;
+      IF ( A + 32768 ) < ( B + 32768 ) THEN RETURN 0FFH; ELSE RETURN 0;
+   END SIGNED$LT ;
+
+   /* RETURNS A / B WITH A AND B TREATED AS SIGNED                           */
+   SIGNED$DIV: PROCEDURE( AIN, BIN )ADDRESS;
+      DECLARE ( AIN, BIN )ADDRESS;
+      DECLARE ( A, B, SIGN )ADDRESS;
+      SIGN = 1;
+      A    = AIN;
+      B    = BIN;
+      IF SIGNED$LT( A, 0 ) THEN DO;
+          SIGN = - SIGN;
+          A    = - A;
+      END;
+      IF SIGNED$LT( B, 0 ) THEN DO;
+          SIGN = - SIGN;
+          B    = - B;
+      END;
+   RETURN ( A / B ) * SIGN;
+   END SIGNED$DIV ;
+
+   /* CP/M BDOS SYSTEM CALL AND I/O ROUTINES                                 */
+   BDOS: PROCEDURE( FN, ARG ); DECLARE FN BYTE, ARG ADDRESS; GOTO 5; END;
+   PR$CHAR:   PROCEDURE( C ); DECLARE C BYTE;    CALL BDOS( 2, C );  END;
+   PR$STRING: PROCEDURE( S ); DECLARE S ADDRESS; CALL BDOS( 9, S );  END;
+   PR$NL:     PROCEDURE;   CALL PR$CHAR( 0DH ); CALL PR$CHAR( 0AH ); END;
+
+   PR$SIGNED$NUMBER: PROCEDURE( N ); /* PRINTS A SIGNED NUMBER               */
+      DECLARE N ADDRESS;
+      DECLARE V ADDRESS, N$STR ( 9 )BYTE, W BYTE;
+      IF SIGNED$LT( N, 0 ) THEN V = - N; ELSE V = N;
+      DO W = 0 TO LAST( N$STR ); N$STR( W ) = ' '; END;
+      W = LAST( N$STR );
+      N$STR( W ) = '$';
+      N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
+      DO WHILE( ( V := V / 10 ) > 0 );
+         N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
+      END;
+      IF SIGNED$LT( N, 0 ) THEN N$STR( W := W - 1 ) = '-';
+      CALL PR$STRING( .N$STR );
+   END PR$SIGNED$NUMBER;
+
+   /* TASK                                                                   */
+
+   DECLARE ( C, N, L, F, Z ) ADDRESS;
+
+   DO C = 1 TO 200;
+      N = C - 100;
+      L = 0; F = 3; IF SIGNED$LT( N, 0 ) THEN Z = - N; ELSE Z = N;
+      DO WHILE Z >= 2;
+         DO WHILE Z MOD 2 = 0;    L = L + SIGNED$DIV( N, 2 ); Z = Z / 2; END;
+         IF F <= Z THEN DO;
+            DO WHILE Z MOD F = 0; L = L + SIGNED$DIV( N, F ); Z = Z / F; END;
+            F = F + 2;
+         END;
+      END;
+      CALL PR$SIGNED$NUMBER( L );
+      IF C MOD 10 = 0 THEN CALL PR$NL;
+   END;
+
+EOF

Task/Arithmetic-derivative/Refal/arithmetic-derivative.refal

@@ -0,0 +1,32 @@
+$ENTRY Go {
+    = <Table 10 7 <Each (Lagarias) <Iota ('-'99) 100>>>
+};
+
+Lagarias {
+    '-' e.N = '-' <Lagarias e.N>;
+    0 = 0;
+    1 = 0;
+    e.N, <Fac e.N>: {
+        e.N = 1;
+        e.F, <Div (e.N) e.F>: e.R =
+            <Add <Mul (e.R) <Lagarias e.F>>
+                 <Mul (e.F) <Lagarias e.R>>>;
+    };
+};
+
+Fac {
+    (e.F) e.N, <Mul (e.N) e.N>: e.N2,
+               <Compare (e.F) e.N2>: '+' = e.N;
+    (e.F) e.N, <Mod (e.N) e.F>: 0 = e.F;
+    (e.F) e.N = <Fac (<Add (1) e.F>) e.N>;
+    e.N = <Fac (2) e.N>;
+};
+
+Table { s.C s.W e.L = <Each (Prout) <Each (Line s.W) <Group s.C e.L>>>; };
+Line { s.W e.X = <Join <Each (Fmt s.W) e.X>>; };
+Fmt { s.W e.X, <Last s.W <Rep s.W ' '> <Symb e.X>>: (e.Z) e.C = e.C; };
+Rep { 0 s.C = ; s.N s.C = s.C <Rep <Sub s.N 1> s.C>; };
+Join { = ; (e.X) e.Y = e.X <Join e.Y>; };
+Group { s.N = ; s.N e.X, <First s.N e.X>: (e.G) e.R = (e.G) <Group s.N e.R>; };
+Each { (e.F) = ; (e.F) (e.X) e.XS = (<Mu e.F e.X>) <Each (e.F) e.XS>; };
+Iota { (e.E) e.E = (e.E); (e.S) e.E = (e.S) <Iota (<Add (1) e.S>) e.E>; };

Task/Arithmetic-derivative/SETL/arithmetic-derivative.setl

@@ -0,0 +1,25 @@
+program arithmetic_derivative;
+    loop for n in [-99..100] do
+        nprint(lpad(str lagarias(n), 6));
+        if (col +:= 1) mod 10 = 0 then
+            print;
+        end if;
+    end loop;
+
+    loop for m in [1..20] do
+        nprint("D(10^" + lpad(str m, 2) + ") / 7 = ");
+        print(lagarias(10**m) div 7);
+    end loop;
+
+    proc lagarias(n);
+        return if n<0 then
+            -lagarias(-n)
+        elseif n in {0,1} then
+            0
+        elseif forall d in {2..floor sqrt n} | n mod d /= 0 then
+            1
+        else
+            (n div d)*lagarias(d) + d*lagarias(n div d)
+        end;
+    end proc;
+end program;

Task/Arithmetic-derivative/Sidef/arithmetic-derivative-1.sidef

@@ -0,0 +1,9 @@
+say "Arithmetic derivative for n in range [-99, 100]:"
+-99 .. 100 -> map { .arithmetic_derivative }.each_slice(10, {|*a|
+    a.map { '%4s' % _ }.join(' ').say
+})
+
+say "\nArithmetic derivative D(10^n)/7 for n in range [1, 20]:"
+for n in (1..20) {
+    say "D(10^#{n})/7 = #{arithmetic_derivative(10**n) / 7}"
+}

Task/Arithmetic-derivative/Sidef/arithmetic-derivative-2.sidef

@@ -0,0 +1,26 @@
+subset Integer  < Number   { .is_int   }
+subset Positive < Integer  { .is_pos   }
+subset Negative < Integer  { .is_neg   }
+subset Prime    < Positive { .is_prime }
+
+func arithmetic_derivative((0)) { 0 }
+func arithmetic_derivative((1)) { 0 }
+
+func arithmetic_derivative(Prime _) { 1 }
+
+func arithmetic_derivative(Negative n) {
+    -arithmetic_derivative(-n)
+}
+
+func arithmetic_derivative(Positive n) is cached {
+
+    var a = n.factor.rand
+    var b = n/a
+
+    arithmetic_derivative(a)*b + a*arithmetic_derivative(b)
+}
+
+func arithmetic_derivative(Number n) {
+    var (a, b) = n.nude
+    (arithmetic_derivative(a)*b - arithmetic_derivative(b)*a) / b**2
+}