/* ARM assembly Raspberry PI  */
/*  program calculPi.s   */
/* this program use gmp library package : libgmp3-dev */
/* link with gcc option -lgmp */

 /* REMARK 1 : this program use routines in a include file
   see task Include a file language arm assembly
   for the routine affichageMess conversion10
   see at end of this program the instruction include */
/* for constantes see task include a file in arm assembly */
/************************************/
/* Constantes                       */
/************************************/
.include "../constantes.inc"

.equ MAXI,      10
.equ SIZEBIG,   100

/*********************************/
/* Initialized data              */
/*********************************/
.data
szMessPi:            .asciz "\nPI = \n"
szCarriageReturn:   .asciz "\n"

szFormat:           .asciz " %Zd\n"
szFormatFloat:      .asciz " %.*Ff\n"
/*********************************/
/* UnInitialized data            */
/*********************************/
.bss
Result1:                    .skip SIZEBIG
Result2:                    .skip SIZEBIG
Result3:                    .skip SIZEBIG
Result4:                    .skip SIZEBIG
fInter5:                    .skip SIZEBIG
fInter6:                    .skip SIZEBIG
fInter7:                    .skip SIZEBIG
fSum:                       .skip SIZEBIG
fSum1:                      .skip SIZEBIG
sBuffer:                    .skip SIZEBIG
fEpsilon:                   .skip SIZEBIG
fPrec:                      .skip SIZEBIG
fPI:                        .skip SIZEBIG
fTEN:                       .skip SIZEBIG
fONE:                       .skip SIZEBIG
/*********************************/
/*  code section                 */
/*********************************/
.text
.global main
main:                             @ entry of program
    mov r4,#0                     @ loop indice
1:
    mov r0,r4
    bl computeAlmkvist            @ compute
    mov r1,r0
    ldr r0,iAdrszFormat           @ print big integer
    bl __gmp_printf

    add r4,r4,#1
    cmp r4,#MAXI
    blt 1b                        @ and loop

    mov r0,#560                   @ float précision in bits
    bl __gmpf_set_default_prec

    mov r4,#0                     @ compute indice
    ldr r0,iAdrfSum               @ init to zéro
    bl __gmpf_init
    ldr r0,iAdrfSum1              @ init to zéro
    bl __gmpf_init

    ldr r0,iAdrfONE               @ result address
    mov r1,#1                     @ init à 1
    bl __gmpf_init_set_ui

    ldr r0,iAdrfInter5            @ init to zéro
    bl __gmpf_init
    ldr r0,iAdrfInter6            @ init to zéro
    bl __gmpf_init
    ldr r0,iAdrfInter7            @ init to zéro
    bl __gmpf_init
    ldr r0,iAdrfEpsilon           @ init to zéro
    bl __gmpf_init
    ldr r0,iAdrfPrec              @ init to zéro
    bl __gmpf_init
    ldr r0,iAdrfPI                @ init to zéro
    bl __gmpf_init
    ldr r0,iAdrfTEN
    mov r1,#10                    @ init to 10
    bl __gmpf_init_set_ui

    ldr r0,iAdrfInter6            @ compute 10 pow 70
    ldr r1,iAdrfTEN
    mov r2,#70
    bl __gmpf_pow_ui

    ldr r0,iAdrfEpsilon           @ divide 1 by 10 pow 70
    ldr r1,iAdrfONE               @ dividende
    ldr r2,iAdrfInter6            @ divisor
    bl __gmpf_div

2:                                @ PI compute loop
    mov r0,r4
    bl computeAlmkvist
    mov r5,r0
    mov r1,#6
    mul r2,r1,r4
    add r6,r2,#3                  @ compute 6n + 3

    ldr r0,iAdrfInter6            @ compute 10 pow (6n+3)
    ldr r1,iAdrfTEN
    mov r2,r6
    bl __gmpf_pow_ui

    ldr r0,iAdrfInter7             @ compute 1 / 10 pow (6n+3)
    ldr r1,iAdrfONE                @ dividende
    ldr r2,iAdrfInter6             @ divisor
    bl __gmpf_div

    ldr r0,iAdrfInter6             @ result big float
    mov r1,r5                      @ big integer Almkvist
    bl __gmpf_set_z                @ conversion in big float

    ldr r0,iAdrfInter5             @ result Almkvist * 1 / 10 pow (6n+3)
    ldr r1,iAdrfInter7             @ operator 1
    ldr r2,iAdrfInter6             @ operator 2
    bl __gmpf_mul

    ldr r0,iAdrfSum1               @ terms addition
    ldr r1,iAdrfSum
    ldr r2,iAdrfInter5
    bl __gmpf_add

    ldr r0,iAdrfSum                @ copy terms
    ldr r1,iAdrfSum1
    bl __gmpf_set

    ldr r0,iAdrfInter7             @ compute 1 / sum
    ldr r1,iAdrfONE                @ dividende
    ldr r2,iAdrfSum                @ divisor
    bl __gmpf_div

    ldr r0,iAdrfPI                 @ compute square root (1 / sum )
    ldr r1,iAdrfInter7
    bl __gmpf_sqrt

    ldr r0,iAdrfInter6             @ compute variation PI
    ldr r1,iAdrfPrec
    ldr r2,iAdrfPI
    bl __gmpf_sub

    ldr r0,iAdrfInter6             @ absolue value
    ldr r1,iAdrfInter5
    bl __gmpf_abs

    add r4,r4,#1                   @ increment indice

    ldr r0,iAdrfPrec               @ copy PI -> prévious
    ldr r1,iAdrfPI
    bl __gmpf_set

    ldr r0,iAdrfInter6             @ compare gap and epsilon
    ldr r1,iAdrfEpsilon
    bl __gmpf_cmp
    cmp r0,#0
    bgt 2b                         @ if gap is highter -> loop

    ldr r0,iAdrszMessPi            @ title display
    bl affichageMess

    ldr r2,iAdrfPI                 @ PI display
    ldr r0,iAdrszFormatFloat
    mov r1,#70
    bl __gmp_printf

100:                              @ standard end of the program
    mov r0, #0                    @ return code
    mov r7, #EXIT                 @ request to exit program
    svc #0                        @ perform the system call
iAdrszCarriageReturn:        .int szCarriageReturn
iAdrfInter5:                 .int fInter5
iAdrfInter6:                 .int fInter6
iAdrfInter7:                 .int fInter7
iAdrfSum:                    .int fSum
iAdrfSum1:                   .int fSum1
iAdrszFormatFloat:           .int szFormatFloat
iAdrszMessPi:                .int szMessPi
iAdrfEpsilon:                .int fEpsilon
iAdrfPrec:                   .int fPrec
iAdrfPI:                     .int fPI
iAdrfTEN:                    .int fTEN
iAdrfONE:                    .int fONE
/***************************************************/
/*   compute  almkvist_giullera formula             */
/***************************************************/
/* r0 contains the number            */
computeAlmkvist:
    push {r1-r4,lr}               @ save registers
    mov r4,r0
    mov r1,#6
    mul r0,r1,r0
    ldr r1,iAdrResult1            @ result address
    bl computeFactorielle         @ compute (n*6)!

    mov r1,#532
    mul r2,r4,r4
    mul r2,r1,r2
    mov r1,#126
    mul r3,r4,r1
    add r2,r2,r3
    add r2,#9
    lsl r2,r2,#5                   @ * 32

    ldr r0,iAdrResult2             @ result
    ldr r1,iAdrResult1             @ operator
    bl __gmpz_mul_ui

    mov r0,r4
    ldr r1,iAdrResult1
    bl computeFactorielle

    ldr r0,iAdrResult3
    bl __gmpz_init                 @ init to 0

    ldr r0,iAdrResult3             @ result
    ldr r1,iAdrResult1             @ operator
    mov r2,#6
    bl __gmpz_pow_ui

    ldr r0,iAdrResult1             @ result
    ldr r1,iAdrResult3             @ operator
    mov r2,#3
    bl __gmpz_mul_ui

    ldr r0,iAdrResult3             @ result
    ldr r1,iAdrResult2             @ operator
    ldr r2,iAdrResult1             @ operator
    bl __gmpz_cdiv_q

    ldr r0,iAdrResult3             @ return result address

    pop {r1-r4,pc}                 @ restaur des registres
iAdrszFormat:         .int szFormat
iAdrResult1:          .int Result1
iAdrResult2:          .int Result2
iAdrResult3:          .int Result3
/***************************************************/
/*   compute  factorielle N                        */
/***************************************************/
/* r0 contains the number            */
/* r1 contains big number result address */
computeFactorielle:
    push {r1-r6,lr}               @ save registers
    mov r5,r0                     @ save N
    mov r6,r1                     @ save result address
    mov r0,r1                     @ result address
    mov r1,#1                     @ init to 1
    bl __gmpz_init_set_ui
    ldr r0,iAdrResult4
    bl __gmpz_init                @ init to 0
    mov r4,#1
1:                                @ loop
    ldr r0,iAdrResult4            @ result
    mov r1,r6                     @ operator 1
    mov r2,r4                     @ operator 2
    bl __gmpz_mul_ui
    mov r0,r6                     @ copy result4 -> result
    ldr r1,iAdrResult4
    bl __gmpz_set
    add r4,r4,#1                  @ increment indice
    cmp r4,r5                     @ N ?
    ble 1b                        @ no -> loop

    mov r0,r1

    pop {r1-r6,pc}                @ restaur des registres
iAdrResult4:          .int Result4

/***************************************************/
/*      ROUTINES INCLUDE                           */
/***************************************************/
.include "../affichage.inc"


using System;
using BI = System.Numerics.BigInteger;
using static System.Console;

class Program {

  static BI isqrt(BI x) { BI q = 1, r = 0, t; while (q <= x) q <<= 2; while (q > 1) {
    q >>= 2; t = x - r - q; r >>= 1; if (t >= 0) { x = t; r += q; } } return r; }

  static string dump(int digs, bool show = false) {
    int gb = 1, dg = ++digs + gb, z;
    BI t1 = 1, t2 = 9, t3 = 1, te, su = 0,
       t = BI.Pow(10, dg <= 60 ? 0 : dg - 60), d = -1, fn = 1;
    for (BI n = 0; n < dg; n++) {
      if (n > 0) t3 *= BI.Pow(n, 6);
      te = t1 * t2 / t3;
      if ((z = dg - 1 - (int)n * 6) > 0) te *= BI.Pow (10, z);
      else te /= BI.Pow (10, -z);
      if (show && n < 10)
        WriteLine("{0,2} {1,62}", n, te * 32 / 3 / t);
      su += te; if (te < 10) {
        if (show) WriteLine("\n{0} iterations required for {1} digits " +
        "after the decimal point.\n", n, --digs); break; }
      for (BI j = n * 6 + 1; j <= n * 6 + 6; j++) t1 *= j;
      t2 += 126 + 532 * (d += 2);
    }
    string s = string.Format("{0}", isqrt(BI.Pow(10, dg * 2 + 3) /
      su / 32 * 3 * BI.Pow((BI)10, dg + 5)));
    return s[0] + "." + s.Substring(1, digs); }

  static void Main(string[] args) {
    WriteLine(dump(70, true)); }
}


#include <boost/multiprecision/cpp_dec_float.hpp>
#include <boost/multiprecision/gmp.hpp>
#include <iomanip>
#include <iostream>

namespace mp = boost::multiprecision;
using big_int = mp::mpz_int;
using big_float = mp::cpp_dec_float_100;
using rational = mp::mpq_rational;

big_int factorial(int n) {
    big_int result = 1;
    for (int i = 2; i <= n; ++i)
        result *= i;
    return result;
}

// Return the integer portion of the nth term of Almkvist-Giullera sequence.
big_int almkvist_giullera(int n) {
    return factorial(6 * n) * 32 * (532 * n * n + 126 * n + 9) /
           (pow(factorial(n), 6) * 3);
}

int main() {
    std::cout << "n |                  Integer portion of nth term\n"
              << "------------------------------------------------\n";
    for (int n = 0; n < 10; ++n)
        std::cout << n << " | " << std::setw(44) << almkvist_giullera(n)
                  << '\n';

    big_float epsilon(pow(big_float(10), -70));
    big_float prev = 0, pi = 0;
    rational sum = 0;
    for (int n = 0;; ++n) {
        rational term(almkvist_giullera(n), pow(big_int(10), 6 * n + 3));
        sum += term;
        pi = sqrt(big_float(1 / sum));
        if (abs(pi - prev) < epsilon)
            break;
        prev = pi;
    }
    std::cout << "\nPi to 70 decimal places is:\n"
              << std::fixed << std::setprecision(70) << pi << '\n';
}


(ql:quickload :computable-reals :silent t)
(use-package :computable-reals)
(setq *print-prec* 70)
(defparameter *iterations* 52)

; factorial using computable-reals multiplication op to keep precision
(defun !r (n)
  (let ((p 1))
    (loop for i from 2 to n doing (setq p (*r p i)))
    p))

; the nth integer term
(defun integral (n)
   (let* ((polynomial (+r (*r 532 n n) (*r 126 n) 9))
          (numer  (*r 32 (!r (*r 6 n)) polynomial))
          (denom  (*r 3 (expt-r (!r n) 6))))
    (/r  numer denom)))

; the exponent for 10 in the nth term of the series
(defun power (n) (- 3 (* 6 (1+ n))))

; the nth term of the series
(defun almkvist-giullera (n)
  (/r (integral n) (expt-r 10 (abs (power n)))))

; the sum of the first n terms
(defun almkvist-giullera-sigma (n)
  (let ((s 0))
    (loop for i from 0 to n doing (setq s (+r s (almkvist-giullera i))))
    s))

; the approximation to pi after n terms
(defun almkvist-giullera-pi (n)
  (sqrt-r (/r 1 (almkvist-giullera-sigma n))))

(format t "~A. ~44A~4A ~A~%" "N" "Integral part of Nth term" "×10^" "=Actual value of Nth term")
(loop for i from 0 to 9 doing
  (format t "~&~a. ~44d ~3d " i (integral i) (power i))
  (finish-output *standard-output*)
  (print-r (almkvist-giullera i) 50 nil))

(format t "~%~%Pi after ~a iterations: " *iterations*)
(print-r (almkvist-giullera-pi *iterations*) *print-prec*)


[* factorial *]sz
[ 1 Sp [ d lp * sp 1 - d 1 <f ]Sf d 1 <f Lfsz sz Lp ]sF

[* nth integral term *]sz
[ sn 32 6 ln * lFx 532 ln * ln * 126 ln * + 9 + * * 3 ln lFx 6 ^ * / ]sI

[* nth exponent of 10 *]sz
[ 1 + 6 * 3 r - ]sE

[* nth term in series *]sz
[ d lIx r 10 r lEx _1 * ^ / ]sA

[* sum of the first n terms *]sz
[ [li lAx ls + ss li 1 - d si 0 r !<L]sL si 0ss lLx ls]sS

[* approximation of pi after n terms *]sz
[ lSx 1 r / v ]sP

[* count digits in a number *]sz
[sn 0 sd lCx ld]sD
[ld 1 + sd ln 10 0k / d sn 0 !=C]sC

[* print a number in a given column width *]sz
[sw d lDx si lw li <T n]sW
[[ ]n li 1 + si lw li <T]sT

[* main loop: print values for first 10 terms *]sz
[N. Integral part of Nth term .................. × 10^ =Actual value of Nth term]p
0 sj
[
  lj n [. ]n
  lj lIx 0k 1 / 44 lWx [ ]n
  lj lEx 4 lWx [ ]n
  lj 99k lAx 50k 1 / p
  lj 1 + d sj 10 >M
] sM
lMx

[]p

[* print resulting value of pi to 70 places *]sz
[Pi after ]n 52n [ iterations:]p
99k 52 lPx 70k 1 / p


-mode(compile).

% Integer math routines: factorial, power, square root, integer logarithm.
%
fac(N) -> fac(N, 1).
fac(N, A) when N < 2 -> A;
fac(N, A) -> fac(N - 1, N*A).

pow(_, N) when N < 0 -> pow_domain_error;
pow(2, N) -> 1 bsl N;
pow(A, N) -> ipow(A, N).

ipow(_, 0) -> 1;
ipow(A, 1) -> A;
ipow(A, 2) -> A*A;
ipow(A, N) ->
    case N band 1 of
        0 -> X = ipow(A, N bsr 1), X*X;
        1 -> A * ipow(A, N - 1)
    end.

% integer logarithm, based on Zeckendorf representations of integers.
%    https://www.keithschwarz.com/interesting/code/?dir=zeckendorf-logarithm
%    we need this, since the exponents get larger than IEEE-754 double can handle.

lognext({A, B, S, T}) -> {B, A+B, T, S*T}.
logprev({A, B, S, T}) -> {B-A, A, T div S, S}.

ilog(A, B) when (A =< 0) or (B < 2) -> ilog_domain_error;
ilog(A, B) ->
    UBound = bracket(A, {0, 1, 1, B}),
    backlog(A, UBound, 0).

bracket(A, State = {_, _, _, T}) when T > A -> State;
bracket(A, State) -> bracket(A, lognext(State)).

backlog(_, {0, _, 1, _}, Log) -> Log;
backlog(N, State = {A, _, S, _}, Log) when S =< N ->
    backlog(N div S, logprev(State), Log + A);
backlog(N, State, Log) -> backlog(N, logprev(State), Log).

isqrt(N) when N < 0 -> isqrt_domain_error;
isqrt(N) ->
    X0 = pow(2, ilog(N, 2) div 2),
    iterate(N, newton(X0, N), N).

iterate(A, B, _) when A =< B -> A;
iterate(_, B, N) -> iterate(B, newton(B, N), N).

newton(X, N) -> (X + N div X) div 2.

% With this out of the way, we can get down to some serious calculation.
%
term(N) -> {  % returns numerator and log10 of the denominator.
    (fac(6*N)*(N*(532*N + 126) + 9) bsl 5) div (3*pow(fac(N), 6)),
    6*N + 3
    }.

neg_term({N, D}) -> {-N, D}.
abs_term({N, D}) -> {abs(N), D}.

add_term(T1 = {_, D1}, T2 = {_, D2}) when D1 > D2 -> add_term(T2, T1);
add_term({N1, D1}, {N2, D2}) ->
    Scale = pow(10, D2 - D1),
    {N1*Scale + N2, D2}.

calculate(Prec) -> calculate(Prec, {0, 0}, 0).
calculate(Prec, T0, K) ->
    T1 = add_term(T0, term(K)),
    {N, D} = abs_term(add_term(neg_term(T1), T0)),
    Accuracy = D - ilog(N, 10),
    if
        Accuracy < Prec -> calculate(Prec, T1, K + 1);
        true -> T1
    end.

get_pi(Prec) ->
    {N0, D0} = calculate(Prec),
    % from the term, t = n0/10^d0, calculate 1/√t
    % if the denominator is an odd power of 10, add 1 to the denominator and multiply the numerator by 10.
    {N, D} = case D0 band 1 of
        0 -> {N0, D0};
        1 -> {10*N0, D0 + 1}
    end,
    [Three|Rest] = lists:sublist(
            integer_to_list(pow(10, D) div isqrt(N)), Prec),
    [Three, $. | Rest].

show_term({A, Decimals}) ->
    Str = integer_to_list(A),
    [$0, $.] ++ lists:duplicate(Decimals - length(Str), $0) ++ Str.

main(_) ->
    Terms = [term(N) || N <- lists:seq(0, 9)],
    io:format("The first 10 terms as scaled decimals are:~n"),
    [io:format("    ~s~n", [show_term(T)]) || T <- Terms],
    io:format("~nThe sum of these terms (pi^-2) is ~s~n",
                [show_term(lists:foldl(fun add_term/2, {0, 0}, Terms))]),
    Pi70 = get_pi(71),
    io:format("~npi to 70 decimal places:~n"),
    io:format("~s~n", [Pi70]).


// Almkvist-Giullera formula for pi. Nigel Galloway: August 17th., 2021
let factorial(n:bigint)=MathNet.Numerics.SpecialFunctions.Factorial n
let fN g=(532I*g*g+126I*g+9I)*(factorial(6I*g))/(3I*(factorial g)**6)
[0..9]|>Seq.iter(bigint>>fN>>(*)32I>>printfn "%A\n")
let _,n=Seq.unfold(fun(n,g)->let n=n*(10I**6)+fN g in Some(Isqrt((10I**(145+6*(int g)))/(32I*n)),(n,g+1I)))(0I,0I)|>Seq.pairwise|>Seq.find(fun(n,g)->n=g)
printfn $"""pi to 70 decimal places is %s{(n.ToString()).Insert(1,".")}"""


USING: continuations formatting io kernel locals math
math.factorials math.functions sequences ;

:: integer-term ( n -- m )
    32 6 n * factorial * 532 n sq * 126 n * + 9 + *
    n factorial 6 ^ 3 * / ;

: exponent-term ( n -- m ) 6 * 3 + neg ;

: nth-term ( n -- x )
    [ integer-term ] [ exponent-term 10^ * ] bi ;

! Factor doesn't have an arbitrary-precision square root afaik,
! so make one using Heron's method.

: sqrt-approx ( r x -- r' x ) [ over / + 2 / ] keep ;

:: almkvist-guillera ( precision -- x )
    0 0 :> ( summed! next-add! )
    [
        100,000,000 <iota> [| n |
            summed n nth-term + next-add!
            next-add summed - abs precision neg 10^ <
            [ return ] when
            next-add summed!
        ] each
    ] with-return
    next-add ;

CONSTANT: 1/pi 113/355  ! Use as initial guess for square root approximation

: pi ( -- )
    1/pi 70 almkvist-guillera 5 [ sqrt-approx ] times
    drop recip "%.70f\n" printf ;

! Task
"N                               Integer Portion  Pow  Nth Term (33 dp)" print
89 CHAR: - <repetition> print
10 [
    dup [ integer-term ] [ exponent-term ] [ nth-term ] tri
    "%d  %44d  %3d  %.33f\n" printf
] each-integer nl
"Pi to 70 decimal places:" print pi


package main

import (
    "fmt"
    "math/big"
    "strings"
)

func factorial(n int64) *big.Int {
    var z big.Int
    return z.MulRange(1, n)
}

var one = big.NewInt(1)
var three = big.NewInt(3)
var six = big.NewInt(6)
var ten = big.NewInt(10)
var seventy = big.NewInt(70)

func almkvistGiullera(n int64, print bool) *big.Rat {
    t1 := big.NewInt(32)
    t1.Mul(factorial(6*n), t1)
    t2 := big.NewInt(532*n*n + 126*n + 9)
    t3 := new(big.Int)
    t3.Exp(factorial(n), six, nil)
    t3.Mul(t3, three)
    ip := new(big.Int)
    ip.Mul(t1, t2)
    ip.Quo(ip, t3)
    pw := 6*n + 3
    t1.SetInt64(pw)
    tm := new(big.Rat).SetFrac(ip, t1.Exp(ten, t1, nil))
    if print {
        fmt.Printf("%d  %44d  %3d  %-35s\n", n, ip, -pw, tm.FloatString(33))
    }
    return tm
}

func main() {
    fmt.Println("N                               Integer Portion  Pow  Nth Term (33 dp)")
    fmt.Println(strings.Repeat("-", 89))
    for n := int64(0); n < 10; n++ {
        almkvistGiullera(n, true)
    }

    sum := new(big.Rat)
    prev := new(big.Rat)
    pow70 := new(big.Int).Exp(ten, seventy, nil)
    prec := new(big.Rat).SetFrac(one, pow70)
    n := int64(0)
    for {
        term := almkvistGiullera(n, false)
        sum.Add(sum, term)
        z := new(big.Rat).Sub(sum, prev)
        z.Abs(z)
        if z.Cmp(prec) < 0 {
            break
        }
        prev.Set(sum)
        n++
    }
    sum.Inv(sum)
    pi := new(big.Float).SetPrec(256).SetRat(sum)
    pi.Sqrt(pi)
    fmt.Println("\nPi to 70 decimal places is:")
    fmt.Println(pi.Text('f', 70))
}


import Control.Monad
import Data.Number.CReal
import GHC.Integer
import Text.Printf

iterations = 52
main = do
  printf "N. %44s %4s %s\n"
          "Integral part of Nth term" "×10^" "=Actual value of Nth term"

  forM_ [0..9] $ \n ->
    printf "%d. %44d %4d %s\n" n
                               (almkvistGiulleraIntegral n)
                               (tenExponent n)
                               (showCReal 50 (almkvistGiullera n))

  printf "\nPi after %d iterations:\n" iterations
  putStrLn $ showCReal 70 $ almkvistGiulleraPi iterations

-- The integral part of the Nth term in the Almkvist-Giullera series
almkvistGiulleraIntegral n =
  let polynomial  = (532 `timesInteger` n `timesInteger` n) `plusInteger` (126 `timesInteger` n) `plusInteger` 9
      numerator   = 32 `timesInteger` (facInteger (6 `timesInteger` n)) `timesInteger` polynomial
      denominator = 3 `timesInteger` (powInteger (facInteger n) 6)
   in numerator `divInteger` denominator

-- The exponent for 10 in the Nth term of the series
tenExponent n = 3 `minusInteger` (6 `timesInteger` (1 `plusInteger` n))

-- The Nth term in the series (integral * 10^tenExponent)
almkvistGiullera n = fromInteger (almkvistGiulleraIntegral n) / fromInteger (powInteger 10 (abs (tenExponent n)))

-- The sum of the first N terms
almkvistGiulleraSum n = sum $ map almkvistGiullera [0 .. n]

-- The approximation of pi from the first N terms
almkvistGiulleraPi n = sqrt $ 1 / almkvistGiulleraSum n

-- Utility: factorial for arbitrary-precision integers
facInteger n = if n `leInteger` 1 then 1 else n `timesInteger` facInteger (n `minusInteger` 1)

-- Utility: exponentiation for arbitrary-precision integers
powInteger 1 _ = 1
powInteger _ 0 = 1
powInteger b 1 = b
powInteger b e = b `timesInteger` powInteger b (e `minusInteger` 1)


numerator =: monad define "0
    (3 * (! x: y)^6) %~ 32 * (!6x*y) * (y*(126 + 532*y)) + 9x
)

term =: numerator % 10x ^ 3 + 6&*

echo 'The first 10 numerators are:'
echo ,. numerator i.10

echo ''
echo 'The sum of the first 10 terms (pi^-2) is ', 0j15 ": +/ term i.10

heron =: [: -: ] + %

sqrt =: dyad define NB. usage: x0 tolerance sqrt x
                    NB. e.g.: (1, %10^100x) sqrt 2 -> √2 to 100 decimals as a ratio p/q
    x0  =. }: x
    eps =. }. x
    x1  =. y heron x0
    while. (| x1 - x0) > eps do.
        x2 =. y heron x1
        x0 =. x1
        x1 =. x2
    end.
    x1
)

pi70 =. (355r113, %10^70x) sqrt % +/ term i.53
echo ''
echo 'pi to 70 decimals: ', 0j70 ": pi70
exit ''


import esMain from 'es-main';
import { BigFloat, set_precision as SetPrecision } from 'bigfloat-esnext';

const Iterations = 52;

export const demo = function() {
  SetPrecision(-75);
  console.log("N." + "Integral part of Nth term".padStart(45) + " ×10^ =Actual value of Nth term");
  for (let i=0; i<10; i++) {
    let line = `${i}. `;
    line += `${integral(i)} `.padStart(45);
    line += `${tenExponent(i)} `.padStart(5);
    line += nthTerm(i);
    console.log(line);
  }

  let pi = approximatePi(Iterations);
  SetPrecision(-70);
  pi = pi.dividedBy(100000).times(100000);
  console.log(`\nPi after ${Iterations} iterations: ${pi}`)
}

export const bigFactorial = n => n <= 1n ? 1n : n * bigFactorial(n-1n);

// the nth integer term
export const integral = function(i) {
  let n = BigInt(i);
  const polynomial  = 532n * n * n + 126n * n + 9n;
  const numerator   = 32n * bigFactorial(6n * n) * polynomial;
  const denominator = 3n * bigFactorial(n) ** 6n;
  return numerator / denominator;
}

// the exponent for 10 in the nth term of the series
export const tenExponent = n => 3n - 6n * (BigInt(n) + 1n);

// the nth term of the series
export const nthTerm = n =>
  new BigFloat(integral(n)).dividedBy(new BigFloat(10n ** -tenExponent(n)))

// the sum of the first n terms
export const sumThrough = function(n) {
  let sum = new BigFloat(0);
  for (let i=0; i<=n; ++i) {
    sum = sum.plus(nthTerm(i));
  }
  return sum;
}

// the approximation to pi after n terms
export const approximatePi  = n =>
   new BigFloat(1).dividedBy(sumThrough(n)).sqrt();

if (esMain(import.meta))
   demo();


# A reminder to include the "rational" module:
# include "rational";

def lpad($len): tostring | ($len - length) as $l | (" " * $l)[:$l] + .;

# To take advantage of gojq's arbitrary-precision integer arithmetic:
def power($b): . as $in | reduce range(0;$b) as $i (1; . * $in);

def factorial:
    if . < 2 then 1
    else reduce range(2;.+1) as $i (1; .*$i)
    end;


using Formatting

setprecision(BigFloat, 300)

function integerterm(n)
    p = BigInt(532) * n * n + BigInt(126) * n + 9
    return (p * BigInt(2)^5 * factorial(BigInt(6) * n)) ÷ (3 * factorial(BigInt(n))^6)
end

exponentterm(n) = -(6n + 3)

nthterm(n) = integerterm(n) * big"10.0"^exponentterm(n)

println("  N                       Integer Term              Power of 10     Nth Term")
println("-"^90)
for n in 0:9
    println(lpad(n, 3), lpad(integerterm(n), 48), lpad(exponentterm(n), 4),
        lpad(format("{1:22.19e}", nthterm(n)), 35))
end

function AlmkvistGuillera(floatprecision)
    summed = nthterm(0)
    for n in 1:10000000
        next = summed + nthterm(n)
        if abs(next - summed) < big"10.0"^(-floatprecision)
            return next
        end
        summed = next
    end
end

println("\nπ to 70 digits is ", format(big"1.0" / sqrt(AlmkvistGuillera(70)), precision=70))

println("Computer π is     ", format(π + big"0.0", precision=70))


ClearAll[numerator, denominator]
numerator[n_] := (2^5) ((6 n)!) (532 n^2 + 126 n + 9)/(3 (n!)^6)
denominator[n_] := 10^(6 n + 3)
numerator /@ Range[0, 9]
val = 1/Sqrt[Total[numerator[#]/denominator[#] & /@ Range[0, 100]]];
N[val, 70]


import strformat, strutils
import decimal

proc fact(n: int): DecimalType =
  result = newDecimal(1)
  if n < 2: return
  for i in 2..n:
    result *= i

proc almkvistGiullera(n: int): DecimalType =
  ## Return the integer portion of the nth term of Almkvist-Giullera sequence.
  let t1 = fact(6 * n) * 32
  let t2 = 532 * n * n + 126 * n + 9
  let t3 = fact(n) ^ 6 * 3
  result = t1 * t2 / t3

let One = newDecimal(1)

setPrec(78)
echo "N                               Integer portion"
echo repeat('-', 47)
for n in 0..9:
  echo &"{n}  {almkvistGiullera(n):>44}"
echo()

echo "Pi to 70 decimal places:"
var
  sum = newDecimal(0)
  prev = newDecimal(0)
  prec = One.scaleb(newDecimal(-70))
  n = 0
while true:
  sum += almkvistGiullera(n) / One.scaleb(newDecimal(6 * n + 3))
  if abs(sum - prev) < prec: break
  prev = sum.clone
  inc n
let pi = 1 / sqrt(sum)
echo ($pi)[0..71]


use strict;
use warnings;
use feature qw(say);
use Math::AnyNum qw(:overload factorial);

sub almkvist_giullera_integral {
    my($n) = @_;
    (32 * (14*$n * (38*$n + 9) + 9) * factorial(6*$n)) / (3*factorial($n)**6);
}

sub almkvist_giullera {
    my($n) = @_;
    almkvist_giullera_integral($n) / (10**(6*$n + 3));
}

sub almkvist_giullera_pi {
    my ($prec) = @_;

    local $Math::AnyNum::PREC = 4*($prec+1);

    my $sum = 0;
    my $target = '';

    for (my $n = 0; ; ++$n) {
        $sum += almkvist_giullera($n);
        my $curr = ($sum**-.5)->as_dec;
        return $target if ($curr eq $target);
        $target = $curr;
    }
}

say 'First 10 integer portions: ';
say "$_  " . almkvist_giullera_integral($_) for 0..9;

my $precision = 70;

printf("π to %s decimal places is:\n%s\n",
    $precision, almkvist_giullera_pi($precision));


with javascript_semantics
requires("1.0.0")
include mpfr.e
mpfr_set_default_precision(-70)

function almkvistGiullera(integer n, bool bPrint)
    mpz {t1,t2,ip} = mpz_inits(3)
    mpz_fac_ui(t1,6*n)
    mpz_mul_si(t1,t1,32)                -- t1:=2^5*(6n)!
    mpz_fac_ui(t2,n)
    mpz_pow_ui(t2,t2,6)
    mpz_mul_si(t2,t2,3)                 -- t2:=3*(n!)^6
    mpz_mul_si(ip,t1,532*n*n+126*n+9)   -- ip:=t1*(532n^2+126n+9)
    mpz_fdiv_q(ip,ip,t2)                -- ip:=ip/t2
    integer pw := 6*n+3
    mpz_ui_pow_ui(t1,10,pw)             -- t1 := 10^(6n+3)
    mpq tm = mpq_init_set_z(ip,t1)      -- tm := rat(ip/t1)
    if bPrint then
        string ips = mpz_get_str(ip),
               tms = mpfr_get_fixed(mpfr_init_set_q(tm),50)
        tms = trim_tail(tms,"0")
        printf(1,"%d  %44s  %3d  %s\n", {n, ips, -pw, tms})
    end if
    return tm
end function

constant hdr = "N --------------- Integer portion -------------  Pow  ----------------- Nth term (50 dp) -----------------"
printf(1,"%s\n%s\n",{hdr,repeat('-',length(hdr))})
for n=0 to 9 do
    {} = almkvistGiullera(n, true)
end for

mpq {res,prev,z} = mpq_inits(3),
    prec = mpq_init_set_str(sprintf("1/1%s",repeat('0',70)))
integer n = 0
while true do
    mpq term := almkvistGiullera(n, false)
    mpq_add(res,res,term)
    mpq_sub(z,res,prev)
    mpq_abs(z,z)
    if mpq_cmp(z,prec) < 0 then exit end if
    mpq_set(prev,res)
    n += 1
end while
mpq_inv(res,res)
mpfr pi = mpfr_init_set_q(res)
mpfr_sqrt(pi,pi)
printf(1,"\nCalculation of pi took %d iterations using the Almkvist-Giullera formula.\n\n",n)
printf(1,"Pi to 70 d.p.: %s\n",mpfr_get_fixed(pi,70))
mpfr_const_pi(pi)
printf(1,"Pi (builtin) : %s\n",mpfr_get_fixed(pi,70))


(scl 70)
(de fact (N)
   (if (=0 N)
      1
      (* N (fact (dec N))) ) )
(de almkvist (N)
   (let
      (A (* 32 (fact (* 6 N)))
         B (+ (* 532 N N) (* 126 N) 9)
         C (* (** (fact N) 6) 3) )
      (/ (* A B) C) ) )
(de integral (N)
   (*/
      1.0
      (almkvist N)
      (** 10 (+ 3 (* 6 N))) ) )
(let (S 0  N -1)
   (do 10
      (println (inc 'N) (almkvist N)) )
   (prinl)
   (setq N -1)
   (while (gt0 (integral (inc 'N)))
      (inc 'S @) )
   (setq S (sqrt (*/ 1.0 1.0 S) 1.0))
   (prinl "Pi to 70 decimal places is:")
   (prinl (format S *Scl)) )


import mpmath as mp

with mp.workdps(72):

    def integer_term(n):
        p = 532 * n * n + 126 * n + 9
        return (p * 2**5 * mp.factorial(6 * n)) / (3 * mp.factorial(n)**6)

    def exponent_term(n):
        return -(mp.mpf("6.0") * n + 3)

    def nthterm(n):
        return integer_term(n) * mp.mpf("10.0")**exponent_term(n)

    for n in range(10):
        print("Term ", n, '  ', int(integer_term(n)))

    def almkvist_guillera(floatprecision):
        summed, nextadd = mp.mpf('0.0'), mp.mpf('0.0')
        for n in range(100000000):
            nextadd = summed + nthterm(n)
            if abs(nextadd - summed) < 10.0**(-floatprecision):
                break

            summed = nextadd

        return nextadd

    print('\nπ to 70 digits is ', end='')
    mp.nprint(mp.mpf(1.0 / mp.sqrt(almkvist_guillera(70))), 71)
    print('mpmath π is       ', end='')
    mp.nprint(mp.pi, 71)


  [ $ "bigrat.qky" loadfile ] now!

  [ 1 swap times [ i^ 1+ * ] ] is !       ( n --> n   )

  [ dup dup 2 ** 532 *
    over 126 * + 9 +
    swap 6 * ! * 32 *
    swap ! 6 ** 3 * / ]        is intterm ( n --> n   )

  [ dup intterm
    10 rot 6 * 3 + **
    reduce ]                   is vterm   ( n --> n/d )

  10 times [ i^ intterm echo cr ] cr

  0 n->v
  53 times [ i^ vterm v+ ]
  1/v 70 vsqrt drop
  70 point$ echo$ cr


# 20201013 Raku programming solution

use BigRoot;
use Rat::Precise;
use experimental :cached;

BigRoot.precision = 75 ;
my $Precision     = 70 ;
my $AGcache       =  0 ;

sub postfix:<!>(Int $n --> Int) is cached { [*] 1 .. $n }

sub Integral(Int $n --> Int) is cached {
   (2⁵*(6*$n)! * (532*$n² + 126*$n + 9)) div (3*($n!)⁶)
}

sub A-G(Int $n --> FatRat) is cached { # Almkvist-Giullera
   Integral($n).FatRat / (10**(6*$n + 3)).FatRat
}

sub Pi(Int $n --> Str) {
   (1/(BigRoot.newton's-sqrt: $AGcache += A-G $n)).precise($Precision)
}

say "First 10 integer portions : ";
say $_, "\t", Integral $_ for ^10;

my $target = Pi my $Nth = 0;

loop { $target eq ( my $next = Pi ++$Nth ) ?? ( last ) !! $target = $next }

say "π to $Precision decimal places is :\n$target"


/*REXX program uses the Almkvist─Giullera formula for   1 / (pi**2)     [or  pi ** -2]. */
numeric digits length( pi() )  +  length(.);                                       w= 102
say $(   , 3)       $(              , w%2)       $('power', 5)       $(          , w)
say $('N', 3)       $('integer term', w%2)       $('of 10', 5)       $('Nth term', w)
say $(   , 3, "─")  $(              , w%2, "─")  $(       , 5, "─")  $(          , w, "─")
                                  s= 0           /*initialize   S   (the sum)  to zero. */
     do n=0  until old=s;    old= s              /*use the "older" value of  S  for OLD.*/
     a= 2**5  *  !(6*n)  *  (532 * n**2  +  126*n  +  9)  /  (3 * !(n)**6)
     z= 10 ** (- (6*n + 3) )
     s= s     +   a * z
     if n>10  then do;  do 3*(n==11);  say ' .';  end;  iterate;  end
     say $(n, 3) right(a, w%2)  $(powX(z), 5)  right( lowE( format(a*z, 1, w-6, 2, 0)), w)
     end   /*n*/
say
say 'The calculation of pi took '       n       " iterations with "         digits() ,
    " decimal digits precision using"   subword( sourceLine(1), 4, 3).
say
numeric digits length( pi() ) - length(.);  d= digits() - length(.);          @= ' ↓↓↓ '
say center(@ 'calculated pi to '  d   " fractional decimal digits (below) is "@, d+4, '─')
say ' 'sqrt(1/s);          say
say ' 'pi();  @= ' ↑↑↑ '
say center(@ 'the  true  pi to '  d   " fractional decimal digits (above) is" @, d+4, '─')
exit 0                                           /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
$:    procedure; parse arg text,width,fill;     return center(text, width, left(fill, 1) )
!:    procedure; parse arg x; !=1;;      do j=2  to x;    != !*j;    end;         return !
lowE: procedure; parse arg x; return translate(x, 'e', "E")
powX: procedure; parse arg p; return right( format( p, 1, 3, 2, 0),  3)   +   0
/*──────────────────────────────────────────────────────────────────────────────────────*/
pi:   pi=3.141592653589793238462643383279502884197169399375105820974944592307816406286208,
      ||9986280348253421170679821480865132823066470938446095505822317253594081284811174503
      return pi
/*──────────────────────────────────────────────────────────────────────────────────────*/
sqrt: procedure; parse arg x;  if x=0  then return 0;  d=digits();  numeric digits;  h=d+6
      m.=9; numeric form; parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g*.5'e'_ % 2
        do j=0  while h>9;        m.j= h;                 h= h % 2  +  1;       end  /*j*/
        do k=j+5  to 0  by -1;    numeric digits m.k;     g= (g + x/g) * .5;    end  /*k*/
      numeric digits d;           return g/1


func almkvist_giullera(n) {
    (32 * (14*n * (38*n + 9) + 9) * (6*n)!) / (3 * n!**6)
}

func almkvist_giullera_pi(prec = 70) {

    local Num!PREC = (4*(prec+1)).numify

    var sum = 0
    var target = -1

    for n in (0..Inf) {
        sum += (almkvist_giullera(n) / (10**(6*n + 3)))
        var curr = (sum**-.5).as_dec
        return target if (target == curr)
        target = curr
    }
}

say 'First 10 integer portions: '

10.of {|n|
    say "#{n} #{almkvist_giullera(n)}"
}

with(70) {|n|
    say "π to #{n} decimal places is:"
    say almkvist_giullera_pi(n)
}


Imports System, BI = System.Numerics.BigInteger, System.Console

Module Module1

    Function isqrt(ByVal x As BI) As BI
        Dim t As BI, q As BI = 1, r As BI = 0
        While q <= x : q <<= 2 : End While
        While q > 1 : q >>= 2 : t = x - r - q : r >>= 1
            If t >= 0 Then x = t : r += q
        End While : Return r
    End Function

    Function dump(ByVal digs As Integer, ByVal Optional show As Boolean = False) As String
        digs += 1
        Dim z As Integer, gb As Integer = 1, dg As Integer = digs + gb
        Dim te As BI, t1 As BI = 1, t2 As BI = 9, t3 As BI = 1, su As BI = 0, t As BI = BI.Pow(10, If(dg <= 60, 0, dg - 60)), d As BI = -1, fn As BI = 1
        For n As BI = 0 To dg - 1
            If n > 0 Then t3 = t3 * BI.Pow(n, 6)
            te = t1 * t2 / t3 : z = dg - 1 - CInt(n) * 6
            If z > 0 Then te = te * BI.Pow(10, z) Else te = te / BI.Pow(10, -z)
            If show AndAlso n < 10 Then WriteLine("{0,2} {1,62}", n, te * 32 / 3 / t)
            su += te : If te < 10 Then
                digs -= 1
                If show Then WriteLine(vbLf & "{0} iterations required for {1} digits " & _
                    "after the decimal point." & vbLf, n, digs)
                Exit For
            End If
            For j As BI = n * 6 + 1 To n * 6 + 6
                t1 = t1 * j : Next
            d += 2 : t2 += 126 + 532 * d
        Next
        Dim s As String = String.Format("{0}", isqrt(BI.Pow(10, dg * 2 + 3) _
            / su / 32 * 3 * BI.Pow(CType(10, BI), dg + 5)))
        Return s(0) & "." & s.Substring(1, digs)
    End Function

    Sub Main(ByVal args As String())
        WriteLine(dump(70, true))
    End Sub

End Module


import "/big" for BigInt, BigRat
import "/fmt" for Fmt

var factorial = Fn.new { |n|
    if (n < 2) return BigInt.one
    var fact = BigInt.one
    for (i in 2..n) fact = fact * i
    return fact
}

var almkvistGiullera = Fn.new { |n, print|
    var t1 = factorial.call(6*n) * 32
    var t2 = 532*n*n + 126*n + 9
    var t3 = factorial.call(n).pow(6)*3
    var ip = t1 * t2 / t3
    var pw = 6*n + 3
    var tm = BigRat.new(ip, BigInt.ten.pow(pw))
    if (print) {
        Fmt.print("$d  $44i  $3d  $-35s", n, ip, -pw, tm.toDecimal(33))
    } else {
        return tm
    }
}

System.print("N                               Integer Portion  Pow  Nth Term (33 dp)")
System.print("-" * 89)
for (n in 0..9) {
    almkvistGiullera.call(n, true)
}

var sum  = BigRat.zero
var prev = BigRat.zero
var prec = BigRat.new(BigInt.one, BigInt.ten.pow(70))
var n = 0
while(true) {
    var term = almkvistGiullera.call(n, false)
    sum = sum + term
    if ((sum-prev).abs < prec) break
    prev = sum
    n = n + 1
}
var pi = BigRat.one/sum.sqrt(70)
System.print("\nPi to 70 decimal places is:")
System.print(pi.toDecimal(70))


F k_prime(k, =n)
   V f = 0
   V p = 2
   L f < k & p * p <= n
      L n % p == 0
         n /= p
         f++
      p++
   R f + (I n > 1 {1} E 0) == k

F primes(k, n)
   V i = 2
   [Int] list
   L list.len < n
      I k_prime(k, i)
         list [+]= i
      i++
   R list

L(k) 1..5
   print(‘k = ’k‘: ’primes(k, 10))


BYTE FUNC IsAlmostPrime(INT num BYTE k)
  INT f,p,v

  f=0 p=2 v=num
  WHILE f<k AND p*p<=num
  DO
    WHILE v MOD p=0
    DO
      v==/p f==+1
    OD
    p==+1
  OD
  IF v>1 THEN
    f==+1
  FI
  IF f=k THEN
    RETURN (1)
  FI
RETURN (0)

PROC Main()
  BYTE count,k
  INT i

  FOR k=1 TO 5
  DO
    PrintF("k=%B:",k)
    count=0 i=2
    WHILE count<10
    DO
      IF IsAlmostPrime(i,k) THEN
        PrintF(" %I",i)
        count==+1
      FI
      i==+1
    OD
    PutE()
  OD
RETURN


with Prime_Numbers, Ada.Text_IO;

procedure Test_Kth_Prime is

   package Integer_Numbers is new
     Prime_Numbers (Natural, 0, 1, 2);
   use Integer_Numbers;

   Out_Length: constant Positive := 10; -- 10 k-th almost primes
   N: Positive; -- the "current number" to be checked

begin
   for K in 1 .. 5 loop
      Ada.Text_IO.Put("K =" & Integer'Image(K) &":  ");
      N := 2;
      for I in 1 .. Out_Length loop
	 while Decompose(N)'Length /= K loop
	    N := N + 1;
	 end loop; -- now N is Kth almost prime;
	 Ada.Text_IO.Put(Integer'Image(Integer(N)));
	 N := N + 1;
      end loop;
      Ada.Text_IO.New_Line;
   end loop;
end Test_Kth_Prime;


BEGIN
   INT examples=10, classes=5;
   MODE SEMIPRIME = STRUCT ([examples]INT data, INT count);
   [classes]SEMIPRIME semi primes;
   PROC num facs = (INT n) INT :
COMMENT
   Return number of not necessarily distinct prime factors of n.
   Not very efficient for large n ...
COMMENT
   BEGIN
      INT tf := 2, residue := n, count := 1;
      WHILE tf < residue DO
	 INT remainder = residue MOD tf;
	 ( remainder = 0 | count +:= 1; residue %:= tf | tf +:= 1 )
      OD;
      count
   END;
   PROC update table = (REF []SEMIPRIME table, INT i) BOOL :
COMMENT
   Add i to the appropriate row of the table, if any, unless that row
   is already full. Return a BOOL which is TRUE when all of the table
   is full.
COMMENT
   BEGIN
      INT k := num facs(i);
      IF k <= classes
      THEN
	 INT c = 1 + count OF table[k];
	 ( c <= examples | (data OF table[k])[c] := i; count OF table[k] := c )
      FI;
      INT sum := 0;
      FOR i TO classes DO sum +:= count OF table[i] OD;
      sum < classes * examples
   END;
   FOR i TO classes DO count OF semi primes[i] := 0 OD;
   FOR i FROM 2 WHILE update table (semi primes, i) DO SKIP OD;
   FOR i TO classes
   DO
      printf (($"k = ", d, ":", n(examples)(xg(0))l$, i, data OF semi primes[i]))
   OD
END


begin

integer function mod(a, b);
integer a, b;
mod := a-(a/b)*b;

integer function kprime(n, k);
integer n, k;
begin
    integer p, f;
    f := 0;
    p := 2;
    while f < k and p*p <= n do
    begin
        while mod(n,p) = 0 do
        begin
            n := n / p;
            f := f + 1;
        end;
        p := p + 1;
    end;
    if n > 1 then f := f + 1;
    if f = k then kprime := 1 else kprime := 0;
end;

integer i, c, k;
for k := 1 step 1 until 5 do
begin
    write("k =");
    writeon(k);
    writeon(": ");
    c := 0;
    i := 2;
    while c < 10 do
    begin
        if kprime(i, k) <> 0 then
        begin
            writeon(i);
            c := c + 1;
        end;
        i := i + 1;
    end;
end;
end


begin
    logical procedure kPrime( integer value nv, k ) ;
    begin
        integer p, f, n;
        n := nv;
        f := 0;
        while f <= k and not odd( n ) do begin
            n := n div 2;
            f := f + 1
        end while_not_odd_n ;
        p := 3;
        while f <= k and p * p <= n do begin
            while n rem p = 0 do begin
                n := n div p;
                f := f + 1
            end while_n_rem_p_eq_0 ;
            p := p + 2
        end while_f_le_k_and_p_is_a_factor ;
        if n > 1 then f := f + 1;
        f = k
    end kPrime ;
    begin
        for k := 1 until 5 do begin
            integer c, i;
            write( i_w := 1, s_w := 0, "k = ", k , ": " );
            c := 0;
            i := 2;
            while c < 10 do begin
                if kPrime( i, k ) then begin
                    writeon( i_w := 3, s_w := 0, " ", i );
                    c := c + 1
                end if_kPrime_i_k ;
                i := i + 1
            end while_c_lt_10
        end for_k
    end
end.


f←{↑r⊣⍵∘{r,∘⊂←⍺↑∪{⍵[⍋⍵]},f∘.×⍵}⍣(⍺-1)⊃r←⊂f←pco¨⍳⍵}


/* ARM assembly Raspberry PI  */
/*  program kprime.s   */

/************************************/
/* Constantes                       */
/************************************/
.equ STDOUT, 1     @ Linux output console
.equ EXIT,   1     @ Linux syscall
.equ WRITE,  4     @ Linux syscall

.equ MAXI,  10
.equ MAXIK,  5
/*********************************/
/* Initialized data              */
/*********************************/
.data
sMessDeb:           .ascii "k="
sMessValeurDeb:     .fill 11, 1, ' '            @ size => 11

sMessResult:        .ascii " "
sMessValeur:        .fill 11, 1, ' '            @ size => 11

szCarriageReturn:   .asciz "\n"

/*********************************/
/* UnInitialized data            */
/*********************************/
.bss
/*********************************/
/*  code section                 */
/*********************************/
.text
.global main
main:                                             @ entry of program
    mov r3,#1                                     @ k
1:                                                @ start loop k
    mov r0,r3
    ldr r1,iAdrsMessValeurDeb
    bl conversion10                               @ call conversion decimal
    ldr r0,iAdrsMessValeurDeb
    mov r1,#':'
    strb r1,[r0,#2]                               @ write : after k value
    mov r1,#0
    strb r1,[r0,#3]                               @ final zéro
    ldr r0,iAdrsMessDeb
    bl affichageMess                              @ display message
    mov r4,#2                                     @ n
    mov r5,#0                                     @ result counter
2:                                                @ start loop n
    mov r0,r4
    mov r1,r3
    bl kprime                                     @ is kprine ?
    cmp r0,#0
    beq 3f                                        @ no
    mov r0,r4
    ldr r1,iAdrsMessValeur
    bl conversion10                               @ call conversion decimal
    ldr r0,iAdrsMessValeur
    mov r1,#0
    strb r1,[r0,#4]                               @ final zéro
    ldr r0,iAdrsMessResult
    bl affichageMess                              @ display message
    add r5,#1                                     @ increment counter
3:
    add r4,#1                                     @ increment n
    cmp r5,#MAXI                                  @ maxi ?
    blt 2b                                        @ no -> loop
    ldr r0,iAdrszCarriageReturn
    bl affichageMess                              @ display carriage return
    add r3,#1                                     @ increment k
    cmp r3,#MAXIK                                 @ maxi ?
    ble 1b                                        @ no -> loop

100:                                              @ standard end of the program
    mov r0, #0                                    @ return code
    mov r7, #EXIT                                 @ request to exit program
    svc #0                                        @ perform the system call

iAdrsMessValeur:          .int sMessValeur
iAdrszCarriageReturn:     .int szCarriageReturn
iAdrsMessResult:          .int sMessResult
iAdrsMessValeurDeb:       .int sMessValeurDeb
iAdrsMessDeb:             .int sMessDeb
/******************************************************************/
/*     compute kprime (n,k)                                       */
/******************************************************************/
/* r0 contains n */
/* r1 contains k */
kprime:
    push {r1-r7,lr}                                   @ save  registers
    mov r5,r0                                         @ save n
    mov r7,r1                                         @ save k
    mov r4,#0                                         @ counter product
    mov r1,#2                                         @ divisor
1:                                                    @ start loop
    cmp r4,r7                                         @ counter >= k
    bge 4f                                            @ yes -> end
    mul r6,r1,r1                                      @ compute product
    cmp r6,r5                                         @ > n
    bgt 4f                                            @ yes -> end
2:                                                    @ start loop division
    mov r0,r5                                         @ dividende
    bl division                                       @ by r1
    cmp r3,#0                                         @ remainder = 0 ?
    bne 3f                                            @ no
    mov r5,r2                                         @ yes -> n = n / r1
    add r4,#1                                         @ increment counter
    b 2b                                              @ and loop
3:
    add r1,#1                                         @ increment divisor
    b 1b                                              @ and loop
4:                                                    @ end compute
    cmp r5,#1                                         @ n > 1
    addgt r4,#1                                       @ yes increment counter
    cmp r4,r7                                         @ counter = k ?
    movne r0,#0                                       @ no -> no kprime
    moveq r0,#1                                       @ yes -> kprime
100:
    pop {r1-r7,lr}                                    @ restaur registers
    bx lr                                             @return
/******************************************************************/
/*     display text with size calculation                         */
/******************************************************************/
/* r0 contains the address of the message */
affichageMess:
    push {r0,r1,r2,r7,lr}                          @ save  registres
    mov r2,#0                                      @ counter length
1:                                                 @ loop length calculation
    ldrb r1,[r0,r2]                                @ read octet start position + index
    cmp r1,#0                                      @ if 0 its over
    addne r2,r2,#1                                 @ else add 1 in the length
    bne 1b                                         @ and loop
                                                   @ so here r2 contains the length of the message
    mov r1,r0                                      @ address message in r1
    mov r0,#STDOUT                                 @ code to write to the standard output Linux
    mov r7, #WRITE                                 @ code call system "write"
    svc #0                                         @ call systeme
    pop {r0,r1,r2,r7,lr}                           @ restaur des  2 registres */
    bx lr                                          @ return
/******************************************************************/
/*     Converting a register to a decimal unsigned                */
/******************************************************************/
/* r0 contains value and r1 address area   */
/* r0 return size of result (no zero final in area) */
/* area size => 11 bytes          */
.equ LGZONECAL,   10
conversion10:
    push {r1-r4,lr}                                 @ save registers
    mov r3,r1
    mov r2,#LGZONECAL
1:                                                  @ start loop
    bl divisionpar10U                               @ unsigned  r0 <- dividende. quotient ->r0 reste -> r1
    add r1,#48                                      @ digit
    strb r1,[r3,r2]                                 @ store digit on area
    cmp r0,#0                                       @ stop if quotient = 0
    subne r2,#1                                     @ else previous position
    bne 1b                                          @ and loop
                                                    @ and move digit from left of area
    mov r4,#0
2:
    ldrb r1,[r3,r2]
    strb r1,[r3,r4]
    add r2,#1
    add r4,#1
    cmp r2,#LGZONECAL
    ble 2b
                                                      @ and move spaces in end on area
    mov r0,r4                                         @ result length
    mov r1,#' '                                       @ space
3:
    strb r1,[r3,r4]                                   @ store space in area
    add r4,#1                                         @ next position
    cmp r4,#LGZONECAL
    ble 3b                                            @ loop if r4 <= area size

100:
    pop {r1-r4,lr}                                    @ restaur registres
    bx lr                                             @return

/***************************************************/
/*   division par 10   unsigned                    */
/***************************************************/
/* r0 dividende   */
/* r0 quotient    */
/* r1 remainder   */
divisionpar10U:
    push {r2,r3,r4, lr}
    mov r4,r0                                          @ save value
    ldr r3,iMagicNumber                                @ r3 <- magic_number    raspberry 1 2
    umull r1, r2, r3, r0                               @ r1<- Lower32Bits(r1*r0) r2<- Upper32Bits(r1*r0)
    mov r0, r2, LSR #3                                 @ r2 <- r2 >> shift 3
    add r2,r0,r0, lsl #2                               @ r2 <- r0 * 5
    sub r1,r4,r2, lsl #1                               @ r1 <- r4 - (r2 * 2)  = r4 - (r0 * 10)
    pop {r2,r3,r4,lr}
    bx lr                                              @ leave function
iMagicNumber:  	.int 0xCCCCCCCD
/***************************************************/
/* integer division unsigned                       */
/***************************************************/
division:
    /* r0 contains dividend */
    /* r1 contains divisor */
    /* r2 returns quotient */
    /* r3 returns remainder */
    push {r4, lr}
    mov r2, #0                                         @ init quotient
    mov r3, #0                                         @ init remainder
    mov r4, #32                                        @ init counter bits
    b 2f
1:                                                     @ loop
    movs r0, r0, LSL #1                                @ r0 <- r0 << 1 updating cpsr (sets C if 31st bit of r0 was 1)
    adc r3, r3, r3                                     @ r3 <- r3 + r3 + C. This is equivalent to r3 ? (r3 << 1) + C
    cmp r3, r1                                         @ compute r3 - r1 and update cpsr
    subhs r3, r3, r1                                   @ if r3 >= r1 (C=1) then r3 <- r3 - r1
    adc r2, r2, r2                                     @ r2 <- r2 + r2 + C. This is equivalent to r2 <- (r2 << 1) + C
2:
    subs r4, r4, #1                                    @ r4 <- r4 - 1
    bpl 1b                                             @ if r4 >= 0 (N=0) then loop
    pop {r4, lr}
    bx lr


almostPrime: function [k, listLen][
    result: new []
    test: 2
    c: 0

    while [c < listLen][
        i: 2
        m: 0
        n: test

        while [i =< n][
            if? zero? n % i [
                n: n / i
                m: m + 1
            ]
            else -> i: i + 1
        ]
        if m = k [
            'result ++ test
            c: c + 1
        ]
        test: test + 1
    ]
    return result
]

loop 1..5 'x ->
    print ["k:" x "=>" almostPrime x 10]


REM Almost prime
FOR K = 1 TO 5
  S$ = STR$(K)
  S$ = LTRIM$(S$)
  S$ = "k = " + S$
  S$ = S$ + ":"
  PRINT S$;
  I = 2
  C = 0
  WHILE C < 10
    AN = I
    GOSUB CHECKKPRIME:
    IF ISKPRIME <> 0 THEN
      PRINT I;
      C = C + 1
    ENDIF
    I = I + 1
  WEND
  PRINT
NEXT K
END

CHECKKPRIME:
REM Check if N (AN) is a K prime (result: ISKPRIME)
F = 0
J = 2
LOOPFOR:
  ANMODJ = AN MOD J
  LOOPWHILE:
    IF ANMODJ <> 0 THEN AFTERWHILE:
    IF F = K THEN FEQK:
    F = F + 1
    AN = AN / J
    ANMODJ = AN MOD J
    GOTO LOOPWHILE:
  AFTERWHILE:
  J = J + 1
  IF J <= AN THEN LOOPFOR:
IF F = K THEN
  ISKPRIME = -1
ELSE
  ISKPRIME = 0
ENDIF
RETURN
FEQK:
ISKPRIME = 0
RETURN


kprime(n,k) {
	p:=2, f:=0
	while( (f<k) && (p*p<=n) ) {
		while ( 0==mod(n,p) ) {
			n/=p
			f++
		}
		p++
	}
	return f + (n>1) == k
}

k:=1, results:=""
while( k<=5 ) {
	i:=2, c:=0, results:=results "k =" k ":"
	while( c<10 ) {
		if (kprime(i,k)) {
			results:=results " " i
			c++
		}
		i++
	}
	results:=results "`n"
	k++
}

MsgBox % results


# syntax: GAWK -f ALMOST_PRIME.AWK
BEGIN {
    for (k=1; k<=5; k++) {
      printf("%d:",k)
      c = 0
      i = 1
      while (c < 10) {
        if (kprime(++i,k)) {
          printf(" %d",i)
          c++
        }
      }
      printf("\n")
    }
    exit(0)
}
function kprime(n,k,  f,p) {
    for (p=2; f<k && p*p<=n; p++) {
      while (n % p == 0) {
        n /= p
        f++
      }
    }
    return(f + (n > 1) == k)
}


10 DEFINT A-Z
20 FOR K=1 TO 5
30 PRINT USING "K = #:";K;
40 I=2: C=0
50 F=0: P=2: N=I
60 IF F >= K OR P*P > N THEN 100
70 IF N MOD P = 0 THEN N = N/P: F = F+1: GOTO 70
80 P = P+1
90 GOTO 60
100 IF N > 1 THEN F = F+1
110 IF F = K THEN C = C+1: PRINT USING " ###";I;
120 I = I+1
130 IF C < 10 THEN 50
140 PRINT
150 NEXT K


function kPrime(n, k)
    f = 0
    for i = 2 to n
        while n mod i = 0
            if f = k then return False
            f += 1
            n /= i
        end while
    next i
    return f = k
end function

for k = 1 to 5
    print "k = "; k; " :";
    i = 2
    c = 0
    while c < 10
        if kPrime(i, k) then
            print rjust (string(i), 4);
            c += 1
        end if
        i += 1
    end while
    print
next k
end


get "libhdr"

let kprime(n, k) = valof
$(  let f, p = 0, 2
    while f<k & p*p<=n do
    $(  while n rem p = 0 do
        $(  n := n/p
            f := f+1
        $)
        p := p+1
    $)
    if n > 1 then f := f + 1
    resultis f = k
$)

let start() be
$(  for k=1 to 5 do
    $(  let i, c = 2, 0
        writef("k = %N:", k)
        while c < 10 do
        $(  if kprime(i, k) then
            $(  writed(i, 4)
                c := c+1
            $)
            i := i+1
        $)
        wrch('*N')
    $)
$)


#include <stdio.h>

int kprime(int n, int k)
{
	int p, f = 0;
	for (p = 2; f < k && p*p <= n; p++)
		while (0 == n % p)
			n /= p, f++;

	return f + (n > 1) == k;
}

int main(void)
{
	int i, c, k;

	for (k = 1; k <= 5; k++) {
		printf("k = %d:", k);

		for (i = 2, c = 0; c < 10; i++)
			if (kprime(i, k)) {
				printf(" %d", i);
				c++;
			}

		putchar('\n');
	}

	return 0;
}


using System;
using System.Collections.Generic;
using System.Linq;

namespace AlmostPrime
{
    class Program
    {
        static void Main(string[] args)
        {
            foreach (int k in Enumerable.Range(1, 5))
            {
                KPrime kprime = new KPrime() { K = k };
                Console.WriteLine("k = {0}: {1}",
                    k, string.Join<int>(" ", kprime.GetFirstN(10)));
            }
        }
    }

    class KPrime
    {
        public int K { get; set; }

        public bool IsKPrime(int number)
        {
            int primes = 0;
            for (int p = 2; p * p <= number && primes < K; ++p)
            {
                while (number % p == 0 && primes < K)
                {
                    number /= p;
                    ++primes;
                }
            }
            if (number > 1)
            {
                ++primes;
            }
            return primes == K;
        }

        public List<int> GetFirstN(int n)
        {
            List<int> result = new List<int>();
            for (int number = 2; result.Count < n; ++number)
            {
                if (IsKPrime(number))
                {
                    result.Add(number);
                }
            }
            return result;
        }
    }
}


#include <cstdlib>
#include <iostream>
#include <sstream>
#include <iomanip>
#include <list>

bool k_prime(unsigned n, unsigned k) {
    unsigned f = 0;
    for (unsigned p = 2; f < k && p * p <= n; p++)
        while (0 == n % p) { n /= p; f++; }
    return f + (n > 1 ? 1 : 0) == k;
}

std::list<unsigned> primes(unsigned k, unsigned n)  {
    std::list<unsigned> list;
    for (unsigned i = 2;list.size() < n;i++)
        if (k_prime(i, k)) list.push_back(i);
    return list;
}

int main(const int argc, const char* argv[]) {
    using namespace std;
    for (unsigned k = 1; k <= 5; k++) {
        ostringstream os("");
        const list<unsigned> l = primes(k, 10);
        for (list<unsigned>::const_iterator i = l.begin(); i != l.end(); i++)
            os << setw(4) << *i;
        cout << "k = " << k << ':' << os.str() << endl;
    }

	return EXIT_SUCCESS;
}


(ns clojure.examples.almostprime
	(:gen-class))

(defn divisors [n]
    " Finds divisors by looping through integers 2, 3,...i.. up to sqrt (n) [note: rather than compute sqrt(), test with i*i <=n] "
    (let [div (some #(if (= 0 (mod n %)) % nil) (take-while #(<= (* % %) n) (iterate inc 2)))]
        (if div                                                         ; div = nil (if no divisor found else its the divisor)
            (into [] (concat (divisors div) (divisors (/ n div))))      ; Concat the two divisors of the two divisors
            [n])))                                                      ; Number is prime so only itself as a divisor

(defn divisors-k [k n]
    " Finds n numbers with k divisors.  Does this by looping through integers 2, 3, ... filtering (passing) ones with k divisors and
      taking the first n "
    (->> (iterate inc 2)            ; infinite sequence of numbers starting at 2
         (map divisors)             ; compute divisor of each element of sequence
         (filter #(= (count %) k))  ; filter to take only elements with k divisors
         (take n)                   ; take n elements from filtered sequence
         (map #(apply * %))))       ; compute number by taking product of divisors

(println (for [k (range 1 6)]
          (println "k:" k (divisors-k k 10))))

}


kprime = proc (n,k: int) returns (bool)
    f: int := 0
    p: int := 2
    while f<k & p*p<=n do
        while n//p=0 do
            n := n/p
            f := f+1
        end
        p := p+1
    end
    if n>1 then f:=f+1 end
    return(f=k)
end kprime

start_up = proc ()
    po: stream := stream$primary_output()
    for k: int in int$from_to(1,5) do
        i: int := 2
        c: int := 0
        stream$puts(po, "k = " || int$unparse(k) || ":")
        while c<10 do
            if kprime(i,k) then
                stream$putright(po, int$unparse(i), 4)
                c := c+1
            end
            i := i+1
        end
        stream$putl(po, "")
    end
end start_up


       IDENTIFICATION DIVISION.
       PROGRAM-ID. ALMOST-PRIME.

       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01 CONTROL-VARS.
          03 K              PIC 9.
          03 I              PIC 999.
          03 SEEN           PIC 99.
          03 N              PIC 999.
          03 P              PIC 99.
          03 P-SQUARED      PIC 9(4).
          03 F              PIC 99.
          03 N-DIV-P        PIC 999V999.
          03 FILLER         REDEFINES N-DIV-P.
             05 NEXT-N      PIC 999.
             05 FILLER      PIC 999.
                88 N-DIVS-P VALUE ZERO.

       01 OUT-VARS.
          03 K-LN           PIC X(70).
          03 K-LN-PTR       PIC 99.
          03 LN-HDR.
             05 FILLER      PIC X(4) VALUE "K = ".
             05 K-OUT       PIC 9.
             05 FILLER      PIC X VALUE ":".
          03 I-FMT.
             05 FILLER      PIC X VALUE SPACE.
             05 I-OUT       PIC ZZ9.

       PROCEDURE DIVISION.
       BEGIN.
           PERFORM K-ALMOST-PRIMES VARYING K FROM 1 BY 1
               UNTIL K IS GREATER THAN 5.
           STOP RUN.

       K-ALMOST-PRIMES.
           MOVE SPACES TO K-LN.
           MOVE 1 TO K-LN-PTR.
           MOVE ZERO TO SEEN.
           MOVE K TO K-OUT.
           STRING LN-HDR DELIMITED BY SIZE INTO K-LN
               WITH POINTER K-LN-PTR.
           PERFORM I-K-ALMOST-PRIME VARYING I FROM 2 BY 1
               UNTIL SEEN IS EQUAL TO 10.
           DISPLAY K-LN.

       I-K-ALMOST-PRIME.
           MOVE ZERO TO F, P-SQUARED.
           MOVE I TO N.
           PERFORM PRIME-FACTOR VARYING P FROM 2 BY 1
               UNTIL F IS NOT LESS THAN K
               OR P-SQUARED IS GREATER THAN N.
           IF N IS GREATER THAN 1, ADD 1 TO F.
           IF F IS EQUAL TO K,
               MOVE I TO I-OUT,
               ADD 1 TO SEEN,
               STRING I-FMT DELIMITED BY SIZE INTO K-LN
                   WITH POINTER K-LN-PTR.

       PRIME-FACTOR.
           MULTIPLY P BY P GIVING P-SQUARED.
           DIVIDE N BY P GIVING N-DIV-P.
           PERFORM DIVIDE-FACTOR UNTIL NOT N-DIVS-P.

       DIVIDE-FACTOR.
           MOVE NEXT-N TO N.
           ADD 1 TO F.
           DIVIDE N BY P GIVING N-DIV-P.


F is_not_deranged(s1, s2)
   L(i) 0 .< s1.len
      I s1[i] == s2[i]
         R 1B
   R 0B

Dict[String, Array[String]] anagram
V count = 0
L(word) File(‘unixdict.txt’).read().split("\n")
   V a = sorted(word).join(‘’)
   I a !C anagram
      anagram[a] = [word]
   E
      L(ana) anagram[a]
         I is_not_deranged(ana, word)
            L.break
      L.was_no_break
         anagram[a].append(word)
         count = max(count, word.len)

L(ana) anagram.values()
   I ana.len > 1 & ana[0].len == count
      print(ana)


(defun start ()
  (loop for k from 1 to 5
    do (format t "k = ~a: ~a~%" k (collect-k-almost-prime k))))

(defun collect-k-almost-prime (k &optional (d 2) (lst nil))
  (cond ((= (length lst) 10) (reverse lst))
        ((= (?-primality d) k) (collect-k-almost-prime k (+ d 1) (cons d lst)))
        (t (collect-k-almost-prime k (+ d 1) lst))))

(defun ?-primality (n &optional (d 2) (c 0))
  (cond ((> d (isqrt n)) (+ c 1))
        ((zerop (rem n d)) (?-primality (/ n d) d (+ c 1)))
        (t (?-primality n (+ d 1) c))))


include "cowgol.coh";

sub kprime(n: uint8, k: uint8): (kp: uint8) is
    var p: uint8 := 2;
    var f: uint8 := 0;
    while f < k and p*p <= n loop
        while 0 == n % p loop
            n := n / p;
            f := f + 1;
        end loop;
        p := p + 1;
    end loop;
    if n > 1 then
        f := f + 1;
    end if;
    if f == k then
        kp := 1;
    else
        kp := 0;
    end if;
end sub;

var k: uint8 := 1;
while k <= 5 loop
    print("k = ");
    print_i8(k);
    print(":");

    var i: uint8 := 2;
    var c: uint8 := 0;
    while c < 10 loop
        if kprime(i,k) != 0 then
            print(" ");
            print_i8(i);
            c := c + 1;
        end if;
        i := i + 1;
    end loop;
    print_nl();
    k := k + 1;
end loop;


/* ARM assembly AARCH64 Raspberry PI 3B */
/*  program anaderan64.s   */

/*******************************************/
/* Constantes file                         */
/*******************************************/
/* for this file see task include a file in language AArch64 assembly*/
.include "../includeConstantesARM64.inc"

.equ MAXI,         50000
.equ BUFFERSIZE,   300000

/*********************************/
/* Structures                    */
/*********************************/
/* this structure has size multiple de 8 */
/* see task anagram for program not use structure */
    .struct  0
Word_Ptr_buffer:                           // p.quader word buffer
    .struct  Word_Ptr_buffer + 8
Word_Ptr_sorted:                           // p.quader word sorted letters
    .struct  Word_Ptr_sorted + 8
Word_length:                               // word length
    .struct  Word_length + 8
Word_top:                                  // top
    .struct  Word_top + 8
Word_end:
/*********************************/
/* Initialized data              */
/*********************************/
.data
szFileName:           .asciz "./unixdict.txt"
//szFileName:           .asciz "./listwordT.txt"
szMessErreur:         .asciz "FILE ERROR."
szMessStart:          .asciz "Program 64 bits start.\n"
szCarriageReturn:     .asciz "\n"
szMessSpace:          .asciz " "

ptBuffex1:            .quad sBuffex1
/*********************************/
/* UnInitialized data            */
/*********************************/
.bss
tbStWords:                  .skip Word_end * MAXI
qNBword:                    .skip 8
sBuffer:                    .skip BUFFERSIZE
sBuffex1:                   .skip BUFFERSIZE

/*********************************/
/*  code section                 */
/*********************************/
.text
.global main
main:                      // entry of program
    ldr x0,qAdrszMessStart
    bl affichageMess
    mov x4,#0              // loop indice
    mov x0,AT_FDCWD        // current directory
    ldr x1,qAdrszFileName  // file name
    mov x2,#O_RDWR         // flags
    mov x3,#0              // mode
    mov x8,#OPEN           //
    svc 0
    cmp x0,#0              // error open
    ble 99f
    mov x9,x0              // FD save Fd
    ldr x1,qAdrsBuffer     // buffer address
    ldr x2,qSizeBuf        // buffersize
    mov x8, #READ
    svc 0
    cmp x0,#0              // error read ?
    blt 99f
    mov x5,x0              // save size read bytes
    ldr x4,qAdrsBuffer     // buffer address
    ldr x0,qAdrsBuffer     // start word address
    mov x2,#0
    mov x1,#0              // word length
1:
    cmp x2,x5
    bge 2f
    ldrb w3,[x4,x2]
    cmp w3,#0xD            // end word ?
    cinc x1,x1,ne          // increment word length
    cinc x2,x2,ne          // increment indice
    bne 1b                 // and loop
    strb wzr,[x4,x2]        // store final zero
    bl anaWord             // sort word letters
    add x2,x2,#2           // jump OD and 0A
    add x0,x4,x2           // new address begin word
    mov x1,#0              // init length
    b 1b                   // and loop

2:
    strb wzr,[x4,x2]       // last word
    bl anaWord

    mov x0,x9              // file Fd
    mov x8, #CLOSE
    svc 0
    cmp x0,#0              // error close ?
    blt 99f

    ldr x0,qAdrtbStWords   // array structure words address
    mov x1,#0              // first indice
    ldr x2,qAdrqNBword
    ldr x2,[x2]            // last indice
    bl triRapide           // quick sort
    ldr x4,qAdrtbStWords   // array structure words address
    mov x0,x4
    mov x9,x2                     // size word array
    mov x8,#0                     // indice first occurence
    ldr x3,[x4,#Word_Ptr_sorted]  // load first value
    mov x2,#1                     // loop indice
    mov x10,#Word_end             // words structure size
    mov x12,#0                    // max word length
3:                                // begin loop
    madd x7,x2,x10,x4              // compute array index
    ldr x5,[x7,#Word_Ptr_sorted]  // load next value
    mov x0,x3
    mov x1,x5
    bl comparStrings
    cmp x0,#0                     // sorted strings equal ?
    bne 4f
    madd x11,x8,x10,x4
    ldr x0,[x11,#Word_Ptr_buffer] // address word 1
    ldr x1,[x7,#Word_Ptr_buffer]  // address word 2
    bl controlLetters
    cmp x0,#0                     // not ok ?
    beq 5f
    mov x0,#1                     // letters ok
    str x0,[x7,#Word_top]         // store top in first occurence
    str x0,[x11,#Word_top]        // store top in current occurence
    ldr x0,[x7,#Word_length]      // word length
    cmp x0,x12                    // compare maxi
    csel x12,x0,x12,gt            // yes  length word -> value max
    b 5f
4:                                // no
    mov x0,x8
    add x8,x8,#1                  // init index  new first occurence
    madd x11,x8,x10,x4             // compute array index
    ldr x3,[x11,#Word_Ptr_sorted] // init value new first occurence
    mov x2,x0                     // reprise au debut de la sequence
5:
    add x2,x2,#1                  // increment indice
    cmp x2,x9                     // end word array ?
    blt 3b                        // no -> loop

    mov x2,#0                     // raz indice
    ldr x4,qAdrtbStWords          // array structure words address
6:                                // begin display loop
    madd x11,x2,x10,x4             // compute array index
    ldr x6,[x11,#Word_top]        // load top
    cmp x6,#0                     // top ok ?
    beq 7f
    ldr x6,[x11,#Word_length]     // load length
    cmp x6,x12                    // compare maxi
    bne 7f
    ldr x0,[x11,#Word_Ptr_buffer] // load address first word
    bl affichageMess              // display first word
    add x2,x2,#1                  // increment indice

    madd x11,x2,x10,x4             // compute array index
    ldr x6,[x11,#Word_top]        // load top
    cmp x6,#0                     // top ok ?
    beq 7f
    ldr x0,qAdrszMessSpace
    bl affichageMess
    ldr x0,[x11,#Word_Ptr_buffer] // load address other word
    bl affichageMess              // display second word

    ldr x0,qAdrszCarriageReturn
    bl affichageMess
7:
    add x2,x2,#1                  // increment indice
    cmp x2,x9                     // maxi ?
    blt 6b                        // no -> loop

    b 100f
99:                               // display error
    ldr x0,qAdrszMessErreur
    bl affichageMess

100:                              // standard end of the program
    mov x0, #0                    // return code
    mov x8, #EXIT                 // request to exit program
    svc #0                        // perform the system call
qAdrszCarriageReturn:        .quad szCarriageReturn
qAdrszFileName:              .quad szFileName
qAdrszMessErreur:            .quad szMessErreur
qAdrsBuffer:                 .quad sBuffer
qSizeBuf:                    .quad BUFFERSIZE
qAdrszMessSpace:             .quad szMessSpace
qAdrtbStWords:               .quad tbStWords
qAdrszMessStart:             .quad szMessStart
/******************************************************************/
/*     analizing word                                   */
/******************************************************************/
/*  x0  word address */
/*  x1 word length   */
anaWord:
    stp x1,lr,[sp,-16]!           // save  registers
    stp x2,x3,[sp,-16]!           // save  registers
    stp x4,x5,[sp,-16]!           // save  registers
    stp x6,x7,[sp,-16]!           // save  registers
    mov x5,x0
    mov x6,x1
    ldr x1,qAdrtbStWords
    ldr x2,qAdrqNBword
    ldr x3,[x2]
    mov x4,#Word_end
    madd x1,x3,x4,x1
    str x0,[x1,#Word_Ptr_buffer]
    mov x0,#0
    str x0,[x1,#Word_top]
    str x6,[x1,#Word_length]
    ldr x4,qAdrptBuffex1
    ldr x0,[x4]
    add x6,x6,x0
    add x6,x6,#1
    str x6,[x4]
    str x0,[x1,#Word_Ptr_sorted]

    add x3,x3,#1
    str x3,[x2]
    mov x1,x0
    mov x0,x5
    bl triLetters         // sort word letters
    mov x2,#0
100:
    ldp x6,x7,[sp],16              // restaur  2 registers
    ldp x4,x5,[sp],16              // restaur  2 registers
    ldp x2,x3,[sp],16              // restaur  2 registers
    ldp x1,lr,[sp],16              // restaur  2 registers
    ret                            // return to address lr x30
qAdrqNBword:            .quad qNBword
qAdrptBuffex1:          .quad ptBuffex1
/******************************************************************/
/*     sort word letters                                  */
/******************************************************************/
/* x0  address begin word */
/* x1  address recept array */
triLetters:
    stp x1,lr,[sp,-16]!           // save  registers
    stp x2,x3,[sp,-16]!           // save  registers
    stp x4,x5,[sp,-16]!           // save  registers
    stp x6,x7,[sp,-16]!           // save  registers
    mov x2,#0
1:
    ldrb w3,[x0,x2]         // load letter
    cmp w3,#0               // end word ?
    beq 6f
    cmp x2,#0               // first letter ?
    bne 2f
    strb w3,[x1,x2]         // yes store in first position
    add x2,x2,#1            // increment indice
    b 1b                    // and loop
2:
    mov x4,#0
3:                          // begin loop to search insertion position
    ldrb w5,[x1,x4]         // load letter
    cmp w3,w5               // compare
    blt 4f                  // to low -> insertion
    add x4,x4,#1            // increment indice
    cmp x4,x2               // compare to letters number in place
    blt 3b                  // search loop
    strb w3,[x1,x2]         // else store in last position
    add x2,x2,#1
    b 1b                    // and loop
4:                          // move first letters in one position
    sub x6,x2,#1            // start indice
5:
    ldrb w5,[x1,x6]         // load letter
    add x7,x6,#1            // store indice - 1
    strb w5,[x1,x7]         // store letter
    sub x6,x6,#1            // decrement indice
    cmp x6,x4               // end ?
    bge 5b                  // no loop
    strb w3,[x1,x4]         // else store letter in free position
    add x2,x2,#1
    b 1b                    // and loop
6:
    strb wzr,[x1,x2]        // final zéro
100:
    ldp x6,x7,[sp],16              // restaur  2 registers
    ldp x4,x5,[sp],16              // restaur  2 registers
    ldp x2,x3,[sp],16              // restaur  2 registers
    ldp x1,lr,[sp],16              // restaur  2 registers
    ret                            // return to address lr x30
/******************************************************************/
/*     control letters                                  */
/******************************************************************/
/* x0  address  word 1*/
/* x1  address  word 2 */
controlLetters:
    stp x1,lr,[sp,-16]!           // save  registers
    stp x2,x3,[sp,-16]!           // save  registers
    stp x4,x5,[sp,-16]!           // save  registers
    mov x2,#0
    mov x5,x0
1:
    ldrb w3,[x5,x2]      // load a letter
    cmp w3,#0            // end word ?
    cset x0,eq
   // moveq x0,#1          //  yes it is OK
    beq 100f
    ldrb w4,[x1,x2]      // load a letter word 2 same position
    cmp w3,w4            // equal ?
    cset x0,ne           // yes -> not good
    //moveq x0,#0          // yes -> not good
    beq 100f
    add x2,x2,#1
    b 1b
100:
    ldp x4,x5,[sp],16              // restaur  2 registers
    ldp x2,x3,[sp],16              // restaur  2 registers
    ldp x1,lr,[sp],16              // restaur  2 registers
    ret                            // return to address lr x30
/***************************************************/
/*   Appel récursif Tri Rapide quicksort           */
/***************************************************/
/* x0 contains the address of table */
/* x1 contains index of first item  */
/* x2 contains the number of elements  > 0  */
triRapide:
    stp x1,lr,[sp,-16]!           // save  registers
    stp x2,x3,[sp,-16]!           // save  registers
    stp x4,x5,[sp,-16]!           // save  registers
    sub x2,x2,#1               // last item index
    cmp x1,x2               // first > last ?
    bge 100f                // yes -> end
    mov x4,x0               // save x0
    mov x5,x2               // save x2
    bl partition1           // cutting.quado 2 parts
    mov x2,x0               // index partition
    mov x0,x4               // table address
    bl triRapide            // sort lower part
    mov x0,x4               // table address
    add x1,x2,#1            // index begin = index partition + 1
    add x2,x5,#1            // number of elements
    bl triRapide            // sort higter part

 100:                       // end function
    ldp x4,x5,[sp],16       // restaur  2 registers
    ldp x2,x3,[sp],16       // restaur  2 registers
    ldp x1,lr,[sp],16       // restaur  2 registers
    ret                     // return to address lr x30

/******************************************************************/
/*      Partition table elements                                */
/******************************************************************/
/* x0 contains the address of table */
/* x1 contains index of first item  */
/* x2 contains index of last item   */
partition1:
    stp x1,lr,[sp,-16]!     // save  registers
    stp x2,x3,[sp,-16]!     // save  registers
    stp x4,x5,[sp,-16]!     // save  registers
    stp x6,x7,[sp,-16]!     // save  registers
    stp x8,x9,[sp,-16]!     // save  registers
    mov x8,x0               // save address table 2
    mov x7,x2
    mov x9,#Word_end
    madd x3,x7,x9,x8
    ldr x6,[x3,#Word_Ptr_sorted]  // load string address last index
    mov x4,x1               // init with first index
    mov x5,x1               // init with first index
1:                          // begin loop
    madd x3,x5,x9,x8
    ldr x0,[x3,#Word_Ptr_sorted]   // load current string address
    mov x1,x6                      // first string address
    bl comparStrings
    cmp x0,#0
    bge 2f
    mov x0,x8                // current string < first string
    mov x1,x4                // swap array
    mov x2,x5
    bl swapWord
    add x4,x4,#1             // and increment index 1
2:
    add x5,x5,#1             // increment index 2
    cmp x5,x7                // end ?
    blt 1b                   // no -> loop

    mov x0,x8                // and swap array
    mov x1,x4
    mov x2,x7
    bl swapWord

    mov x0,x4                // return index partition
100:
    ldp x8,x9,[sp],16       // restaur  2 registers
    ldp x6,x7,[sp],16       // restaur  2 registers
    ldp x4,x5,[sp],16       // restaur  2 registers
    ldp x2,x3,[sp],16       // restaur  2 registers
    ldp x1,lr,[sp],16       // restaur  2 registers
    ret                     // return to address lr x30
/******************************************************************/
/*      Swap table elements                                */
/******************************************************************/
/* x0 contains the address of table */
/* x1 contains index 1  */
/* x2 contains index  2   */
swapWord:
    stp x1,lr,[sp,-16]!           // save  registers
    stp x2,x3,[sp,-16]!           // save  registers
    stp x4,x5,[sp,-16]!           // save  registers
    stp x6,x7,[sp,-16]!           // save  registers
    mov x3,#Word_end
    madd x4,x1,x3,x0        // compute array index
    madd x5,x2,x3,x0
    mov x6,#0
1:
    ldr x2,[x4,x6]         // load 4 bytes
    ldr x3,[x5,x6]
    str x2,[x5,x6]         // store 4 bytes
    str x3,[x4,x6]
    add x6,x6,#8           // increment 4 bytes
    cmp x6,#Word_end       // structure size is multiple to 4
    blt 1b
100:
    ldp x6,x7,[sp],16              // restaur  2 registers
    ldp x4,x5,[sp],16              // restaur  2 registers
    ldp x2,x3,[sp],16              // restaur  2 registers
    ldp x1,lr,[sp],16              // restaur  2 registers
    ret                            // return to address lr x30

/************************************/
/* Strings case sensitive comparisons  */
/************************************/
/* x0 et x1 contains the address of strings */
/* return 0 in x0 if equals */
/* return -1 if string x0 < string x1 */
/* return 1  if string x0 > string x1 */
comparStrings:
    stp x1,lr,[sp,-16]! // save  registers
    stp x2,x3,[sp,-16]! // save  registers
    stp x4,x5,[sp,-16]! // save  registers
    mov x2,#0           // counter
1:
    ldrb w3,[x0,x2]     // byte string 1
    ldrb w4,[x1,x2]     // byte string 2
    cmp w3,w4
    blt 2f              // small
    bgt 3f              // greather
    cmp x3,#0           // 0 end string
    beq 4f              // end string
    add x2,x2,#1        // else add 1 in counter
    b 1b                // and loop
2:
    mov x0,#-1          // small
    b 100f
3:
    mov x0,#1           // greather
    b 100f
4:
   mov x0,#0            // equal
100:
    ldp x4,x5,[sp],16   // restaur  2 registers
    ldp x2,x3,[sp],16   // restaur  2 registers
    ldp x1,lr,[sp],16   // restaur  2 registers
    ret                 // return to address lr x30

/********************************************************/
/*        File Include fonctions                        */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"


with Ada.Text_IO; use Ada.Text_IO;
with Ada.Containers.Generic_Array_Sort;
with Ada.Containers.Indefinite_Vectors;
procedure Danagrams is
   package StringVector is new Ada.Containers.Indefinite_Vectors
      (Positive, String);
   procedure StrSort is new Ada.Containers.Generic_Array_Sort
      (Index_Type => Positive,
      Element_Type => Character,
      Array_Type => String);
   function Derange (s1 : String; s2 : String) return Boolean is begin
      for i in s1'Range loop
         if (s1 (i) = s2 (i)) then return False; end if;
      end loop;
      return True;
   end Derange;
   File : File_Type;
   len, foundlen : Positive := 1;
   Vect, SVect : StringVector.Vector;
   index, p1, p2 : StringVector.Extended_Index := 0;
begin
   Open (File, In_File, "unixdict.txt");
   while not End_Of_File (File) loop
      declare str : String := Get_Line (File);
      begin
         len := str'Length;
         if len > foundlen then
            Vect.Append (str);
            StrSort (str);
            index := 0;
            loop --  Loop through anagrams by index in vector of sorted strings
               index := SVect.Find_Index (str, index + 1);
               exit when index = StringVector.No_Index;
               if Derange (Vect.Last_Element, Vect.Element (index)) then
                     p1 := Vect.Last_Index; p2 := index;
                     foundlen := len;
               end if;
            end loop;
            SVect.Append (str);
         end if;
      end;
   end loop;
   Close (File);
   Put_Line (Vect.Element (p1) & " " & Vect.Element (p2));
end Danagrams;


import std.stdio, std.algorithm, std.traits;

Unqual!T[] decompose(T)(in T number) pure nothrow
in {
    assert(number > 1);
} body {
    typeof(return) result;
    Unqual!T n = number;

    for (Unqual!T i = 2; n % i == 0; n /= i)
        result ~= i;
    for (Unqual!T i = 3; n >= i * i; i += 2)
        for (; n % i == 0; n /= i)
            result ~= i;

    if (n != 1)
        result ~= n;
    return result;
}

void main() {
    enum outLength = 10; // 10 k-th almost primes.

    foreach (immutable k; 1 .. 6) {
        writef("K = %d: ", k);
        auto n = 2; // The "current number" to be checked.
        foreach (immutable i; 1 .. outLength + 1) {
            while (n.decompose.length != k)
                n++;
            // Now n is K-th almost prime.
            write(n, " ");
            n++;
        }
        writeln;
    }
}


program AlmostPrime;

{$APPTYPE CONSOLE}

function IsKPrime(const n, k: Integer): Boolean;
var
  p, f, v: Integer;
begin
  f := 0;
  p := 2;
  v := n;
  while (f < k) and (p*p <= n) do begin
    while (v mod p) = 0 do begin
      v := v div p;
      Inc(f);
    end;
    Inc(p);
  end;
  if v > 1 then Inc(f);
  Result := f = k;
end;

var
  i, c, k: Integer;

begin
  for k := 1 to 5 do begin
    Write('k = ', k, ':');
    c := 0;
    i := 2;
    while c < 10 do begin
      if IsKPrime(i, k) then begin
        Write(' ', i);
        Inc(c);
      end;
      Inc(i);
    end;
    WriteLn;
  end;
end.


# find the largest deranged anagrams in a list of words              #
# use the associative array in the Associate array/iteration task    #
PR read "aArray.a68" PR

# returns the length of str                                          #
OP LENGTH = ( STRING str )INT: 1 + ( UPB str - LWB str );

# returns TRUE if a and b are the same length and have no            #
# identical characters at any position,                              #
# FALSE otherwise                                                    #
PRIO ALLDIFFER = 9;
OP   ALLDIFFER = ( STRING a, b )BOOL:
     IF LENGTH a /= LENGTH b
     THEN
        # the two stringa are not the same size                      #
        FALSE
     ELSE
        # the strings are the same length, check the characters      #
        BOOL result := TRUE;
        INT  b pos  := LWB b;
        FOR a pos FROM LWB a TO UPB a WHILE result := ( a[ a pos ] /= b[ b pos ] )
        DO
            b pos +:= 1
        OD;
        result
     FI # ALLDIFFER # ;

# returns text with the characters sorted                            #
OP   SORT = ( STRING text )STRING:
     BEGIN
        STRING sorted := text;
        FOR end pos FROM UPB sorted - 1 BY -1 TO LWB sorted
        WHILE
            BOOL swapped := FALSE;
            FOR pos FROM LWB sorted TO end pos DO
                IF sorted[ pos ] > sorted[ pos + 1 ]
                THEN
                    CHAR  t           := sorted[ pos     ];
                    sorted[ pos     ] := sorted[ pos + 1 ];
                    sorted[ pos + 1 ] := t;
                    swapped           := TRUE
                FI
            OD;
            swapped
        DO SKIP OD;
        sorted
     END # SORTED # ;

# read the list of words and find the longest deranged anagrams      #

CHAR separator = "|"; # character that will separate the anagrams    #

IF  FILE input file;
    STRING file name = "unixdict.txt";
    open( input file, file name, stand in channel ) /= 0
THEN
    # failed to open the file #
    print( ( "Unable to open """ + file name + """", newline ) )
ELSE
    # file opened OK #
    BOOL at eof := FALSE;
    # set the EOF handler for the file #
    on logical file end( input file, ( REF FILE f )BOOL:
                                     BEGIN
                                         # note that we reached EOF on the #
                                         # latest read #
                                         at eof := TRUE;
                                         # return TRUE so processing can continue #
                                         TRUE
                                     END
                       );
    REF AARRAY words := INIT LOC AARRAY;
    STRING word;
    INT    longest derangement := 0;
    STRING longest word        := "<none>";
    STRING longest anagram     := "<none>";
    WHILE NOT at eof
    DO
        STRING word;
        get( input file, ( word, newline ) );
        INT    word length = LENGTH word;
        IF  word length >= longest derangement
        THEN
            # this word is at least long as the longest derangement   #
            # found so far - test it                                  #
            STRING sorted word = SORT word;
            IF ( words // sorted word ) /= ""
            THEN
                # we already have this sorted word - test for         #
                # deranged anagrams                                   #
                # the word list will have a leading separator         #
                # and be followed by one or more words separated by   #
                # the separator                                       #
                STRING word list   := words // sorted word;
                INT    list pos    := LWB word list + 1;
                INT    list max     = UPB word list;
                BOOL   is deranged := FALSE;
                WHILE  list pos < list max
                  AND  NOT is deranged
                DO
                    STRING anagram = word list[ list pos : ( list pos + word length ) - 1 ];
                    IF  is deranged := word ALLDIFFER anagram
                    THEN
                        # have a deranged anagram                     #
                        longest derangement := word length;
                        longest word        := word;
                        longest anagram     := anagram
                    FI;
                    list pos +:= word length + 1
                OD
            FI;
            # add the word to the anagram list                        #
            words // sorted word +:= separator + word
        FI
    OD;
    close( input file );
    print( ( "Longest deranged anagrams: "
           , longest word
           , " and "
           , longest anagram
           , newline
           )
         )
FI


proc nonrec kprime(word n, k) bool:
    word f, p;
    f := 0;
    p := 2;
    while f < k and p*p <= n do
        while n%p = 0 do
            n := n/p;
            f := f+1
        od;
        p := p+1
    od;
    if n>1 then f+1 = k
    else f = k
    fi
corp

proc nonrec main() void:
    byte k, i, c;
    for k from 1 upto 5 do
        write("k = ", k:1, ":");
        i := 2;
        c := 0;
        while c < 10 do
            if kprime(i,k) then
                write(i:4);
                c := c+1
            fi;
            i := i+1
        od;
        writeln()
    od
corp


(define (almost-prime? p k)
	(= k (length (prime-factors p))))

(define (almost-primes k nmax)
	(take (filter (rcurry almost-prime? k) [2 ..]) nmax))

(define (task (kmax 6) (nmax 10))
	(for ((k [1 .. kmax]))
		(write 'k= k '|)
		(for-each write (almost-primes k nmax))
		(writeln)))


use AppleScript version "2.3.1" -- OS X 10.9 (Mavericks) or later — for these 'use' commands!
-- Uses the customisable AppleScript-coded sort shown at <https://macscripter.net/viewtopic.php?pid=194430#p194430>.
-- It's assumed scripters will know how and where to install it as a library.
use sorter : script "Custom Iterative Ternary Merge Sort"
use scripting additions

on longestDerangedAnagrams(listOfWords)
    script o
        property wordList : listOfWords
        property doctoredWords : {}
        property hitLength : 0
        property output : {}

        -- Test for any deranged pairs amongst the words of an anagram group.
        on testPairs(a, b)
            set anagramGroup to items a thru b of my wordList
            set groupCount to b - a + 1
            set wordLength to (count beginning of anagramGroup)
            repeat with i from 1 to (groupCount - 1)
                set w1 to item i of anagramGroup
                repeat with j from (i + 1) to groupCount
                    set w2 to item j of anagramGroup
                    set areDeranged to true
                    repeat with c from 1 to wordLength
                        if (character c of w1 = character c of w2) then
                            set areDeranged to false
                            exit repeat
                        end if
                    end repeat
                    -- Append any deranged pairs found to the output list and note their word length.
                    if (areDeranged) then
                        set end of my output to {w1, w2}
                        set hitLength to wordLength
                    end if
                end repeat
            end repeat
        end testPairs
    end script

    ignoring case
        -- Build another list containing doctored versions of the input words with their characters lexically sorted.
        set astid to AppleScript's text item delimiters
        set AppleScript's text item delimiters to ""
        repeat with thisWord in o's wordList
            set theseChars to thisWord's characters
            -- A straight ascending in-place sort here.
            tell sorter to sort(theseChars, 1, -1, {}) -- Params: (list, start index, end index, customisation spec.).
            set end of o's doctoredWords to theseChars as text
        end repeat
        set AppleScript's text item delimiters to astid

        -- Sort the list of doctored words into descending order by length and ascending order by value within
        -- each length, rearranging the original-word list in parallel to maintain the index correspondence.
        script descendingByLengthAscendingByValue
            on isGreater(a, b)
                set lenA to (count a)
                set lenB to (count b)
                if (lenA = lenB) then return (a > b)
                return (lenB > lenA)
            end isGreater
        end script
        tell sorter to sort(o's doctoredWords, 1, -1, {comparer:descendingByLengthAscendingByValue, slave:{o's wordList}})

        -- Locate each run of equal doctored words and test the corresponding originals for deranged pairs.
        set i to 1
        set currentText to beginning of o's doctoredWords
        repeat with j from 2 to (count o's doctoredWords)
            set thisText to item j of o's doctoredWords
            if (thisText is not currentText) then
                if (j - i > 1) then tell o to testPairs(i, j - 1)
                set currentText to thisText
                set i to j
            end if
            -- Stop on reaching a word shorter than the longest derangement(s) found.
            if ((count thisText) < o's hitLength) then exit repeat
        end repeat
        if (j > i) then tell o to testPairs(i, j)
    end ignoring

    return o's output
end longestDerangedAnagrams

-- The closing values of AppleScript 'run handler' variables not explicity declared local are
-- saved back to the script file afterwards — and "unixdict.txt" contains 25,104 words!
local wordFile, wordList
-- The words in "unixdict.txt" are arranged one per line in alphabetical order.
-- Some contain punctuation characters, so they're best extracted as 'paragraphs' rather than as 'words'.
set wordFile to ((path to desktop as text) & "unixdict.txt") as «class furl»
set wordList to paragraphs of (read wordFile as «class utf8»)
return longestDerangedAnagrams(wordList)


defmodule Factors do
  def factors(n), do: factors(n,2,[])

  defp factors(1,_,acc), do: acc
  defp factors(n,k,acc) when rem(n,k)==0, do: factors(div(n,k),k,[k|acc])
  defp factors(n,k,acc)                 , do: factors(n,k+1,acc)

  def kfactors(n,k), do: kfactors(n,k,1,1,[])

  defp kfactors(_tn,tk,_n,k,_acc) when k == tk+1, do: IO.puts "done! "
  defp kfactors(tn,tk,_n,k,acc) when length(acc) == tn do
    IO.puts "K: #{k} #{inspect acc}"
    kfactors(tn,tk,2,k+1,[])
  end
  defp kfactors(tn,tk,n,k,acc) do
    case length(factors(n)) do
      ^k -> kfactors(tn,tk,n+1,k,acc++[n])
      _  -> kfactors(tn,tk,n+1,k,acc)
    end
  end
end

Factors.kfactors(10,5)


-module(factors).
-export([factors/1,kfactors/0,kfactors/2]).

factors(N) ->
     factors(N,2,[]).

factors(1,_,Acc) -> Acc;
factors(N,K,Acc) when N rem K == 0 ->
    factors(N div K,K, [K|Acc]);
factors(N,K,Acc) ->
    factors(N,K+1,Acc).

kfactors() -> kfactors(10,5,1,1,[]).
kfactors(N,K) -> kfactors(N,K,1,1,[]).
kfactors(_Tn,Tk,_N,K,_Acc) when K == Tk+1 ->  io:fwrite("Done! ");
kfactors(Tn,Tk,N,K,Acc) when length(Acc) == Tn  ->
    io:format("K: ~w ~w ~n", [K, Acc]),
    kfactors(Tn,Tk,2,K+1,[]);

kfactors(Tn,Tk,N,K,Acc) ->
    case length(factors(N)) of K ->
     kfactors(Tn,Tk, N+1,K, Acc ++ [ N ] );
      _ ->
      kfactors(Tn,Tk, N+1,K, Acc) end.