Factorions: Difference between revisions

From Rosetta Code
Content added Content deleted
(Added Arturo implementation)
No edit summary
Line 1,624: Line 1,624:
The factorions for base 12 are:
The factorions for base 12 are:
1 2</pre>
1 2</pre>

=={{header|Vlang}}==
{{trans|Go}}
<lang vlang>import strconv

fn main() {
// cache factorials from 0 to 11
mut fact := [12]u64{}
fact[0] = 1
for n := u64(1); n < 12; n++ {
fact[n] = fact[n-1] * n
}
for b := 9; b <= 12; b++ {
println("The factorions for base $b are:")
for i := u64(1); i < 1500000; i++ {
digits := strconv.format_uint(i, b)
mut sum := u64(0)
for digit in digits {
if digit < `a` {
sum += fact[digit-`0`]
} else {
sum += fact[digit+10-`a`]
}
}
if sum == i {
print("$i ")
}
}
println("\n")
}
}</lang>

{{out}}
<pre>
The factorions for base 9 are:
1 2 41282

The factorions for base 10 are:
1 2 145 40585

The factorions for base 11 are:
1 2 26 48 40472

The factorions for base 12 are:
1 2
</pre>


=={{header|Wren}}==
=={{header|Wren}}==

Revision as of 12:55, 10 June 2022

Task
Factorions
You are encouraged to solve this task according to the task description, using any language you may know.


Definition

A factorion is a natural number that equals the sum of the factorials of its digits.


Example

145   is a factorion in base 10 because:

          1! + 4! + 5!   =   1 + 24 + 120   =   145 


It can be shown (see talk page) that no factorion in base 10 can exceed   1,499,999.


Task

Write a program in your language to demonstrate, by calculating and printing out the factorions, that:

  •   There are   3   factorions in base   9
  •   There are   4   factorions in base 10
  •   There are   5   factorions in base 11
  •   There are   2   factorions in base 12     (up to the same upper bound as for base 10)


See also



11l

Translation of: Python

<lang 11l>V fact = [1] L(n) 1..11

  fact.append(fact[n-1] * n)

L(b) 9..12

  print(‘The factorions for base ’b‘ are:’)
  L(i) 1..1'499'999
     V fact_sum = 0
     V j = i
     L j > 0
        V d = j % b
        fact_sum += fact[d]
        j I/= b
     I fact_sum == i
        print(i, end' ‘ ’)
  print("\n")</lang>
Output:
The factorions for base 9 are:
1 2 41282 

The factorions for base 10 are:
1 2 145 40585 

The factorions for base 11 are:
1 2 26 48 40472 

The factorions for base 12 are:
1 2 

360 Assembly

<lang 360asm>* Factorions 26/04/2020 FACTORIO CSECT

        USING  FACTORIO,R13       base register
        B      72(R15)            skip savearea
        DC     17F'0'             savearea
        SAVE   (14,12)            save previous context
        ST     R13,4(R15)         link backward
        ST     R15,8(R13)         link forward
        LR     R13,R15            set addressability
        XR     R4,R4              ~
        LA     R5,1               f=1
        LA     R3,FACT+4          @fact(1)
        LA     R6,1               i=1
      DO WHILE=(C,R6,LE,=A(NN2))  do i=1 to nn2
        MR     R4,R6                fact(i-1)*i
        ST     R5,0(R3)             fact(i)=fact(i-1)*i
        LA     R3,4(R3)             @fact(i+1)
        LA     R6,1(R6)             i++
      ENDDO    ,                  enddo i
        LA     R7,NN1             base=nn1
      DO WHILE=(C,R7,LE,=A(NN2))  do base=nn1 to nn2

MVC PG,PGX init buffer

        LA     R3,PG+6              @buffer
        XDECO  R7,XDEC              edit base
        MVC    PG+5(2),XDEC+10      output base
        LA     R3,PG+10             @buffer
        LA     R6,1                 i=1
      DO WHILE=(C,R6,LE,LIM)        do i=1 to lim 
        LA     R9,0                   s=0
        LR     R8,R6                  t=i
      DO WHILE=(C,R8,NE,=F'0')        while t<>0
        XR     R4,R4                    ~
        LR     R5,R8                    t 
        DR     R4,R7                    r5=t/base; r4=d=(t mod base)
        LR     R1,R4                    d
        SLA    R1,2                     ~
        L      R2,FACT(R1)              fact(d)
        AR     R9,R2                    s=s+fact(d)
        LR     R8,R5                    t=t/base
      ENDDO    ,                      endwhile
      IF    CR,R9,EQ,R6 THEN          if s=i then
        XDECO  R6,XDEC                  edit i
        MVC    0(6,R3),XDEC+6           output i
        LA     R3,7(R3)                 @buffer
      ENDIF    ,                      endif
        LA     R6,1(R6)               i++
      ENDDO    ,                    enddo i
        XPRNT  PG,L'PG              print buffer
        LA     R7,1(R7)             base++
      ENDDO    ,                  enddo base
        L      R13,4(0,R13)       restore previous savearea pointer
        RETURN (14,12),RC=0       restore registers from calling save

NN1 EQU 9 nn1=9 NN2 EQU 12 nn2=12 LIM DC f'1499999' lim=1499999 FACT DC (NN2+1)F'1' fact(0:12) PG DS CL80 buffer PGX DC CL80'Base .. : ' buffer init XDEC DS CL12 temp fo xdeco

        REGEQU
        END    FACTORIO </lang>
Output:
Base  9 :      1      2  41282
Base 10 :      1      2    145  40585
Base 11 :      1      2     26     48  40472
Base 12 :      1      2

ALGOL 68

Translation of: C

<lang algol68>BEGIN

   # cache factorials from 0 to 11 #
   [ 0 : 11 ]INT fact;
   fact[0] := 1;
   FOR n TO 11 DO
       fact[n] := fact[n-1] * n
   OD;
   FOR b FROM 9 TO 12 DO
       print( ( "The factorions for base ", whole( b, 0 ), " are:", newline ) );
       FOR i TO 1500000 - 1 DO
           INT sum := 0;
           INT j := i;
           WHILE j > 0 DO
               sum +:= fact[ j MOD b ];
               j OVERAB b
           OD;
           IF sum = i THEN print( ( whole( i, 0 ), " " ) ) FI
       OD;
       print( ( newline ) )
   OD

END</lang>

Output:
The factorions for base 9 are:
1 2 41282
The factorions for base 10 are:
1 2 145 40585
The factorions for base 11 are:
1 2 26 48 40472
The factorions for base 12 are:
1 2

Applesoft BASIC

<lang basic>100 DIM FACT(12) 110 FACT(0) = 1 120 FOR N = 1 TO 11 130 FACT(N) = FACT(N - 1) * N 140 NEXT 200 FOR B = 9 TO 12 210 PRINT "THE FACTORIONS "; 215 PRINT "FOR BASE "B" ARE:" 220 FOR I = 1 TO 1499999 230 SUM = 0 240 FOR J = I TO 0 STEP 0 245 M = INT (J / B) 250 D = J - M * B 260 SUM = SUM + FACT(D) 270 J = M 280 NEXT J 290 IF SU = I THEN PRINT I" "; 300 NEXT I 310 PRINT : PRINT 320 NEXT B</lang>

Arturo

<lang rebol>factorials: [1 1 2 6 24 120 720 5040 40320 362880 3628800 39916800]

factorion?: function [n, base][

   try? [
       n = sum map digits.base:base n 'x -> factorials\[x]
   ]
   else [
       print ["n:" n "base:" base]
       false
   ]

]

loop 9..12 'base ->

   print ["Base" base "factorions:" select 1..45000 'z -> factorion? z base]

]</lang>

Output:
Base 9 factorions: [1 2 41282] 
Base 10 factorions: [1 2 145 40585] 
Base 11 factorions: [1 2 26 48 40472] 
Base 12 factorions: [1 2]

AutoHotkey

Translation of: C

<lang AutoHotkey>fact:=[] fact[0] := 1 while (A_Index < 12) fact[A_Index] := fact[A_Index-1] * A_Index b := 9 while (b <= 12) { res .= "base " b " factorions: `t" while (A_Index < 1500000){ sum := 0 j := A_Index while (j > 0){ d := Mod(j, b) sum += fact[d] j /= b } if (sum = A_Index) res .= A_Index " " } b++ res .= "`n" } MsgBox % res return</lang>

Output:
base 9 factorions:  	1  2  41282  
base 10 factorions:  	1  2  145  40585  
base 11 factorions:  	1  2  26  48  40472  
base 12 factorions:  	1  2  

AWK

<lang AWK>

  1. syntax: GAWK -f FACTORIONS.AWK
  2. converted from C

BEGIN {

   fact[0] = 1 # cache factorials from 0 to 11
   for (n=1; n<12; ++n) {
     fact[n] = fact[n-1] * n
   }
   for (b=9; b<=12; ++b) {
     printf("base %d factorions:",b)
     for (i=1; i<1500000; ++i) {
       sum = 0
       j = i
       while (j > 0) {
         d = j % b
         sum += fact[d]
         j = int(j/b)
       }
       if (sum == i) {
         printf(" %d",i)
       }
     }
     printf("\n")
   }
   exit(0)

} </lang>

Output:
base 9 factorions: 1 2 41282
base 10 factorions: 1 2 145 40585
base 11 factorions: 1 2 26 48 40472
base 12 factorions: 1 2

C

Translation of: Go

<lang c>#include <stdio.h>

int main() {

   int n, b, d;
   unsigned long long i, j, sum, fact[12];
   // cache factorials from 0 to 11
   fact[0] = 1;
   for (n = 1; n < 12; ++n) {
       fact[n] = fact[n-1] * n;
   }
   for (b = 9; b <= 12; ++b) {
       printf("The factorions for base %d are:\n", b);
       for (i = 1; i < 1500000; ++i) {
           sum = 0;
           j = i;
           while (j > 0) {
               d = j % b;
               sum += fact[d];
               j /= b;
           }
           if (sum == i) printf("%llu ", i);
       }
       printf("\n\n");
   }
   return 0;

}</lang>

Output:
The factorions for base 9 are:
1 2 41282 

The factorions for base 10 are:
1 2 145 40585 

The factorions for base 11 are:
1 2 26 48 40472 

The factorions for base 12 are:
1 2 

C++

Translation of: C

<lang cpp>#include <iostream>

class factorion_t { public:

   factorion_t() {
       f[0] = 1u;
       for (uint n = 1u; n < 12u; n++)
           f[n] = f[n - 1] * n;
   }
   bool operator()(uint i, uint b) const {
       uint sum = 0;
       for (uint j = i; j > 0u; j /= b)
           sum += f[j % b];
       return sum == i;
   }

private:

   ulong f[12];  //< cache factorials from 0 to 11

};

int main() {

   factorion_t factorion;
   for (uint b = 9u; b <= 12u; ++b) {
       std::cout << "factorions for base " << b << ':';
       for (uint i = 1u; i < 1500000u; ++i)
           if (factorion(i, b))
               std::cout << ' ' << i;
       std::cout << std::endl;
   }
   return 0;

}</lang>

Output:
factorions for base 9: 1 2 41282
factorions for base 10: 1 2 145 40585
factorions for base 11: 1 2 26 48 40472
factorions for base 12: 1 2

Common Lisp

<lang lisp>(defparameter *bases* '(9 10 11 12)) (defparameter *limit* 1500000)

(defun ! (n) (apply #'* (loop for i from 2 to n collect i)))

(defparameter *digit-factorials* (mapcar #'! (loop for i from 0 to (1- (apply #'max *bases*)) collect i)))

(defun fact (n) (nth n *digit-factorials*))

(defun digit-value (digit)

 (let ((decimal (digit-char-p digit)))
   (cond ((not (null decimal)) decimal)
         ((char>= #\Z digit #\A) (+ (char-code digit) (- (char-code #\A)) 10))
         ((char>= #\z digit #\a) (+ (char-code digit) (- (char-code #\a)) 10))
         (t nil))))

(defun factorionp (n &optional (base 10))

 (= n (apply #'+
           (mapcar #'fact
                   (map 'list #'digit-value
                        (write-to-string n :base base))))))

(loop for base in *bases* do

 (let ((factorions
       (loop for i from 1 while (< i *limit*) if (factorionp i base) collect i)))
   (format t "In base ~a there are ~a factorions:~%" base (list-length factorions))
   (loop for n in factorions do
     (format t "~c~a" #\Tab (write-to-string n :base base))
     (if (/= base 10) (format t " (decimal ~a)" n))
     (format t "~%"))
   (format t "~%")))</lang>
Output:
In base 9 there are 3 factorions:
        1 (decimal 1)
        2 (decimal 2)
        62558 (decimal 41282)

In base 10 there are 4 factorions:
        1
        2
        145
        40585

In base 11 there are 5 factorions:
        1 (decimal 1)
        2 (decimal 2)
        24 (decimal 26)
        44 (decimal 48)
        28453 (decimal 40472)

In base 12 there are 2 factorions:
        1 (decimal 1)
        2 (decimal 2)


Delphi

Translation of: C

<lang Delphi> program Factorions;

{$APPTYPE CONSOLE}

uses

 System.SysUtils;

begin

 var fact: TArray<UInt64>;
 SetLength(fact, 12);
 fact[0] := 0;
 for var n := 1 to 11 do
   fact[n] := fact[n - 1] * n;
 for var b := 9 to 12 do
 begin
   writeln('The factorions for base ', b, ' are:');
   for var i := 1 to 1499999 do
   begin
     var sum := 0;
     var j := i;
     while j > 0 do
     begin
       var d := j mod b;
       sum := sum + fact[d];
       j := j div b;
     end;
     if sum = i then
       writeln(i, ' ');
   end;
   writeln(#10);
 end;
 readln;

end.</lang>

F#

<lang fsharp> // Factorians. Nigel Galloway: October 22nd., 2021 let N=[|let mutable n=1 in yield n; for g in 1..11 do n<-n*g; yield n|] let fG n g=let rec fN g=function i when i<n->g+N.[i] |i->fN(g+N.[i%n])(i/n) in fN 0 g {9..12}|>Seq.iter(fun n->printf $"In base %d{n} Factorians are:"; {1..1500000}|>Seq.iter(fun g->if g=fG n g then printf $" %d{g}"); printfn "") </lang>

Output:
In base 9 Factorians are: 1 2 41282
In base 10 Factorians are: 1 2 145 40585
In base 11 Factorians are: 1 2 26 48 40472
In base 12 Factorians are: 1 2

Factor

<lang factor>USING: formatting io kernel math math.parser math.ranges memoize prettyprint sequences ; IN: rosetta-code.factorions

! Memoize factorial function MEMO: factorial ( n -- n! ) [ 1 ] [ [1,b] product ] if-zero ;

factorion? ( n base -- ? )
   dupd >base string>digits [ factorial ] map-sum = ;
show-factorions ( limit base -- )
   dup "The factorions for base %d are:\n" printf
   [ [1,b) ] dip [ dupd factorion? [ pprint bl ] [ drop ] if ]
   curry each nl ;

1,500,000 9 12 [a,b] [ show-factorions nl ] with each</lang>

Output:
The factorions for base 9 are:
1 2 41282 

The factorions for base 10 are:
1 2 145 40585 

The factorions for base 11 are:
1 2 26 48 40472 

The factorions for base 12 are:
1 2 

Fōrmulæ

Fōrmulæ programs are not textual, visualization/edition of programs is done showing/manipulating structures but not text. Moreover, there can be multiple visual representations of the same program. Even though it is possible to have textual representation —i.e. XML, JSON— they are intended for storage and transfer purposes more than visualization and edition.

Programs in Fōrmulæ are created/edited online in its website, However they run on execution servers. By default remote servers are used, but they are limited in memory and processing power, since they are intended for demonstration and casual use. A local server can be downloaded and installed, it has no limitations (it runs in your own computer). Because of that, example programs can be fully visualized and edited, but some of them will not run if they require a moderate or heavy computation/memory resources, and no local server is being used.

In this page you can see the program(s) related to this task and their results.

FreeBASIC

<lang freebasic>Dim As Integer fact(12), suma, d, j fact(0) = 1 For n As Integer = 1 To 11

   fact(n) = fact(n-1) * n

Next n For b As Integer = 9 To 12

   Print "Los factoriones para base " & b & " son: "
   For i As Integer = 1 To 1499999
       suma = 0
       j = i
       While j > 0
           d = j Mod b
           suma += fact(d)
           j \= b
       Wend
       If suma = i Then Print i & " ";
   Next i
   Print : Print

Next b Sleep</lang>

Output:
Los factoriones para base 9 son:
1 2 41282

Los factoriones para base 10 son:
1 2 145 40585

Los factoriones para base 11 son:
1 2 26 48 40472

Los factoriones para base 12 son:
1 2

Frink

<lang frink>factorion[n, base] := sum[map["factorial", integerDigits[n, base]]]

for base = 9 to 12 {

  for n = 1 to 1_499_999
     if n == factorion[n, base]
        println["$base\t$n"]

}</lang>

Output:
9	1
9	2
9	41282
10	1
10	2
10	145
10	40585
11	1
11	2
11	26
11	48
11	40472
12	1
12	2

Go

<lang go>package main

import (

   "fmt"
   "strconv"

)

func main() {

   // cache factorials from 0 to 11
   var fact [12]uint64
   fact[0] = 1
   for n := uint64(1); n < 12; n++ {
       fact[n] = fact[n-1] * n
   }
   for b := 9; b <= 12; b++ {
       fmt.Printf("The factorions for base %d are:\n", b)
       for i := uint64(1); i < 1500000; i++ {
           digits := strconv.FormatUint(i, b)
           sum := uint64(0)
           for _, digit := range digits {
               if digit < 'a' {
                   sum += fact[digit-'0']
               } else {
                   sum += fact[digit+10-'a']
               }
           }
           if sum == i {
               fmt.Printf("%d ", i)
           }
       }
       fmt.Println("\n")
   }

}</lang>

Output:
The factorions for base 9 are:
1 2 41282 

The factorions for base 10 are:
1 2 145 40585 

The factorions for base 11 are:
1 2 26 48 40472 

The factorions for base 12 are:
1 2 

Haskell

<lang haskell>import Text.Printf (printf) import Data.List (unfoldr) import Control.Monad (guard)

factorion :: Int -> Int -> Bool factorion b n = f b n == n

where
 f b = sum . map (product . enumFromTo 1) . unfoldr (\x -> guard (x > 0) >> pure (x `mod` b, x `div` b))

main :: IO () main = mapM_ (uncurry (printf "Factorions for base %2d: %s\n") . (\(a, b) -> (b, result a b)))

 [(3,9), (4,10), (5,11), (2,12)]
where 
 factorions b = filter (factorion b) [1..]
 result n = show . take n . factorions</lang>
Output:
Factorions for base  9: [1,2,41282]
Factorions for base 10: [1,2,145,40585]
Factorions for base 11: [1,2,26,48,40472]
Factorions for base 12: [1,2]

J

<lang J>

  index=: $ #: I.@:,
  factorion=: 10&$: :(] = [: +/ [: ! #.^:_1)&>
  FACTORIONS=: 9 0 +"1 index Q=: 9 10 11 12 factorion/ i. 1500000
  NB. base, factorion expressed in bases 10, and base
  (,. ".@:((Num_j_,26}.Alpha_j_) {~ #.inv/)"1) FACTORIONS
9     1     1
9     2     2
9 41282 62558

10 1 1 10 2 2 10 145 145 10 40585 40585 11 1 1 11 2 2 11 26 24 11 48 44 11 40472 28453 12 1 1 12 2 2

  NB. tallies of factorions in the bases
  (9+i.4),.+/"1 Q
9 3

10 4 11 5 12 2 </lang>

Java

<lang java> public class Factorion {

   public static void main(String [] args){
       System.out.println("Base 9:");
       for(int i = 1; i <= 1499999; i++){
           String iStri = String.valueOf(i);
           int multiplied = operate(iStri,9);
           if(multiplied == i){
               System.out.print(i + "\t");
           }
       }
       System.out.println("\nBase 10:");
       for(int i = 1; i <= 1499999; i++){
           String iStri = String.valueOf(i);
           int multiplied = operate(iStri,10);
           if(multiplied == i){
               System.out.print(i + "\t");
           }
       }
       System.out.println("\nBase 11:");
       for(int i = 1; i <= 1499999; i++){
           String iStri = String.valueOf(i);
           int multiplied = operate(iStri,11);
           if(multiplied == i){
               System.out.print(i + "\t");
           }
       }
       System.out.println("\nBase 12:");
       for(int i = 1; i <= 1499999; i++){
           String iStri = String.valueOf(i);
           int multiplied = operate(iStri,12);
           if(multiplied == i){
               System.out.print(i + "\t");
           }
       }
   }
   public static int factorialRec(int n){
       int result = 1;
       return n == 0 ? result : result * n * factorialRec(n-1);
   }
   public static int operate(String s, int base){
       int sum = 0;
       String strx = fromDeci(base, Integer.parseInt(s));
       for(int i = 0; i < strx.length(); i++){
           if(strx.charAt(i) == 'A'){
               sum += factorialRec(10);
           }else if(strx.charAt(i) == 'B') {
               sum += factorialRec(11);
           }else if(strx.charAt(i) == 'C') {
               sum += factorialRec(12);
           }else {
               sum += factorialRec(Integer.parseInt(String.valueOf(strx.charAt(i)), base));
           }
       }
       return sum;
   }
   // Ln 57-71 from Geeks for Geeks @ https://www.geeksforgeeks.org/convert-base-decimal-vice-versa/
   static char reVal(int num) {
       if (num >= 0 && num <= 9)
           return (char)(num + 48);
       else
           return (char)(num - 10 + 65);
   }
   static String fromDeci(int base, int num){
       StringBuilder s = new StringBuilder();
       while (num > 0) {
           s.append(reVal(num % base));
           num /= base;
       }
       return new String(new StringBuilder(s).reverse());
   }

} </lang>

Output:
Base 9:
1	2	41282	
Base 10:
1	2	145	40585	
Base 11:
1	2	26	48	40472	
Base 12:
1	2	

Julia

<lang julia>isfactorian(n, base) = mapreduce(factorial, +, map(c -> parse(Int, c, base=16), split(string(n, base=base), ""))) == n

printallfactorian(base) = println("Factorians for base $base: ", [n for n in 1:100000 if isfactorian(n, base)])

foreach(printallfactorian, 9:12)

</lang>

Output:
Factorians for base 9: [1, 2, 41282]
Factorians for base 10: [1, 2, 145, 40585]
Factorians for base 11: [1, 2, 26, 48, 40472]
Factorians for base 12: [1, 2]

Mathematica / Wolfram Language

<lang Mathematica>ClearAll[FactorionQ] FactorionQ[n_,b_:10]:=Total[IntegerDigits[n,b]!]==n Select[Range[1500000],FactorionQ[#,9]&] Select[Range[1500000],FactorionQ[#,10]&] Select[Range[1500000],FactorionQ[#,11]&] Select[Range[1500000],FactorionQ[#,12]&]</lang>

Output:
{1, 2, 41282}
{1, 2, 145, 40585}
{1, 2, 26, 48, 40472}
{1, 2}

Nim

Note that the library has precomputed the values of factorial, so there is no need for caching. <lang Nim>from math import fac from strutils import join

iterator digits(n, base: Natural): Natural =

 ## Yield the digits of "n" in base "base".
 var n = n
 while true:
   yield n mod base
   n = n div base
   if n == 0: break

func isFactorion(n, base: Natural): bool =

 ## Return true if "n" is a factorion for base "base".
 var s = 0
 for d in n.digits(base):
   inc s, fac(d)
 result = s == n

func factorions(base, limit: Natural): seq[Natural] =

 ## Return the list of factorions for base "base" up to "limit".
 for n in 1..limit:
   if n.isFactorion(base):
     result.add(n)


for base in 9..12:

 echo "Factorions for base ", base, ':'
 echo factorions(base, 1_500_000 - 1).join(" ")</lang>
Output:
Factorions for base 9:
1 2 41282
Factorions for base 10:
1 2 145 40585
Factorions for base 11:
1 2 26 48 40472
Factorions for base 12:
1 2

OCaml

Translation of: C

<lang ocaml>let () =

 (* cache factorials from 0 to 11 *)
 let fact = Array.make 12 0 in
 fact.(0) <- 1;
 for n = 1 to pred 12 do
   fact.(n) <- fact.(n-1) * n;
 done;
 for b = 9 to 12 do
   Printf.printf "The factorions for base %d are:\n" b;
   for i = 1 to pred 1_500_000 do
     let sum = ref 0 in
     let j = ref i in
     while !j > 0 do
       let d = !j mod b in
       sum := !sum + fact.(d);
       j := !j / b;
     done;
     if !sum = i then (print_int i; print_string " ")
   done;
   print_string "\n\n";
 done</lang>

Pascal

modified munchhausen numbers#Pascal. output in base and 0! == 1!, so in Base 10 40585 has the same digits as 14558. <lang pascal>program munchhausennumber; {$IFDEF FPC}{$MODE objFPC}{$Optimization,On,all}{$ELSE}{$APPTYPE CONSOLE}{$ENDIF} uses

 sysutils;

type

 tdigit  = byte;

const

 MAXBASE = 17;

var

 DgtPotDgt : array[0..MAXBASE-1] of NativeUint;
 dgtCnt : array[0..MAXBASE-1] of NativeInt;
 cnt: NativeUint;

function convertToString(n:NativeUint;base:byte):AnsiString; const

 cBASEDIGITS = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvxyz';

var

 r,dgt: NativeUint;

begin

 IF base > length(cBASEDIGITS) then
   EXIT('Base to big');
 result := ;
 repeat
   r := n div base;
   dgt := n-r*base;
   result := cBASEDIGITS[dgt+1]+result;
   n := r;
 until n =0;

end;

function CheckSameDigits(n1,n2,base:NativeUInt):boolean; var

 i : NativeUInt;

Begin

 fillchar(dgtCnt,SizeOf(dgtCnt),#0);
 repeat
   //increment digit of n1
   i := n1;n1 := n1 div base;i := i-n1*base;inc(dgtCnt[i]);
   //decrement digit of n2
   i := n2;n2 := n2 div base;i := i-n2*base;dec(dgtCnt[i]);
 until (n1=0) AND (n2= 0);
 result := true;
 For i := 2 to Base-1 do
   result := result AND (dgtCnt[i]=0);
 result := result AND (dgtCnt[0]+dgtCnt[1]=0);

end;

procedure Munch(number,DgtPowSum,minDigit:NativeUInt;digits,base:NativeInt); var

 i: NativeUint;
 s1,s2: AnsiString;

begin

 inc(cnt);
 number := number*base;
 IF digits > 1 then
 Begin
   For i := minDigit to base-1 do
     Munch(number+i,DgtPowSum+DgtPotDgt[i],i,digits-1,base);
 end
 else
   For i := minDigit to base-1 do
     //number is always the arrangement of the digits leading to smallest number
     IF (number+i)<= (DgtPowSum+DgtPotDgt[i]) then
       IF CheckSameDigits(number+i,DgtPowSum+DgtPotDgt[i],base) then
         iF number+i>0 then
         begin
           s1 := convertToString(DgtPowSum+DgtPotDgt[i],base);
           s2 := convertToString(number+i,base);
           If length(s1)= length(s2) then
             writeln(Format('%*d %*s  %*s',[Base-1,DgtPowSum+DgtPotDgt[i],Base-1,s1,Base-1,s2]));
         end;

end;

//factorions procedure InitDgtPotDgt(base:byte); var

 i: NativeUint;

Begin

 DgtPotDgt[0]:= 1;
 For i := 1 to Base-1 do
   DgtPotDgt[i] := DgtPotDgt[i-1]*i;
 DgtPotDgt[0]:= 0;

end; { //Munchhausen numbers procedure InitDgtPotDgt; var

 i,k,dgtpow: NativeUint;

Begin

 // digit ^ digit ,special case 0^0 here 0
 DgtPotDgt[0]:= 0;
 For i := 1 to Base-1 do
 Begin
   dgtpow := i;
   For k := 2 to i do
     dgtpow := dgtpow*i;
   DgtPotDgt[i] := dgtpow;
 end;

end; } var

 base : byte;

begin

 cnt := 0;
 For base := 2 to MAXBASE do
 begin
   writeln('Base = ',base);
   InitDgtPotDgt(base);
   Munch(0,0,0,base,base);
 end;
 writeln('Check Count ',cnt);

end.</lang>

Output:
TIO.RUN Real time: 45.701 s User time: 44.968 s Sys. time: 0.055 s CPU share: 98.51 %
Base = 2
1 1  1
Base = 3
 1  1   1
 2  2   2
Base = 4
  1   1    1
  2   2    2
  7  13   13
Base = 5
   1    1     1
   2    2     2
  49  144   144
Base = 6
    1     1      1
    2     2      2
   25    41     14
   26    42     24
Base = 7
     1      1       1
     2      2       2
Base = 8
      1       1        1
      2       2        2
Base = 9
       1        1         1
       2        2         2
   41282    62558     25568
Base = 10
        1         1          1
        2         2          2
      145       145        145
    40585     40585      14558
Base = 11
         1          1           1
         2          2           2
        26         24          24
        48         44          44
     40472      28453       23458
Base = 12
          1           1            1
          2           2            2
Base = 13
           1            1             1
           2            2             2
   519326767     83790C5B      135789BC
Base = 14
            1             1              1
            2             2              2
  12973363226     8B0DD409C      11489BCDD
Base = 15
             1              1               1
             2              2               2
          1441            661             166
          1442            662             266
Base = 16
              1               1                1
              2               2                2
  2615428934649     260F3B66BF9      1236669BBFF
Base = 17
               1                1                 1
               2                2                 2
           40465             8405              1458
  43153254185213     146F2G8500G4      111244568FGG
  43153254226251     146F2G8586G4      124456688FGG
Check Count 1571990934

Perl

Raku version

Translation of: Raku
Library: ntheory

<lang perl>use strict; use warnings; use ntheory qw/factorial todigits/;

my $limit = 1500000;

for my $b (9 .. 12) {

   print "Factorions in base $b:\n";
   $_ == factorial($_) and print "$_ " for 0..$b-1;
   for my $i (1 .. int $limit/$b) {
       my $sum;
       my $prod = $i * $b;
       for (reverse todigits($i, $b)) {
           $sum += factorial($_);
           $sum = 0 && last if $sum > $prod;
       }
       next if $sum == 0;
       ($sum + factorial($_) == $prod + $_) and print $prod+$_ . ' ' for 0..$b-1;
   }
   print "\n\n";

}</lang>

Output:
Factorions in base 9:
1 2 41282

Factorions in base 10:
1 2 145 40585

Factorions in base 11:
1 2 26 48 40472

Factorions in base 12:
1 2

Sidef version

Alternatively, a more efficient approach:

Translation of: Sidef
Library: ntheory

<lang perl>use 5.020; use ntheory qw(:all); use experimental qw(signatures); use Algorithm::Combinatorics qw(combinations_with_repetition);

sub max_power ($base = 10) {

   my $m = 1;
   my $f = factorial($base - 1);
   while ($m * $f >= $base**($m-1)) {
       $m += 1;
   }
   return $m-1;

}

sub factorions ($base = 10) {

   my @result;
   my @digits    = (0 .. $base-1);
   my @factorial = map { factorial($_) } @digits;
   foreach my $k (1 .. max_power($base)) {
       my $iter = combinations_with_repetition(\@digits, $k);
       while (my $comb = $iter->next) {
           my $n = vecsum(map { $factorial[$_] } @$comb);
           if (join(' ', sort { $a <=> $b } todigits($n, $base)) eq join(' ', @$comb)) {
               push @result, $n;
           }
       }
   }
   return @result;

}

foreach my $base (2 .. 14) {

   my @r = factorions($base);
   say "Factorions in base $base are (@r)";

}</lang>

Output:
Factorions in base 2 are (1 2)
Factorions in base 3 are (1 2)
Factorions in base 4 are (1 2 7)
Factorions in base 5 are (1 2 49)
Factorions in base 6 are (1 2 25 26)
Factorions in base 7 are (1 2)
Factorions in base 8 are (1 2)
Factorions in base 9 are (1 2 41282)
Factorions in base 10 are (1 2 145 40585)
Factorions in base 11 are (1 2 26 48 40472)
Factorions in base 12 are (1 2)
Factorions in base 13 are (1 2 519326767)
Factorions in base 14 are (1 2 12973363226)

Phix

Translation of: C

As per talk page (ok, and the task description), this is incorrectly using the base 10 limit for bases 9, 11, and 12.

with javascript_semantics
for base=9 to 12 do
    printf(1,"The factorions for base %d are: ", base)
    for i=1 to 1499999 do
        atom total = 0, j = i, d
        while j>0 and total<=i do
            d = remainder(j,base)
            total += factorial(d)
            j = floor(j/base)
        end while
        if total==i then printf(1,"%d ", i) end if
    end for
    printf(1,"\n")
end for
Output:
The factorions for base 9 are: 1 2 41282
The factorions for base 10 are: 1 2 145 40585
The factorions for base 11 are: 1 2 26 48 40472
The factorions for base 12 are: 1 2
Translation of: Sidef

Using the correct limits and much faster, or at least it was until I upped the bases to 14.

with javascript_semantics
function max_power(integer base = 10)
    integer m = 1
    atom f = factorial(base-1)
    while m*f >= power(base,m-1) do
        m += 1
    end while
    return m-1
end function
 
constant digits = "0123456789abcd"

function fcomb(sequence res, integer base, n, at=1, atom fsum=0, string chosen="")
    if length(chosen)=n then
        string fs = sort(sprintf("%a",{{base,fsum}}))
        if fs=chosen then
            res = append(res,sprintf("%d",fsum))
        end if
    else
        for i=at to base do
            res = fcomb(res,base,n,i,fsum+factorial(i-1),chosen&digits[i])
        end for
    end if
    return res
end function

function factorions(integer base = 10)
    sequence result = {}
    for k=1 to max_power(base) do
        result &= fcomb({},base,k)
    end for
    return result
end function

for base=2 to 14 do
    printf(1,"Base %2d factorions: %s\n",{base,join(factorions(base))})
end for
Output:
Base  2 factorions: 1 2
Base  3 factorions: 1 2
Base  4 factorions: 1 2 7
Base  5 factorions: 1 2 49
Base  6 factorions: 1 2 25 26
Base  7 factorions: 1 2
Base  8 factorions: 1 2
Base  9 factorions: 1 2 41282
Base 10 factorions: 1 2 145 40585
Base 11 factorions: 1 2 26 48 40472
Base 12 factorions: 1 2
Base 13 factorions: 1 2 519326767
Base 14 factorions: 1 2 12973363226

It will in fact go all the way to 17, though I don't recommend it:

Base 15 factorions: 1 2 1441 1442
Base 16 factorions: 1 2 2615428934649
Base 17 factorions: 1 2 40465 43153254185213 43153254226251

PureBasic

Translation of: C

<lang PureBasic>Declare main()

If OpenConsole() : main() : Else : End 1 : EndIf Input() : End

Procedure main()

 Define.i n,b,d,i,j,sum
 Dim fact.i(12)
 
 fact(0)=1
 For n=1 To 11 : fact(n)=fact(n-1)*n : Next
 
 For b=9 To 12
   PrintN("The factorions for base "+Str(b)+" are: ")
   For i=1 To 1500000-1
     sum=0 : j=i
     While j>0
       d=j%b : sum+fact(d) : j/b
     Wend
     If sum=i : Print(Str(i)+" ") : EndIf
   Next
   Print(~"\n\n")
 Next

EndProcedure</lang>

Output:
The factorions for base 9 are: 
1 2 41282 

The factorions for base 10 are: 
1 2 145 40585 

The factorions for base 11 are: 
1 2 26 48 40472 

The factorions for base 12 are: 
1 2 

Python

Translation of: C

<lang Python>fact = [1] # cache factorials from 0 to 11 for n in range(1, 12):

   fact.append(fact[n-1] * n)

for b in range(9, 12+1):

   print(f"The factorions for base {b} are:")
   for i in range(1, 1500000):
       fact_sum = 0
       j = i
       while j > 0:
           d = j % b
           fact_sum += fact[d]
           j = j//b
       if fact_sum == i:
           print(i, end=" ")
   print("\n")

</lang>

Output:
The factorions for base 9 are:
1 2 41282

The factorions for base 10 are:
1 2 145 40585

The factorions for base 11 are:
1 2 26 48 40472

The factorions for base 12 are:
1 2

Quackery

<lang Quackery> [ table ] is results ( n --> s )

 4 times 
   [ ' [ stack [ ] ]
     copy
     ' results put ]
 [ results dup take 
   rot join swap put ]  is addresult ( n n -->   )
 [ table 9 10 11 12 ]   is radix     (   n --> n )
 [ table 1 ]            is !         (   n --> n )     
 1 11 times
   [ i^ 1+ * dup
     ' ! put ]
 drop 
   
 [ dip dup
   0 temp put
   [ tuck /mod !
     temp tally
     swap over 0 = 
     until ]
   2drop 
   temp take = ]       is factorion ( n n --> b )
 1500000 times
   [ i^ 4 times 
     [ dup 
       i^ radix
       factorion if
         [ dup i^ 
           addresult ] ]
     drop ]
 4 times 
   [ say "Factorions for base "
    i^ radix echo say ": "
    i^ results take echo cr ]</lang>
Output:
Factorions for base 9: [ 1 2 41282 ]
Factorions for base 10: [ 1 2 145 40585 ]
Factorions for base 11: [ 1 2 26 48 40472 ]
Factorions for base 12: [ 1 2 ]


Racket

Translation of: C

<lang racket>#lang racket

(define fact

 (curry list-ref (for/fold ([result (list 1)] #:result (reverse result))
                           ([x (in-range 1 20)])
                   (cons (* x (first result)) result))))

(for ([b (in-range 9 13)])

 (printf "The factorions for base ~a are:\n" b)
 (for ([i (in-range 1 1500000)])
   (let loop ([sum 0] [n i])
     (cond
       [(positive? n) (loop (+ sum (fact (modulo n b))) (quotient n b))]
       [(= sum i) (printf "~a " i)])))
 (newline))</lang>
Output:
The factorions for base 9 are:
1 2 41282 
The factorions for base 10 are:
1 2 145 40585 
The factorions for base 11 are:
1 2 26 48 40472 
The factorions for base 12 are:
1 2 

Raku

(formerly Perl 6)

Works with: Rakudo version 2019.07.1

<lang perl6>constant @factorial = 1, |[\*] 1..*;

constant $limit = 1500000;

constant $bases = 9 .. 12;

my @result;

$bases.map: -> $base {

   @result[$base] = "\nFactorions in base $base:\n1 2";
   sink (1 .. $limit div $base).map: -> $i {
       my $product = $i * $base;
       my $partial;
       for $i.polymod($base xx *) {
           $partial += @factorial[$_];
           last if $partial > $product
       }
       next if $partial > $product;
       my $sum;
       for ^$base {
           last if ($sum = $partial + @factorial[$_]) > $product + $_;
           @result[$base] ~= " $sum" and last if $sum == $product + $_
       }
   }

}

.say for @result[$bases];</lang>

Output:
Factorions in base 9:
1 2 41282

Factorions in base 10:
1 2 145 40585

Factorions in base 11:
1 2 26 48 40472

Factorions in base 12:
1 2

REXX

Translation of: C

<lang rexx>/*REXX program calculates and displays factorions in bases nine ───► twelve. */ parse arg LOb HIb lim . /*obtain optional arguments from the CL*/ if LOb== | LOb=="," then LOb= 9 /*Not specified? Then use the default.*/ if HIb== | HIb=="," then HIb= 12 /* " " " " " " */ if lim== | lim=="," then lim= 1500000 - 1 /* " " " " " " */

 do fact=0  to HIb;   !.fact= !(fact)           /*use memoization for factorials.      */
 end   /*fact*/
 do base=LOb  to  HIb                           /*process all the required bases.      */
 @= 1 2                                         /*initialize the list  (@)  to  1 & 2. */
         do j=3  for lim-2;  $= 0               /*initialize the sum   ($)  to  zero.  */
                                         t= j   /*define the target  (for the sum !'s).*/
                                do until t==0;    d= t // base      /*obtain a "digit".*/
                                                  $= $ + !.d        /*add  !(d) to sum.*/
                                                  t= t % base       /*get a new target.*/
                                end   /*until*/
         if $==j  then @= @ j                   /*Good factorial sum? Then add to list.*/
         end   /*i*/
 say
 say 'The factorions for base '      right( base, length(HIb) )        " are: "         @
 end   /*base*/

exit /*stick a fork in it, we're all done. */ /*──────────────────────────────────────────────────────────────────────────────────────*/ !: procedure; parse arg x;  !=1; do j=2 to x;  !=!*j; end; return ! /*factorials*/</lang>

output   when using the default inputs:
The factorions for base   9  are:  1 2 41282

The factorions for base  10  are:  1 2 145 40585

The factorions for base  11  are:  1 2 26 48 40472

The factorions for base  12  are:  1 2

Ruby

<lang ruby> def factorion?(n, base)

 n.digits(base).sum{|digit| (1..digit).inject(1, :*)} == n 

end

(9..12).each do |base|

 puts "Base #{base} factorions: #{(1..1_500_000).select{|n| factorion?(n, base)}.join(" ")} "

end </lang>

Output:
Base 9 factorions: 1 2 41282 
Base 10 factorions: 1 2 145 40585 
Base 11 factorions: 1 2 26 48 40472 
Base 12 factorions: 1 2 

Scala

Translation of: C++

<lang scala>object Factorion extends App {

   private def is_factorion(i: Int, b: Int): Boolean = {
       var sum = 0L
       var j = i
       while (j > 0) {
           sum +=  f(j % b)
           j /= b
       }
       sum == i
   }
   private val f = Array.ofDim[Long](12)
   f(0) = 1L
   (1 until 12).foreach(n => f(n) = f(n - 1) * n)
   (9 to 12).foreach(b => {
       print(s"factorions for base $b:")
       (1 to 1500000).filter(is_factorion(_, b)).foreach(i => print(s" $i"))
       println
   })

}</lang>

Sidef

<lang ruby>func max_power(b = 10) {

   var m = 1
   var f = (b-1)!
   while (m*f >= b**(m-1)) {
       m += 1
   }
   return m-1

}

func factorions(b = 10) {

   var result = []
   var digits = @^b
   var fact = digits.map { _! }
   for k in (1 .. max_power(b)) {
       digits.combinations_with_repetition(k, {|*comb|
           var n = comb.sum_by { fact[_] }
           if (n.digits(b).sort == comb) {
               result << n
           }
       })
   }
   return result

}

for b in (2..12) {

   var r = factorions(b)
   say "Base #{'%2d' % b} factorions: #{r}"

}</lang>

Output:
Base  2 factorions: [1, 2]
Base  3 factorions: [1, 2]
Base  4 factorions: [1, 2, 7]
Base  5 factorions: [1, 2, 49]
Base  6 factorions: [1, 2, 25, 26]
Base  7 factorions: [1, 2]
Base  8 factorions: [1, 2]
Base  9 factorions: [1, 2, 41282]
Base 10 factorions: [1, 2, 145, 40585]
Base 11 factorions: [1, 2, 26, 48, 40472]
Base 12 factorions: [1, 2]

Swift

Translation of: C

<lang swift>var fact = Array(repeating: 0, count: 12)

fact[0] = 1

for n in 1..<12 {

 fact[n] = fact[n - 1] * n

}

for b in 9...12 {

 print("The factorions for base \(b) are:")
 for i in 1..<1500000 {
   var sum = 0
   var j = i
   while j > 0 {
     sum += fact[j % b]
     j /= b
   }
   if sum == i {
     print("\(i)", terminator: " ")
     fflush(stdout)
   }
 }
 print("\n")

}</lang>

Output:
The factorions for base 9 are:
1 2 41282 

The factorions for base 10 are:
1 2 145 40585 

The factorions for base 11 are:
1 2 26 48 40472 

The factorions for base 12 are:
1 2

Vlang

Translation of: Go

<lang vlang>import strconv

fn main() {

   // cache factorials from 0 to 11
   mut fact := [12]u64{}
   fact[0] = 1
   for n := u64(1); n < 12; n++ {
       fact[n] = fact[n-1] * n
   }

   for b := 9; b <= 12; b++ {
       println("The factorions for base $b are:")
       for i := u64(1); i < 1500000; i++ {
           digits := strconv.format_uint(i, b)
           mut sum := u64(0)
           for digit in digits {
               if digit < `a` {
                   sum += fact[digit-`0`]
               } else {
                   sum += fact[digit+10-`a`]
               }
           }
           if sum == i {
               print("$i ")
           }
       }
       println("\n")
   }

}</lang>

Output:
The factorions for base 9 are:
1 2 41282 

The factorions for base 10 are:
1 2 145 40585 

The factorions for base 11 are:
1 2 26 48 40472 

The factorions for base 12 are:
1 2  

Wren

Translation of: C

<lang ecmascript>// cache factorials from 0 to 11 var fact = List.filled(12, 0) fact[0] = 1 for (n in 1..11) fact[n] = fact[n-1] * n

for (b in 9..12) {

   System.print("The factorions for base %(b) are:")
   for (i in 1...1500000) {
       var sum = 0
       var j = i
       while (j > 0) {
           var d = j % b
           sum = sum + fact[d]
           j = (j/b).floor
       }
       if (sum == i) System.write("%(i) ")
   }
   System.print("\n")

}</lang>

Output:
The factorions for base 9 are:
1 2 41282 

The factorions for base 10 are:
1 2 145 40585 

The factorions for base 11 are:
1 2 26 48 40472 

The factorions for base 12 are:
1 2 

VBScript

<lang vb>' Factorions - VBScript - PG - 26/04/2020

   Dim fact()

nn1=9 : nn2=12 lim=1499999

   ReDim fact(nn2)

fact(0)=1 For i=1 To nn2 fact(i)=fact(i-1)*i Next For base=nn1 To nn2 list="" For i=1 To lim s=0 t=i Do While t<>0 d=t Mod base s=s+fact(d) t=t\base Loop If s=i Then list=list &" "& i Next Wscript.Echo "the factorions for base "& right(" "& base,2) &" are: "& list Next </lang>

Output:
the factorions for base  9 are: 1 2 41282
the factorions for base 10 are: 1 2 145 40585
the factorions for base 11 are: 1 2 26 48 40472
the factorions for base 12 are: 1 2


zkl

Translation of: C

<lang zkl>var facts=[0..12].pump(List,fcn(n){ (1).reduce(n,fcn(N,n){ N*n },1) }); #(1,1,2,6....) fcn factorions(base){

  fs:=List();
  foreach n in ([1..1_499_999]){
     sum,j := 0,n;
     while(j){

sum+=facts[j%base]; j/=base;

     }
     if(sum==n) fs.append(n);
  }
  fs

}</lang> <lang zkl>foreach n in ([9..12]){

  println("The factorions for base %2d are: ".fmt(n),factorions(n).concat("  "));

}</lang>

Output:
The factorions for base  9 are: 1  2  41282
The factorions for base 10 are: 1  2  145  40585
The factorions for base 11 are: 1  2  26  48  40472
The factorions for base 12 are: 1  2