June 2018 Update

Task/Left-factorials/00DESCRIPTION

@@ -1,3 +1,5 @@
+<!-- Left Factorial !-->
+
 '''Left factorials''', &nbsp; <big><big>!n</big></big>, &nbsp; may refer to either &nbsp; ''subfactorials'' &nbsp; or to &nbsp; ''factorial sums'';
 <br>the same notation can be confusingly seen used for the two different definitions.
 

Task/Left-factorials/Factor/left-factorials.factor

@@ -0,0 +1,26 @@
+USING: formatting fry io kernel math math.factorials
+math.functions math.parser math.ranges sequences ;
+IN: rosetta-code.left-factorials
+
+: left-factorial ( n -- m ) iota [ n! ] map-sum ;
+
+: print-left-factorials ( seq quot -- )
+    '[
+        dup left-factorial @
+        [ number>string "!" prepend ] dip
+        "%6s   %-6d\n" printf
+    ] each nl ; inline
+
+: digit-count ( n -- count ) log10 floor >integer 1 + ;
+
+: part1 ( -- ) 11 iota [ ] print-left-factorials ;
+
+: part2 ( -- ) 20 110 10 <range> [ ] print-left-factorials ;
+
+: part3 ( -- ) "Number of digits for" print
+    1,000 10,000 1,000 <range>
+    [ digit-count ] print-left-factorials ;
+
+: main ( -- ) part1 part2 part3 ;
+
+MAIN: main

Task/Left-factorials/Forth/left-factorials.fth

@@ -0,0 +1,48 @@
+36000 CONSTANT #DIGITS  \ Enough for !10000
+CREATE S #DIGITS ALLOT  S #DIGITS ERASE  VARIABLE S#
+CREATE F #DIGITS ALLOT  F #DIGITS ERASE  VARIABLE F#
+1 F C!  1 F# !  \ F = 1 = 0!
+
+\ "Bignums": represented by two cells on the stack:
+\ 1) An address pointing to the least-significant unit
+\ 2) An integer size representing the number of character-size units
+: mod/   /mod swap ;
+: B+ ( addr u addr' u' -- u'')  \ Add the second "bignum" into the first
+   over + >R  -rot over + >R ( addr' addr R:end' R:end)
+   swap >R 0 over R>  ( addr 0 addr addr' R:end' R:end)
+   \ 0: Assume second has equal or more digits, as in our problem
+   BEGIN over R@ < WHILE  \ 1: add all digits from S
+     dup >R C@ swap dup >R C@ ( addr c a a' R:end' R:end R:addr'* R:addr*)
+     + +  10 mod/ R@ C!  R> 1+ R> 1+
+   REPEAT R> drop  ( addr c addr* addr'* R:end')
+   BEGIN dup R@ < WHILE   \ 2: add any remaining digits from F
+     dup >R C@ swap >R        ( addr c a' R:end' R:addr'* R:addr*)
+     +    10 mod/ R@ C!  R> 1+ R> 1+
+   REPEAT R> drop drop  ( addr c addr*)
+   BEGIN over WHILE       \ 3: add any carry digits
+     >R 10 mod/ ( addr m d R:addr*) R@ C! R> 1+
+   REPEAT  rot - nip ;  \ calculate travel distance, discard 0 carry
+: B* ( addr u u' -- u'')  \ Multiply "bignum" inplace by U'
+   0 2swap over >R dup >R bounds  ( u' 0 addr+u addr R:addr R:u)
+   DO ( u' c) over I C@ * +  10 mod/ I C! LOOP
+   nip R> BEGIN ( c u) over WHILE  \ insert carry, may have multiple digits
+     >R  10 mod/  R@ swap R> R@ + ( m u d addr+u R:addr) C!  1+
+   REPEAT  nip R> ( u'' addr) drop ;
+: .B ( addr u)  over +  BEGIN 1-  \ print bignum
+     dup C@ [char] 0 + EMIT  over over >=
+   UNTIL  drop drop ;
+: .!n   0 <# #s [char] ! hold #> 6 over - spaces type space ;
+: REPORT ( n)
+   dup 10 <=  over dup  20 111 within  swap 10 mod 0= and or
+   IF .!n [char] = emit space S S# @ .B cr
+   ELSE dup 1000 mod 0=
+     IF .!n ." has " S# @ . ." digits" cr
+     ELSE drop THEN
+   THEN ;
+: GO   0 REPORT
+   1 BEGIN dup 10000 <=
+   WHILE
+     S S# @  F F# @      B+ S# !
+     dup REPORT
+     dup     F F# @  rot B* F# !
+   1+ REPEAT  drop ;

Task/Left-factorials/Julia/left-factorials.julia

@@ -1,2 +1,4 @@
-leftfactorial(n::Integer) = n <= 0 ? zero(n) : sum(factorial, 0:n-1)
-@vectorize_1arg Integer leftfactorial
+leftfactorial(n::Integer) = n ≤ 0 ? zero(n) : sum(factorial, 0:n-1)
+
+@show leftfactorial.(0:10)
+@show ndigits.(leftfactorial.(big.(1000:1000:10_000)))

Task/Left-factorials/Ruby/left-factorials-1.rb

@@ -1,8 +1,7 @@
 left_fact = Enumerator.new do |y|
-  n, f, lf = 0, 1, 0
-  loop do
+  f, lf = 1, 0
+  1.step do |n|
     y  << lf #yield left_factorial
-    n  += 1
     lf += f
     f  *= n
   end

Task/Left-factorials/Ruby/left-factorials-2.rb

@@ -1,8 +1,12 @@
-left_fact = Enumerator.new do |y|
-  f, lf = 1, 0
-  1.step do |n|
-    y  << lf #yield left_factorial
-    lf += f
-    f  *= n
+tens = 20.step(110, 10)
+thousands = 1000.step(10_000, 1000)
+
+10001.times do |n|
+  lf = left_fact.next
+  case n
+  when 0..10, *tens
+    puts "!#{n} = #{lf}"
+  when *thousands
+    puts "!#{n} has #{lf.to_s.size} digits"
   end
 end

Task/Left-factorials/Standard-ML/left-factorials.ml

@@ -0,0 +1,29 @@
+(* reuse earlier factorial calculations in dfac, apply to listed arguments in cumlfac *)
+(* example: left factorial n, is #3 (dfac (0,n-1,1,1) ) *)
+(* output list contains (number, factorial, left factorial) *)
+(* tested in PolyML *)
+
+
+val store = ref 0;
+
+val rec dfac = fn
+        (from,to,acc,cm) => if from = to then (from,acc,cm) else (store:=(from+1)*acc;dfac (from+1,to,!store,!store+cm ) );
+
+val rec cumlfac = fn
+        (x::y::rm) => x :: cumlfac ( dfac (#1 x, #1 y, #2 x, #3 x) :: rm ) |
+        rm =>rm ;
+
+val arguments = List.tabulate (10,fn 0=>(0,1,1)|i=>(i,0,0)) @
+                List.tabulate (10,fn i=> (10*i+19,0,0) )    @
+                List.tabulate ( 10,fn i=> (1000*i+999,0,0));
+
+val result = (~1,0,0)::(cumlfac arguments);
+
+(* done *)
+(* display: *)
+
+List.app (fn triple :int*int*int =>
+        print(Int.toString (1+ #1 triple ) ^ " : " ^ Int.fmt StringCvt.DEC (#3 triple ) ^" \n" )
+        ) (List.take(result,21)  ) ;
+List.app (fn triple :int*int*int =>
+        print( Int.toString (1+ #1 triple ) ^ " : " ^ Int.toString  (size(Int.toString (#3 triple ))) ^" \n" ) ) (List.drop(result,21)  );