Data update

Task/Left-factorials/Ada/left-factorials.adb

@@ -0,0 +1,76 @@
+-- Rosetta Code Task written in Ada
+-- Left factorials
+-- https://rosettacode.org/wiki/Left_factorials
+-- (Mostly) translated from the AWK example
+-- February 2025, R. B. E.
+-- Using PragmARC.Unbounded_Numbers, GNAT version 14.2.0-3, MacOS 15.3, M1 chip
+
+with Ada.Text_IO; use Ada.Text_IO;
+with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
+with PragmARC.Unbounded_Numbers.Integers; use PragmARC.Unbounded_Numbers.Integers;
+
+procedure Left_Factorials is
+
+  function Left_Fact (F : Natural) return Unbounded_Integer is
+    Result : Unbounded_Integer := To_Unbounded_Integer (0);
+    Adder : Unbounded_Integer := To_Unbounded_Integer (1);
+  begin
+    if F = 0 then
+      return Result;
+    end if;
+    for K in 1..F loop
+      Result := Result + Adder;
+      Adder := Adder * To_Unbounded_Integer (K);
+    end loop;
+    return Result;
+  end Left_Fact;
+
+  function Brute_Force_Digit_String_Length (N : in Unbounded_Integer) return Natural is
+    Big_Zero : constant Unbounded_Integer := To_Unbounded_Integer (0);
+    Big_Ten : constant Unbounded_Integer := To_Unbounded_Integer (10);
+    Local_N : Unbounded_Integer := N;
+    String_Length : Natural := 0;
+  begin
+    loop
+      exit when Local_N = Big_Zero;
+      Local_N := Local_N / Big_Ten;
+      String_Length := String_Length + 1;
+    end loop;
+    return String_Length;
+  end Brute_Force_Digit_String_Length;
+
+begin
+  for I in 0..10 loop
+    Put ("!");
+    Put (I, 0);
+    Put (" = ");
+    Put (Image (Value => Left_Fact (I)));
+    New_Line;
+  end loop;
+  New_Line;
+  for I in 20..110 loop
+    if (I mod 10) = 0 then
+      Put ("!");
+      Put (I, 0);
+      Put (" =");
+      if I < 70 then
+        Put (" ");
+      else
+        New_Line;
+      end if;
+      Put (Image (Value => Left_Fact (I)));
+      New_Line;
+    end if;
+  end loop;
+  New_Line;
+  for I in 1_000..10_000 loop
+    if (I mod 1_000) = 0 then
+      Put ("!");
+      Put (I, 0);
+      Put (" has ");
+      Put (Brute_Force_Digit_String_Length (Left_Fact (I)), 0);
+      Put_Line (" digits.");
+    end if;
+  end loop;
+  New_Line;
+end Left_Factorials;

Task/Left-factorials/EasyLang/left-factorials.easy

@@ -0,0 +1,66 @@
+func[] bn s$ .
+   i = len s$ - 7 + 1
+   while i >= -5
+      r[] &= number substr s$ i 7
+      i -= 7
+   .
+   return r[]
+.
+func$ bns bn[] .
+   s$ = bn[$]
+   for i = len bn[] - 1 downto 1
+      h$ = bn[i]
+      s$ &= substr "0000000" 1 (7 - len h$) & h$
+   .
+   return s$
+.
+func[] bnmul a[] b[] .
+   len r[] len a[] + len b[]
+   if len a[] > len b[] : swap a[] b[]
+   for ia = 1 to len a[]
+      h = 0
+      for ib = 1 to len b[]
+         h += r[ia + ib - 1] + b[ib] * a[ia]
+         r[ia + ib - 1] = h mod 10000000
+         h = h div 10000000
+      .
+      r[ia + ib - 1] += h
+   .
+   while r[$] = 0 and len r[] > 1 : len r[] -1
+   return r[]
+.
+func[] bnadd a[] b[] .
+   if len b[] > len a[] : swap a[] b[]
+   len r[] len a[]
+   for i = 1 to len r[]
+      v = 0
+      if i <= len b[] : v = b[i]
+      h += a[i] + v
+      r[i] = h mod 10000000
+      h = h div 10000000
+   .
+   if h > 0 : r[] &= h
+   while len r[] > 1 and r[$] = 0 : len r[] -1
+   return r[]
+.
+#
+func[] left_factorial n .
+   if n = 0 : return [ 0 ]
+   fact[] = [ 1 ]
+   sum[] = fact[]
+   for i = 1 to n - 1
+      fact[] = bnmul fact[] [ i ]
+      sum[] = bnadd sum[] fact[]
+   .
+   return sum[]
+.
+for i = 0 to 110
+   if i < 10 or i mod 10 = 0
+      print "!" & i & " = " & bns left_factorial i
+   .
+.
+print ""
+for i = 1000 step 1000 to 10000
+   a$ = bns left_factorial i
+   print "!" & i & " has " & len a$ & " digits."
+.

Task/Left-factorials/FutureBasic/left-factorials.basic

@@ -0,0 +1,151 @@
+//
+// Subfactorials / "Left Factorials"
+//
+// Using FutureBasic 7.0.35
+//
+// September 2025, R.W.
+//
+
+include "GMP.incl"
+
+_MAXN = 10000   // supports init(10000)
+
+dim InitN as long
+dim lf_list( _MAXN ) as mpz_t //lf_list(k) holds k! for k = 0..InitN
+dim lf_psum( _MAXN ) as mpz_t //lf_psum(n) = 1! + 2! + ... + n!
+
+// ------------------------------
+// init vars
+// ------------------------------
+local fn InitLF( n as long )
+  long i
+
+  if n < 0 then n = 0
+  if n > _MAXN then n = _MAXN
+  InitN = n
+
+  // Initialize all mpz_t slots we'll use
+  for i = 0 to n
+    fn mpz_init( lf_list(i) )
+    fn mpz_init( lf_psum(i) )
+  next
+
+  // lf_list(0) = 0! = 1
+  fn mpz_set_ui( lf_list(0), 1 )
+  fn mpz_set_ui( lf_psum(0), 1 )
+
+  // Build up factorials iteratively:
+  // lf_list(k) = k! for k = 1..n
+  // f will carry the running factorial value
+  mpz_t f
+  fn mpz_init_set_ui( f, 1 )
+  for i = 1 to n
+    fn mpz_mul_ui( f, f, i )      // f *= i
+    fn mpz_set( lf_list(i), f )   // lf_list(i) = f
+    fn mpz_add( lf_psum(i), lf_psum(i-1), lf_list(i) )
+  next
+  fn mpz_clear( f )
+end fn
+
+// Sum of 1! + 2! + ... + n!
+//
+local fn LF_Sum( n as long, sum_out as mpz_t )
+  if n <= 0
+    fn mpz_set_ui( sum_out, 0 )
+    exit fn
+  end if
+  if n > InitN then n = InitN
+  fn mpz_set( sum_out, lf_psum(n-1) )
+end fn
+
+// Number of base-10 digits in the LF sum
+
+// Exact base-10 digit count for !n (sum of 0!..(n-1)!)
+
+local fn LF_NumDigitsBase10_Exact( n as long ) as long
+  mpz_t s, p10
+  long d
+  fn mpz_init( s )
+  fn LF_Sum( n, s )
+
+  // mpz_sizeinbase(x, 10) in GMP is not guaranteed exact for bases
+  // that are not powers of two. The manual notes it may return a
+  // value that’s “either exact or one too big.” Ch 5, page 45.
+  // Because of this we need to add an extra guard, basically use
+  // mpz_sizeinbase as an upper bound d, then compare the number
+  // against 10^(d-1). If the value is smaller, subtract 1 to
+  // yield the exact count.
+
+  d = fn mpz_sizeinbase( s, 10 )       // may be exact or 1 too big for base 10
+
+  if d > 0
+    fn mpz_init( p10 )
+    fn mpz_ui_pow_ui( p10, 10, d-1 )    // p10 = 10^(d-1)
+    if fn mpz_cmp( s, p10 ) < 0
+      d = d - 1
+    end if
+    fn mpz_clear( p10 )
+  end if
+  fn mpz_clear( s )
+end fn = d
+
+// Cleanup
+
+local fn CleanupLF
+  long i
+  for i = 0 to InitN
+    fn mpz_clear( lf_list(i) )
+    fn mpz_clear( lf_psum(i) )
+  next
+end fn
+
+// ----------------------------------
+// Subfactorials / Left Factorials
+// ----------------------------------
+local fn Main
+  long i, d
+  mpz_t s
+  // start the clock
+  CFTimeInterval t
+  t = fn CACurrentMediaTime
+
+  fn InitLF( 10000 )
+
+  // Factorial 0..10
+  fn mpz_init( s )
+  for i = 0 to 10
+    fn LF_Sum( i, s )
+    print @"!"; i; @" = ";
+    print @fn mpz_cf2(s)
+  next
+
+  // Factorial 20..110 step 10
+
+  for i = 20 to 110 step 10
+    fn LF_Sum( i, s )
+    print @"!"; i; @" = ";
+    print @fn mpz_cf2(s)
+  next
+
+  // Number of digits from 1,000..10,000 step 1000
+
+  for i = 1000 to 10000 step 1000
+    d = fn LF_NumDigitsBase10_Exact( i )
+    print @"!"; i; " contains "; d; " digits"
+  next
+
+  fn mpz_clear( s )
+
+  printf @"\nCompute time: %.3f ms", (fn CACurrentMediaTime-t)*1000
+  handleEvents
+
+  fn CleanupLF
+end fn
+
+window 1,@"Left Factorials",(0,0,980,500)
+
+fn Main
+
+handleEvents
+
+//

Task/Left-factorials/PowerShell/left-factorials.ps1

@@ -0,0 +1,26 @@
+function left-factorial ([BigInt]$n) {
+    [BigInt]$k, [BigInt]$fact = ([BigInt]::Zero), ([BigInt]::One)
+    [BigInt]$lfact = ([BigInt]::Zero)
+    while($k -lt $n){
+        if($k -gt ([BigInt]::Zero)) {
+            $fact = [BigInt]::Multiply($fact, $k)
+            $lfact = [BigInt]::Add($lfact, $fact)
+        } else {
+            $lfact = ([BigInt]::One)
+        }
+        $k = [BigInt]::Add($k, [BigInt]::One)
+    }
+    $lfact
+}
+0..9 | foreach{
+    "!$_ = $(left-factorial $_)"
+}
+for($i = 10; $i -le 110; $i += 10) {
+    "!$i = $(left-factorial $i)"
+}
+for($i = 1000; $i -le 10000; $i += 1000) {
+    $digits = [BigInt]::Log10($(left-factorial $i))
+    $digits = [Math]::Floor($digits) + 1
+    if($digits -gt 1) {"!$i has $digits digits"}
+    else {"!$i has $digits digit"}
+}