def addNums(x: String, y: String) = {
  val padSize = x.length max y.length
  val paddedX = "0" * (padSize - x.length) + x
  val paddedY = "0" * (padSize - y.length) + y
  val (sum, carry) = (paddedX zip paddedY).foldRight(("", 0)) {
    case ((dx, dy), (acc, carry)) =>
      val sum = dx.asDigit + dy.asDigit + carry
      ((sum % 10).toString + acc, sum / 10)
  }
  if (carry != 0) carry.toString + sum else sum
}

def multByDigit(num: String, digit: Int) = {
  val (mult, carry) = num.foldRight(("", 0)) {
    case (d, (acc, carry)) =>
      val mult = d.asDigit * digit + carry
      ((mult % 10).toString + acc, mult / 10)
  }
  if (carry != 0) carry.toString + mult else mult
}

def mult(x: String, y: String) =
  y.foldLeft("")((acc, digit) => addNums(acc + "0", multByDigit(x, digit.asDigit)))


L := proc(n, L_0, L_1, add)
if n = 0 then
  return L_0;
elif n = 1 then
  return L_1;
else
  return L(n - 1) + L(n - 2) + add;
end if;
end proc:

Leonardo := n -> (L(1, 1, 1),[seq(0..n - 1)])

Fibonacci := n -> (L(0, 1, 0), [seq(0..n - 1)])


(over over + rolldown pop pick +) :next
(('print dip " " print! next) 25 times newline) :leo

"First 25 Leonardo numbers:" puts!
1 1 1 leo
"First 25 Leonardo numbers with add=0, L(0)=0, L(1)=1:" puts!
0 0 1 leo


MODULE Leonardo;
FROM FormatString IMPORT FormatString;
FROM Terminal IMPORT WriteString,WriteLn,ReadChar;

PROCEDURE leonardo(a,b,step,num : INTEGER);
VAR
    buf : ARRAY[0..63] OF CHAR;
    i,temp : INTEGER;
BEGIN
    FOR i:=1 TO num DO
        IF i=1 THEN
            FormatString(" %i", buf, a);
            WriteString(buf)
        ELSIF i=2 THEN
            FormatString(" %i", buf, b);
            WriteString(buf)
        ELSE
            FormatString(" %i", buf, a+b+step);
            WriteString(buf);

            temp := a;
            a := b;
            b := temp + b + step
        END
    END;
    WriteLn
END leonardo;

BEGIN
    leonardo(1,1,1,25);
    leonardo(0,1,0,25);

    ReadChar
END Leonardo.


(define one (lambda (f) (lambda (x) (f x))))
(define (add a b) (lambda (f) (lambda (x) ((a f) ((b f) x)))))
(define (mult a b) (lambda (f) (lambda (x) ((a (b f)) x))))
(define (expo a b) (lambda (f) (lambda (x) (((b a) f) x))))
(define two (add one one))
(define six (add two (add two two)))
(define sixty-four (expo two six))
(display (mult (expo two sixty-four) (expo two sixty-four)))


$ include "seed7_05.s7i";
  include "bigint.s7i";

const proc: main is func
  begin
    writeln(2_**64 * 2_**64);
  end func;


import strformat

proc leonardoNumbers(count: int, L0: int = 1,
                     L1: int = 1, ADD: int = 1) =
  var t = 0
  var (L0_loc, L1_loc) = (L0, L1)
  for i in 0..<count:
    write(stdout, fmt"{L0_loc:7}")
    t = L0_loc + L1_loc + ADD
    L0_loc = L1_loc
    L1_loc = t
    if i mod 5 == 4:
      write(stdout, "\n")
  write(stdout, "\n")

echo "Leonardo Numbers:"
leonardoNumbers(25)
echo "Fibonacci Numbers: "
leonardoNumbers(25, 0, 1, 0)


no warnings 'experimental::signatures';
use feature 'signatures';

sub leonardo ($n, $l0 = 1, $l1 = 1, $add = 1) {
  ($l0, $l1) = ($l1, $l0+$l1+$add)  for 1..$n;
  $l0;
}

my @L = map { leonardo($_) } 0..24;
print "Leonardo[1,1,1]: @L\n";
my @F = map { leonardo($_,0,1,0) } 0..24;
print "Leonardo[0,1,0]: @F\n";


with javascript_semantics
function leonardo(integer n, l1=1, l2=1, step=1)
-- return the first n leonardo numbers, starting {l1,l2}, with step as the add number
    sequence res = {l1,l2}
    while length(res)<n do
        res = append(res,res[$]+res[$-1]+step)
    end while
    return res
end function
?{"Leonardo",leonardo(25)}
?{"Fibonacci",leonardo(25,0,1,0)}


go =>
  println([leonardo(I) : I in 0..24]),
  println([leonardo(0,1,0,I) : I in 0..24]).

leonardo(N) = leonardo(1,1,1,N).
table
leonardo(I1,_I2,_Add,0) = I1.
leonardo(_I1,I2,_Add,1) = I2.
leonardo(I1,I2,Add,N) = leonardo(I1,I2,Add,N-1) + leonardo(I1,I2,Add,N-2) + Add.


(de leo (A B C)
   (default A 1  B 1  C 1)
   (make
      (do 25
         (inc
            'B
            (+ (link (swap 'A B)) C) ) ) ) )

(println 'Leonardo (leo))
(println 'Fibonacci (leo 0 1 0))


To run:
Start up.
Write "First 25 Leonardo numbers:" on the console.
Show 25 of the Leonardo numbers starting with 1 and 1 and using 1 for the add number.
Write "First 25 Leonardo numbers with L(0)=0, L(1)=1, add=0:" on the console.
Show 25 of the Leonardo numbers starting with 0 and 1 and using 0 for the add number.
Wait for the escape key.
Shut down.

To show a number of the Leonardo numbers starting with a first number and a second number and using an add number for the add number:
If the number is less than 2, exit.
Privatize the number.
Privatize the first number.
Privatize the second number.
Subtract 2 from the number.
Write the first number then " " then the second number on the console without advancing.
Loop.
If a counter is past the number, write "" on the console; exit.
Swap the first number with the second number.
Put the first number plus the second number plus the add number into the second number.
Write the second number then " " on the console without advancing.
Repeat.


EnableExplicit

#N = 25

Procedure leon_R(a.i, b.i, s.i = 1, n.i = #N)

  If n>2
    Print(Space(1) + Str(a + b + s))
    ProcedureReturn leon_R(b, a + b + s, s, n-1)
  EndIf

EndProcedure

If OpenConsole()

  Define r$

  Print("Enter first two Leonardo numbers and increment step (separated by space) : ")
  r$ = Input()
  PrintN("First " + Str(#N) + " Leonardo numbers : ")
  Print(StringField(r$, 1, Chr(32)) + Space(1) +
        StringField(r$, 2, Chr(32)))

  leon_R(Val(StringField(r$, 1, Chr(32))),
         Val(StringField(r$, 2, Chr(32))),
         Val(StringField(r$, 3, Chr(32))))

  r$ = Input()
EndIf


package require Tcl 8.5

proc longmult {x y} {
    set digits [lreverse [split $x ""]]
    set result {0}
    set j -2
    foreach m [lreverse [split $y ""]] {
	set c 0
	set i [incr j]
	foreach d $digits {
	    set v [lindex $result [incr i]]
	    if {$v eq ""} {
		lappend result 0
		set v 0
	    }
	    regexp (.)(.)$ 0[expr {$v + $c + $d*$m}] -> c v
	    lset result $i $v
	}
	lappend result $c
    }
    # Reconvert digit list into a decimal number
    set result [string trimleft [join [lreverse $result] ""] 0]
    if {$result == ""} then {return 0} else {return $result}
}

puts [set n [expr {2**64}]]
puts [longmult $n $n]
puts [expr {$n * $n}]


def Leonardo(L_Zero, L_One, Add, Amount):
    terms = [L_Zero,L_One]
    while len(terms) < Amount:
        new = terms[-1] + terms[-2]
        new += Add
        terms.append(new)
    return terms

out = ""
print "First 25 Leonardo numbers:"
for term in Leonardo(1,1,1,25):
    out += str(term) + " "
print out

out = ""
print "Leonardo numbers with fibonacci parameters:"
for term in Leonardo(0,1,0,25):
    out += str(term) + " "
print out


  [ 1 1 1 ]             is leo     (         --> n n n )

  [ 0 1 0 ]             is fibo    (         --> n n n )

  [ 2 1 0 ]             is lucaso (         --> n n n )

  [ temp put
    rot times
      [ tuck +
        temp share + ]
    temp release drop ] is nardo   ( n n n n --> n     )

say "Leonardo numbers:" cr
25 times [ i^ leo nardo echo sp ]
cr cr
say "Fibonacci numbers:" cr
25 times [ i^ fibo nardo echo sp ]
cr cr
say "Lucas numbers:" cr
25 times [ i^ lucaso nardo echo sp ]


leonardo_numbers <- function(add = 1, l0 = 1, l1 = 1, how_many = 25) {
	result <- c(l0, l1)
	for (i in 3:how_many)
		result <- append(result, result[[i - 1]] + result[[i - 2]] + add)
	result
}
cat("First 25 Leonardo numbers\n")
cat(leonardo_numbers(), "\n")

cat("First 25 Leonardo numbers from 0, 1 with add number = 0\n")
cat(leonardo_numbers(0, 0, 1), "\n")


successor = ~&a^?\1! ~&ah?/~&NfatPRC ~&NNXatPC

sum = ~&B^?a\~&[email protected] ~&B?abh/[email protected] ~&Yabh2Ofabt2RC

product = ~&alrB^& [email protected]

x = 18446744073709551616

#show+

y = %nP [email protected] x


#lang racket
(define (Leonardo n #:L0 (L0 1) #:L1 (L1 1) #:1+ (1+ 1))
  (cond [(= n 0) L0]
        [(= n 1) L1]
        [else
         (let inr ((n (- n 2)) (L_n-2 L0) (L_n-1 L1))
           (let ((L_n (+ L_n-1 L_n-2 1+)))
             (if (zero? n) L_n (inr (sub1 n) L_n-1 L_n))))]))

(module+ main
  (map Leonardo (range 25))
  (map (curry Leonardo #:L0 0 #:L1 1 #:1+ 0) (range 25)))

(module+ test
  (require rackunit)
  (check-equal? (Leonardo 0) 1)
  (check-equal? (Leonardo 1) 1)
  (check-equal? (Leonardo 2) 3)
  (check-equal? (Leonardo 3) 5))


sub 𝑳 ( $𝑳0 = 1, $𝑳1 = 1, $𝑳add = 1 ) { $𝑳0, $𝑳1, { $^n2 + $^n1 + $𝑳add } ... * }

# Part 1
say "The first 25 Leonardo numbers:";
put 𝑳()[^25];

# Part 2
say "\nThe first 25 numbers using 𝑳0 of 0, 𝑳1 of 1, and adder of 0:";
put 𝑳( 0, 1, 0 )[^25];


/*REXX pgm computes Leonardo numbers, allowing the specification of L(0), L(1), and ADD#*/
numeric digits 500                               /*just in case the user gets ka-razy.  */
@.=1                                             /*define the default for the  @. array.*/
parse arg N L0 L1 a# .                           /*obtain optional arguments from the CL*/
if  N =='' |  N ==","  then    N= 25             /*Not specified?  Then use the default.*/
if L0\=='' & L0\==","  then  @.0= L0             /*Was     "         "   "   "   value. */
if L1\=='' & L1\==","  then  @.1= L1             /* "      "         "   "   "     "    */
if a#\=='' & a#\==","  then  @.a= a#             /* "      "         "   "   "     "    */
say 'The first '   N   " Leonardo numbers are:"  /*display a title for the output series*/
if @.0\==1 | @.1\==1  then say 'using '     @.0     " for L(0)"
if @.0\==1 | @.1\==1  then say 'using '     @.1     " for L(1)"
if @.a\==1            then say 'using '     @.a     " for the  add  number"
say                                              /*display blank line before the output.*/
$=                                               /*initialize the output line to "null".*/
             do j=0  for N                       /*construct a list of Leonardo numbers.*/
             if j<2  then [email protected].j                  /*for the 1st two numbers, use the fiat*/
                     else do                     /*··· otherwise, compute the Leonardo #*/
                          [email protected].0                  /*save the old primary Leonardo number.*/
                          @.[email protected].1                /*store the new primary number in old. */
                          @.[email protected].0  +  _  +  @.a  /*compute the next Leonardo number.    */
                          [email protected].1                  /*store the next Leonardo number in Z. */
                          end                    /* [↑]  only 2 Leonardo #s are stored. */
             $=$ z                               /*append the just computed # to $ list.*/
             end   /*j*/                         /* [↓]  elide the leading blank in  $. */
say strip($)                                     /*stick a fork in it,  we're all done. */


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

Module Module1

    Dim a As Decimal, mx As Decimal = 1E28D, hm As Decimal = 1E14D

    ' allows for 56 digit representation, using 28 decimal digits from each decimal
    Structure bd
        Public hi, lo As Decimal
    End Structure

    ' outputs bd structure as string, optionally inserting commas
    Function toStr(ByVal a As bd, ByVal Optional comma As Boolean = False) As String
        Dim r As String = If(a.hi = 0, String.Format("{0:0}", a.lo),
                                       String.Format("{0:0}{1:" & New String("0"c, 28) & "}", a.hi, a.lo))
        If Not comma Then Return r
        Dim rc As String = ""
        For i As Integer = r.Length - 3 To 0 Step -3
            rc = "," & r.Substring(i, 3) & rc : Next
        toStr = r.Substring(0, r.Length Mod 3) & rc
            toStr = toStr.Substring(If(toStr.Chars(0) = "," , 1, 0))
    End Function

    ' needed because Math.Pow() returns a double
    Function Pow_dec(ByVal bas As Decimal, ByVal exp As UInteger) As Decimal
        If exp = 0 Then Pow_dec = 1D else Pow_dec = Pow_dec(bas, exp >> 1) : _
        Pow_dec *= Pow_dec : If (exp And 1) <> 0 Then Pow_dec *= bas
    End Function

    Sub Main(ByVal args As String())
         For p As UInteger = 64 To 95 - 1 Step 30                 ' show prescribed output and maximum power of 2 output
            Dim y As bd, x As bd : a = Pow_dec(2D, p)             ' init the bd variables, a = decimal value to be squared
            WriteLine("The square of (2^{0}):                    {1,38:n0}", p, a)
            x.hi = Math.Floor(a / hm) : x.lo = a Mod hm           ' setup for the squaring process
            Dim BS As BI = BI.Pow(CType(a, BI), 2)                ' for the BigInteger checking of result
            y.lo = x.lo * x.lo : y.hi = x.hi * x.hi               ' square the lo and the hi parts
            a = x.hi * x.lo * 2D                                  ' calculate the middle term (mid-term)
            y.hi += Math.Floor(a / hm) : y.lo += (a Mod hm) * hm  ' increment hi and lo parts with high and low parts of the mid-term
            While y.lo > mx : y.lo -= mx : y.hi += 1 : End While  ' check for overflow, adjust both parts as needed
            WriteLine(" is {0,75} (which {1} match the BigInteger computation)" & vbLf,
                toStr(y, True), If(BS.ToString() = toStr(y), "does", "fails to"))
        Next
    End Sub

End Module


# Project : Leanardo numbers

n0 = 1
n1 = 1
add = 1
see "First 25 Leonardo numbers:" + nl
leonardo()
n0 = 1
n1 = 1
add = 0
see "First 25 Leonardo numbers with L(0) = 0, L(1) = 1, step = 0 (fibonacci numbers):" + nl
see "" + add + " "
leonardo()

func leonardo()
        see "" + n0 + " " + n1
        for i=3 to 25
              temp=n1
              n1=n0+n1+add
              n0=temp
             see " "+ n1
        next
        see nl


def leonardo(l0=1, l1=1, add=1)
  return to_enum(__method__,l0,l1,add) unless block_given?
  loop do
    yield l0
    l0, l1 = l1, l0+l1+add
  end
end

p leonardo.take(25)
p leonardo(0,1,0).take(25)


sqliteconnect #mem, ":memory:"
#mem execute("CREATE TABLE lno (name,L0,L1,ad)")
#mem execute("INSERT INTO lno VALUES('Leonardo',1,1,1),('Fibonacci',0,1,0);")
#mem execute("SELECT * FROM lno")
for j = 1 to 2
#row  = #mem #nextrow()
name$ = #row name$()
L0    = #row L0()
L1    = #row L1()
ad    = #row ad()
print :print name$;" add=";ad :print" ";L0;" ";L1;" ";
for i = 3 to 25
  temp  = L1
  L1    = L0 + L1 + ad
  L0    = temp
  print L1;" ";
next i
next j
end


fn leonardo(mut n0: u32, mut n1: u32, add: u32) -> impl std::iter::Iterator<Item = u32> {
    std::iter::from_fn(move || {
        let n = n0;
        n0 = n1;
        n1 += n + add;
        Some(n)
    })
}

fn main() {
    println!("First 25 Leonardo numbers:");
    for i in leonardo(1, 1, 1).take(25) {
        print!("{} ", i);
    }
    println!();
    println!("First 25 Fibonacci numbers:");
    for i in leonardo(0, 1, 0).take(25) {
        print!("{} ", i);
    }
    println!();
}


def leo( n:Int, n1:Int=1, n2:Int=1, addnum:Int=1 ) : BigInt = n match {
  case 0 => n1
  case 1 => n2
  case n => leo(n - 1, n1, n2, addnum) + leo(n - 2, n1, n2, addnum) + addnum
}

{
println( "The first 25 Leonardo Numbers:")
(0 until 25) foreach { n => print( leo(n) + " " ) }

println( "\n\nThe first 25 Fibonacci Numbers:")
(0 until 25) foreach { n => print( leo(n, n1=0, n2=1, addnum=0) + " " ) }
}


import "/fmt" for Fmt

// argument validation
var d = Fn.new { |b|
    if (b < 48 || b > 57) Fiber.abort("digit 0-9 expected")
    return b - 48
}

// converts a list of bytes to a string
var b2s = Fn.new { |b| b.map { |e| String.fromByte(e) }.join() }

// add two numbers as strings
var add = Fn.new { |x, y|
    if (y.count > x.count) {
        var t = x
        x = y
        y = t
    }
    var b = List.filled(x.count+1, 0)
    var c = 0
    for (i in 1..x.count) {
        if (i <= y.count) c = c + d.call(y[y.count-i].bytes[0])
        var s = d.call(x[x.count-i].bytes[0]) + c
        c = (s/10).floor
        b[b.count-i] = (s%10) + 48
    }
    if (c == 0) return b2s.call(b[1..-1])
    b[0] = c + 48
    return b2s.call(b)
}

// multiply a number by a single digit
var mulDigit = Fn.new { |x, y|
    if (y == 48) return "0"
    y = d.call(y)
    var b = List.filled(x.count+1, 0)
    var c = 0
    for (i in 1..x.count) {
        var s = d.call(x[x.count-i].bytes[0]) * y + c
        c = (s/10).floor
        b[b.count-i] = (s%10) + 48
    }
    if (c == 0) return b2s.call(b[1..-1])
    b[0] = c + 48
    return b2s.call(b)
}

// multiply two numbers as strings
var mul = Fn.new { |x, y|
    var result = mulDigit.call(x, y[y.count-1].bytes[0])
    var zeros = ""
    var i = 2
    while (i <= y.count) {
        zeros = zeros + "0"
        result = add.call(result, mulDigit.call(x, y[y.count-i].bytes[0]) + zeros)
        i = i + 1
    }
    result = result.trimStart("0")
    if (result == "") result = "0"
    return result
}

var n = "18446744073709551616"
Fmt.print("$,s", mul.call(n, n))


$ include "seed7_05.s7i";

const proc: leonardo (in var integer: l0, in var integer: l1, in integer: add, in integer: count) is func
  local
    var integer: temp is 0;
  begin
    for count do
      write(" " <& l0);
      temp := l0 + l1 + add;
      l0 := l1;
      l1 := temp;
    end for;
    writeln;
  end func;

const proc: main is func
  begin
    write("Leonardo Numbers:");
    leonardo(1, 1, 1, 25);
    write("Fibonacci Numbers:");
    leonardo(0, 1, 0, 25);
  end func;


func 𝑳(n, 𝑳0 = 1, 𝑳1 = 1, 𝑳add = 1) {
    { (𝑳0, 𝑳1) = (𝑳1, 𝑳0 + 𝑳1 + 𝑳add) } * n
    return 𝑳0
}

say "The first 25 Leonardo numbers:"
say 25.of { 𝑳(_) }

say "\nThe first 25 numbers using 𝑳0 of 0, 𝑳1 of 1, and adder of 0:"
say 25.of { 𝑳(_, 0, 1, 0) }


struct Leonardo: Sequence, IteratorProtocol {
    private let add : Int
    private var n0: Int
    private var n1: Int

    init(n0: Int = 1, n1: Int = 1, add: Int = 1) {
        self.n0 = n0
        self.n1 = n1
        self.add = add
    }

    mutating func next() -> Int? {
        let n = n0
        n0 = n1
        n1 += n + add
        return n
    }
}

print("First 25 Leonardo numbers:")
print(Leonardo().prefix(25).map{String($0)}.joined(separator: " "))

print("First 25 Fibonacci numbers:")
print(Leonardo(n0: 0, add: 0).prefix(25).map{String($0)}.joined(separator: " "))


Option Explicit

Private Sub LeonardoNumbers()
Dim L, MyString As String
    Debug.Print "First 25 Leonardo numbers :"
    L = Leo_Numbers(25, 1, 1, 1)
    MyString = Join(L, "; ")
    Debug.Print MyString
    Debug.Print "First 25 Leonardo numbers from 0, 1 with add number = 0"
    L = Leo_Numbers(25, 0, 1, 0)
    MyString = Join(L, "; ")
    Debug.Print MyString
    Debug.Print "If the first prarameter is too small :"
    L = Leo_Numbers(1, 0, 1, 0)
    MyString = Join(L, "; ")
    Debug.Print MyString
End Sub

Public Function Leo_Numbers(HowMany As Long, L_0 As Long, L_1 As Long, Add_Nb As Long)
Dim N As Long, Ltemp

    If HowMany > 1 Then
        ReDim Ltemp(HowMany - 1)
        Ltemp(0) = L_0: Ltemp(1) = L_1
        For N = 2 To HowMany - 1
             Ltemp(N) = Ltemp(N - 1) + Ltemp(N - 2) + Add_Nb
        Next N
    Else
        ReDim Ltemp(0)
        Ltemp(0) = "The first parameter is too small"
    End If
    Leo_Numbers = Ltemp
End Function


include c:\cxpl\stdlib;
char Two64, Product(40);
[Two64:= "18446744073709551616";
StrNMul(Two64, Two64, Product, 20);
Product(39):= Product(39)!$80;          \terminate string
Text(0, Product+1);                     \skip leading zero
]


Module Module1

    Iterator Function Leonardo(Optional L0 = 1, Optional L1 = 1, Optional add = 1) As IEnumerable(Of Integer)
        While True
            Yield L0
            Dim t = L0 + L1 + add
            L0 = L1
            L1 = t
        End While
    End Function

    Sub Main()
        Console.WriteLine(String.Join(" ", Leonardo().Take(25)))
        Console.WriteLine(String.Join(" ", Leonardo(0, 1, 0).Take(25)))
    End Sub

End Module


fn leonardo(n int, l0 int, l1 int, add int) []int {
    mut leo := []int{len: n}
    leo[0] = l0
    leo[1] = l1
    for i := 2; i < n; i++ {
        leo[i] = leo[i - 1] + leo[i - 2] + add
    }
    return leo
}

fn main() {
    println("The first 25 Leonardo numbers with L[0] = 1, L[1] = 1 and add number = 1 are:")
    println(leonardo(25, 1, 1, 1))
    println("\nThe first 25 Leonardo numbers with L[0] = 0, L[1] = 1 and add number = 0 are:")
    println(leonardo(25, 0, 1, 0))
}


var leonardo = Fn.new { |first, add, limit|
    var leo = List.filled(limit, 0)
    leo[0] = first[0]
    leo[1] = first[1]
    for (i in 2...limit) leo[i] = leo[i-1] + leo[i-2] + add
    return leo
}

System.print("The first 25 Leonardo numbers with L(0) = 1, L(1) = 1 and Add = 1 are:")
for (l in leonardo.call([1, 1], 1, 25)) System.write("%(l) ")

System.print("\n\nThe first 25 Leonardo numbers with L(0) = 0, L(1) = 1 and Add = 0 are:")
for (l in leonardo.call([0, 1], 0, 25)) System.write("%(l) ")
System.print()


limit = 25

sub leonardo(L0, L1, suma, texto$)
	local i
	print "Numeros de " + texto$, " (", L0, ",", L1, ",", suma, "):"
	for i = 1 to limit
		if i = 1 then print L0, " ";
		elsif i = 2 then print L1, " ";
		else
			print L0 + L1 + suma, " ";
			tmp = L0
			L0 = L1
			L1 = tmp + L1 + suma
		endif
	next i
	print chr$(10)
end sub

leonardo(1,1,1,"Leonardo")
leonardo(0,1,0,"Fibonacci")
end


fcn leonardoNumber(n, n1=1,n2=1,addnum=1){
   if(n==0) return(n1);
   if(n==1) return(n2);
   self.fcn(n-1,n1,n2,addnum) + self.fcn(n-2,n1,n2,addnum) + addnum
}


F gcd(=a, =b)
   L b != 0
      (a, b) = (b, a % b)
   R a

F lcm(m, n)
   R m I/ gcd(m, n) * n

print(lcm(12, 18))


LCM      CSECT
         USING  LCM,R15            use calling register
         L      R6,A               a
         L      R7,B               b
         LR     R8,R6              c=a
LOOPW    LR     R4,R8                c
         SRDA   R4,32                shift to next reg
         DR     R4,R7                c/b
         LTR    R4,R4              while c mod b<>0
         BZ     ELOOPW               leave while
         AR     R8,R6                c+=a
         B      LOOPW              end while
ELOOPW   LPR    R9,R6              c=abs(u)
         L      R1,A               a
         XDECO  R1,XDEC            edit a
         MVC    PG+4(5),XDEC+7     move a to buffer
         L      R1,B               b
         XDECO  R1,XDEC            edit b
         MVC    PG+10(5),XDEC+7    move b to buffer
         XDECO  R8,XDEC            edit c
         MVC    PG+17(10),XDEC+2   move c to buffer
         XPRNT  PG,80              print buffer
         XR     R15,R15            return code =0
         BR     R14                return to caller
A        DC     F'1764'            a
B        DC     F'3920'            b
PG       DC     CL80'lcm(00000,00000)=0000000000'  buffer
XDEC     DS     CL12               temp for edit
         YREGS
         END    LCM


: gcd \ a b -- gcd
	dup 0 n:= if drop ;; then
	tuck \ b a b
	n:mod \ b a-mod-b
	recurse ;

: lcm \ m n
	2dup \ m n m n
	n:* \ m n m*n
	n:abs \ m n abs(m*n)
	-rot \ abs(m*n) m n
	gcd \ abs(m*n) gcd(m.n)
	n:/mod \ abs / gcd
	nip \ abs div gcd
;

: demo \ n m --
	2dup "LCM of " . . " and " . . " = " . lcm . ;

12 18 demo cr
-6 14 demo cr
35  0 demo cr

bye


CARD FUNC Lcm(CARD a,b)
  CARD tmp,c

  IF a=0 OR b=0 THEN
   RETURN (0)
  FI

  IF a<b THEN
    tmp=a a=b b=tmp
  FI

  c=0
  DO
    c==+1
  UNTIL a*c MOD b=0
  OD
RETURN(a*c)

PROC Test(CARD a,b)
  CARD res

  res=Lcm(a,b)
  PrintF("LCM of %I and %I is %I%E",a,b,res)
RETURN

PROC Main()
  Test(4,6)
  Test(120,77)
  Test(24,8)
  Test(1,56)
  Test(12,0)
RETURN


with Ada.Text_IO; use Ada.Text_IO;

procedure Lcm_Test is
   function Gcd (A, B : Integer) return Integer is
      M : Integer := A;
      N : Integer := B;
      T : Integer;
   begin
      while N /= 0 loop
         T := M;
         M := N;
         N := T mod N;
      end loop;
      return M;
   end Gcd;

   function Lcm (A, B : Integer) return Integer is
   begin
      if A = 0 or B = 0 then
         return 0;
      end if;
      return abs (A) * (abs (B) / Gcd (A, B));
   end Lcm;
begin
   Put_Line ("LCM of 12, 18 is" & Integer'Image (Lcm (12, 18)));
   Put_Line ("LCM of -6, 14 is" & Integer'Image (Lcm (-6, 14)));
   Put_Line ("LCM of 35, 0 is" & Integer'Image (Lcm (35, 0)));
end Lcm_Test;


BEGIN
   PROC gcd = (INT m, n) INT :
   BEGIN
      INT a := ABS m, b := ABS n;
      IF a=0 OR b=0 THEN 0 ELSE
	 WHILE b /= 0 DO INT t = b; b := a MOD b; a := t OD;
	 a
      FI
   END;
   PROC lcm = (INT m, n) INT : ( m*n = 0 | 0 | ABS (m*n) % gcd (m, n));
   INT m=12, n=18;
   printf (($gxg(0)3(xgxg(0))l$,
	    "The least common multiple of", m, "and", n, "is", lcm(m,n),
	    "and their greatest common divisor is", gcd(m,n)))
END


begin
    integer procedure gcd ( integer value a, b ) ;
        if b = 0 then a else gcd( b, a rem abs(b) );

    integer procedure lcm( integer value a, b ) ;
        abs( a * b ) div gcd( a, b );

    write( lcm( 15, 20  ) );
end.


------------------ LEAST COMMON MULTIPLE -----------------

-- lcm :: Integral a => a -> a -> a
on lcm(x, y)
    if 0 = x or 0 = y then
        0
    else
        abs(x div (gcd(x, y)) * y)
    end if
end lcm

--------------------------- TEST -------------------------
on run

    lcm(12, 18)

    --> 36
end run

-------------------- GENERIC FUNCTIONS -------------------

-- abs :: Num a => a -> a
on abs(x)
    if 0 > x then
        -x
    else
        x
    end if
end abs

-- gcd :: Integral a => a -> a -> a
on gcd(x, y)
    script
        on |λ|(a, b)
            if 0 = b then
                a
            else
                |λ|(b, a mod b)
            end if
        end |λ|
    end script

    result's |λ|(abs(x), abs(y))
end gcd


< a , b >

( return ,

        abs ( @a * @b ) /
        !gcd( @a , @b )

)


lcm: function [x,y][
    x * y / gcd @[x y]
]

print lcm 12 18


; lcm.asm: calculates the least common multiple
; of two positive integers
;
; nasm x86_64 assembly (linux) with libc
; assemble: nasm -felf64 lcm.asm; gcc lcm.o
; usage: ./a.out [number1] [number2]

    global main
    extern printf ; c function: prints formatted output
    extern strtol ; c function: converts strings to longs

    section .text

main:
    push rbp    ; set up stack frame

    ; rdi contains argc
    ; if less than 3, exit
    cmp rdi, 3
    jl incorrect_usage

    ; push first argument as number
    push rsi
    mov rdi, [rsi+8]
    mov rsi, 0
    mov rdx, 10 ; base 10
    call strtol
    pop rsi
    push rax

    ; push second argument as number
    push rsi
    mov rdi, [rsi+16]
    mov rsi, 0
    mov rdx, 10 ; base 10
    call strtol
    pop rsi
    push rax

    ; pop arguments and call get_gcd
    pop rdi
    pop rsi
    call get_gcd

    ; print value
    mov rdi, print_number
    mov rsi, rax
    call printf

    ; exit
    mov rax, 0  ; 0--exit success
    pop rbp
    ret

incorrect_usage:
    mov rdi, bad_use_string
    ; rsi already contains argv
    mov rsi, [rsi]
    call printf
    mov rax, 0  ; 0--exit success
    pop rbp
    ret

bad_use_string:
    db "Usage: %s [number1] [number2]",10,0

print_number:
    db "%d",10,0

get_gcd:
    push rbp    ; set up stack frame
    mov rax, 0
    jmp loop

loop:
    ; keep adding the first argument
    ; to itself until a multiple
    ; is found. then, return
    add rax, rdi
    push rax
    mov rdx, 0
    div rsi
    cmp rdx, 0
    pop rax
    je gcd_found
    jmp loop

gcd_found:
    pop rbp
    ret


#define ATS_DYNLOADFLAG 0       (* No initialization is needed. *)

#include "share/atspre_define.hats"
#include "share/atspre_staload.hats"

(********************************************************************)
(*                                                                  *)
(* Declarations.                                                    *)
(*                                                                  *)
(* (These could be ported to a .sats file.)                         *)
(*                                                                  *)

(* lcm for unsigned integer types without constraints. *)
extern fun {tk : tkind}
g0uint_lcm (u : g0uint tk,
            v : g0uint tk) :<>
    g0uint tk

(* The gcd template function to be expanded when g0uint_lcm is
   expanded. Set it to your favorite gcd function. *)
extern fun {tk : tkind}
g0uint_lcm$gcd (u : g0uint tk,
                v : g0uint tk) :<>
    g0uint tk

(* lcm for signed integer types, giving unsigned results. *)
extern fun {tk_signed, tk_unsigned : tkind}
g0int_lcm (u : g0int tk_signed,
           v : g0int tk_signed) :<>
    g0uint tk_unsigned

overload lcm with g0uint_lcm
overload lcm with g0int_lcm

(********************************************************************)
(*                                                                  *)
(* The implementations.                                             *)
(*                                                                  *)

implement {tk}
g0uint_lcm (u, v) =
  let
    val d = g0uint_lcm$gcd<tk> (u, v)
  in
    (* There is no need to take the absolute value, because this
       implementation is strictly for unsigned integers. *)
    (u * v) / d
  end

implement {tk_signed, tk_unsigned}
g0int_lcm (u, v) =
  let
    extern castfn
    unsigned :
      g0int tk_signed -<> g0uint tk_unsigned
  in
    g0uint_lcm (unsigned (abs u), unsigned (abs v))
  end

(********************************************************************)
(*                                                                  *)
(* A test that it actually works.                                   *)
(*                                                                  *)

implement
main0 () =
  let
    implement {tk}
    g0uint_lcm$gcd (u, v) =
      (* An ugly gcd for the sake of demonstrating that it can be done
         this way: Euclid’s algorithm written an the ‘Algol’ style,
         which is not a natural style in ATS. Almost always you want
         to write a tail-recursive function, instead. I did, however
         find the ‘Algol’ style very useful when I was migrating
         matrix routines from Fortran.

         In reality, you would implement g0uint_lcm$gcd by having it
         simply call whatever gcd template function you are using in
         your program. *)
      $effmask_all
        begin
          let
            var x : g0uint tk = u
            var y : g0uint tk = v
          in
            while (y <> 0)
              let
                val z = y
              in
                y := x mod z;
                x := z
              end;
            x
          end
        end
  in
    assertloc (lcm (~6, 14) = 42U);
    assertloc (lcm (2L, 0L) = 0ULL);
    assertloc (lcm (12UL, 18UL) = 36UL);
    assertloc (lcm (12, 22) = 132ULL);
    assertloc (lcm (7ULL, 31ULL) = 217ULL)
  end


LCM(Number1,Number2)
{
 If (Number1 = 0 || Number2 = 0)
  Return
 Var := Number1 * Number2
 While, Number2
  Num := Number2, Number2 := Mod(Number1,Number2), Number1 := Num
 Return, Var // Number1
}

Num1 = 12
Num2 = 18
MsgBox % LCM(Num1,Num2)


Func _LCM($a, $b)
	Local $c, $f, $m = $a, $n = $b
	$c = 1
	While $c <> 0
		$f = Int($a / $b)
		$c = $a - $b * $f
		If $c <> 0 Then
			$a = $b
			$b = $c
		EndIf
	WEnd
	Return $m * $n / $b
EndFunc   ;==>_LCM


# greatest common divisor
function gcd(m, n,    t) {
	# Euclid's method
	while (n != 0) {
		t = m
		m = n
		n = t % n
	}
	return m
}

# least common multiple
function lcm(m, n,    r) {
	if (m == 0 || n == 0)
		return 0
	r = m * n / gcd(m, n)
	return r < 0 ? -r : r
}

# Read two integers from each line of input.
# Print their least common multiple.
{ print lcm($1, $2) }


10 DEF FN MOD(A) = INT((A / B - INT(A / B)) * B + .05) * SGN(A / B)
20 INPUT"M=";M%
30 INPUT"N=";N%
40 GOSUB 100
50 PRINT R
60 END

100 REM LEAST COMMON MULTIPLE M% N%
110 R = 0
120 IF M% = 0 OR N% = 0 THEN RETURN
130 A% = M% : B% = N% : GOSUB 200"GCD
140 R = ABS(M%*N%)/R
150 RETURN

200 REM GCD ITERATIVE EUCLID A% B%
210 FOR B = B% TO 0 STEP 0
220     C% = A%
230     A% = B
240     B = FN MOD(C%)
250 NEXT B
260 R = ABS(A%)
270 RETURN


function mcm (m, n)
	if m = 0 or n = 0 then return 0
	if m < n then
		t = m : m = n : n = t
	end if
	cont = 0
	do
		cont += 1
	until (m * cont) mod n  = 0
	return m * cont
end function

print "lcm( 12,  18) = "; mcm( 12, -18)
print "lcm( 15,  12) = "; mcm( 15,  12)
print "lcm(-10, -14) = "; mcm(-10, -14)
print "lcm(  0,   1) = "; mcm(  0,   1)


@echo off
setlocal enabledelayedexpansion
set num1=12
set num2=18

call :lcm %num1% %num2%
exit /b

:lcm <input1> <input2>
if %2 equ 0 (
	set /a lcm = %num1%*%num2%/%1
	echo LCM = !lcm!
	pause>nul
	goto :EOF
)
set /a res = %1 %% %2
call :lcm %2 %res%
goto :EOF


/* greatest common divisor */
define g(m, n) {
	auto t

	/* Euclid's method */
	while (n != 0) {
		t = m
		m = n
		n = t % n
	}
	return (m)
}

/* least common multiple */
define l(m, n) {
	auto r

	if (m == 0 || n == 0) return (0)
	r = m * n / g(m, n)
	if (r < 0) return (-r)
	return (r)
}


get "libhdr"

let lcm(m,n) =
    m=0 -> 0,
    n=0 -> 0,
    abs(m*n) / gcd(m,n)
and gcd(m,n) =
    n=0 -> m,
    gcd(n, m rem n)

let start() be writef("%N*N", lcm(12, 18))


#include <stdio.h>

int gcd(int m, int n)
{
        int tmp;
        while(m) { tmp = m; m = n % m; n = tmp; }
        return n;
}

int lcm(int m, int n)
{
        return m / gcd(m, n) * n;
}

int main()
{
        printf("lcm(35, 21) = %d\n", lcm(21,35));
        return 0;
}


Using System;
class Program
{
    static int gcd(int m, int n)
    {
        return n == 0 ? Math.Abs(m) : gcd(n, n % m);
    }
    static int lcm(int m, int n)
    {
        return Math.Abs(m * n) / gcd(m, n);
    }
    static void Main()
    {
        Console.WriteLine("lcm(12,18)=" + lcm(12,18));
    }
}


#include <boost/math/common_factor.hpp>
#include <iostream>

int main( ) {
   std::cout << "The least common multiple of 12 and 18 is " <<
      boost::math::lcm( 12 , 18 ) << " ,\n"
      << "and the greatest common divisor " << boost::math::gcd( 12 , 18 ) << " !" << std::endl ;
   return 0 ;
}


(defn gcd
      [a b]
      (if (zero? b)
      a
      (recur b, (mod a b))))

(defn lcm
      [a b]
      (/ (* a b) (gcd a b)))
;; to calculate the lcm for a variable number of arguments
(defn lcmv [& v] (reduce lcm v))


gcd = proc (m, n: int) returns (int)
    m, n := int$abs(m), int$abs(n)
    while n ~= 0 do m, n := n, m // n end
    return(m)
end gcd

lcm = proc (m, n: int) returns (int)
    if m=0 cor n=0
        then return(0)
        else return(int$abs(m*n) / gcd(m,n))
    end
end lcm

start_up = proc ()
    po: stream := stream$primary_output()
    stream$putl(po, int$unparse(lcm(12, 18)))
end start_up


       IDENTIFICATION DIVISION.
       PROGRAM-ID. show-lcm.

       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       REPOSITORY.
           FUNCTION lcm
           .
       PROCEDURE DIVISION.
           DISPLAY "lcm(35, 21) = " FUNCTION lcm(35, 21)
           GOBACK
           .
       END PROGRAM show-lcm.

       IDENTIFICATION DIVISION.
       FUNCTION-ID. lcm.

       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       REPOSITORY.
           FUNCTION gcd
           .
       DATA DIVISION.
       LINKAGE SECTION.
       01  m                       PIC S9(8).
       01  n                       PIC S9(8).
       01  ret                     PIC S9(8).

       PROCEDURE DIVISION USING VALUE m, n RETURNING ret.
           COMPUTE ret = FUNCTION ABS(m * n) / FUNCTION gcd(m, n)
           GOBACK
           .
       END FUNCTION lcm.

       IDENTIFICATION DIVISION.
       FUNCTION-ID. gcd.

       DATA DIVISION.
       LOCAL-STORAGE SECTION.
       01  temp                    PIC S9(8).

       01  x                       PIC S9(8).
       01  y                       PIC S9(8).

       LINKAGE SECTION.
       01  m                       PIC S9(8).
       01  n                       PIC S9(8).
       01  ret                     PIC S9(8).

       PROCEDURE DIVISION USING VALUE m, n RETURNING ret.
           MOVE m to x
           MOVE n to y

           PERFORM UNTIL y = 0
               MOVE x TO temp
               MOVE y TO x
               MOVE FUNCTION MOD(temp, y) TO Y
           END-PERFORM

           MOVE FUNCTION ABS(x) TO ret
           GOBACK
           .
       END FUNCTION gcd.


include "cowgol.coh";

sub gcd(m: uint32, n: uint32): (r: uint32) is
    while n != 0 loop
        var t := m;
        m := n;
        n := t % n;
    end loop;
    r := m;
end sub;

sub lcm(m: uint32, n: uint32): (r: uint32) is
    if m==0 or n==0 then
        r := 0;
    else
        r := m*n / gcd(m,n);
    end if;
end sub;

print_i32(lcm(12, 18));
print_nl();


import std.stdio, std.bigint, std.math;

T gcd(T)(T a, T b) pure nothrow {
    while (b) {
        immutable t = b;
        b = a % b;
        a = t;
    }
    return a;
}

T lcm(T)(T m, T n) pure nothrow {
    if (m == 0) return m;
    if (n == 0) return n;
    return abs((m * n) / gcd(m, n));
}

void main() {
    lcm(12, 18).writeln;
    lcm("2562047788015215500854906332309589561".BigInt,
        "6795454494268282920431565661684282819".BigInt).writeln;
}


main() {
	int x=8;
  int y=12;
int z= gcd(x,y);
  var lcm=(x*y)/z;
  print('$lcm');
  }

int gcd(int a,int b)
{
  if(b==0)
    return a;
  if(b!=0)
    return gcd(b,a%b);
}


proc gcd(word m, n) word:
    word t;
    while n /= 0 do
        t := m;
        m := n;
        n := t % n
    od;
    m
corp

proc lcm(word m, n) word:
    if m=0 or n=0
        then 0
        else m*n / gcd(m,n)
    fi
corp

proc main() void:
    writeln(lcm(12, 18))
corp


import extensions;
import system'math;

gcd = (m,n => (n == 0) ? (m.Absolute) : (gcd(n,n.mod:m)));

lcm = (m,n => (m * n).Absolute / gcd(m,n));

public program()
{
    console.printLine("lcm(12,18)=",lcm(12,18))
}


defmodule RC do
  def gcd(a,0), do: abs(a)
  def gcd(a,b), do: gcd(b, rem(a,b))

  def lcm(a,b), do: div(abs(a*b), gcd(a,b))
end

IO.puts RC.lcm(-12,15)


% Implemented by Arjun Sunel
-module(lcm).
-export([main/0]).

main() ->
	lcm(-3,4).

gcd(A, 0) ->
	A;

gcd(A, B) ->
	gcd(B, A rem B).

lcm(A,B) ->
	abs(A*B div gcd(A,B)).


PROGRAM LCM

PROCEDURE GCD(A,B->GCD)
    LOCAL C
    WHILE B DO
        C=A
        A=B
        B=C MOD B
    END WHILE
    GCD=ABS(A)
END PROCEDURE

PROCEDURE LCM(M,N->LCM)
    IF M=0 OR N=0 THEN
        LCM=0
        EXIT PROCEDURE
      ELSE
        GCD(M,N->GCD)
        LCM=ABS(M*N)/GCD
    END IF
END PROCEDURE

BEGIN
    LCM(18,12->LCM)
    PRINT("LCM of 18 AND 12 =";LCM)
    LCM(14,-6->LCM)
    PRINT("LCM of 14 AND -6 =";LCM)
    LCM(0,35->LCM)
    PRINT("LCM of 0 AND 35 =";LCM)
END PROGRAM


function gcd(integer m, integer n)
    integer tmp
    while m do
        tmp = m
        m = remainder(n,m)
        n = tmp
    end while
    return n
end function

function lcm(integer m, integer n)
    return m / gcd(m, n) * n
end function


## இந்த நிரல் இரு எண்களுக்கு இடையிலான மீச்சிறு பொது மடங்கு (LCM), மீப்பெரு பொது வகுத்தி (GCD) என்ன என்று கணக்கிடும்

நிரல்பாகம் மீபொம(எண்1, எண்2)

	@(எண்1 == எண்2) ஆனால்

  ## இரு எண்களும் சமம் என்பதால், மீபொம அந்த எண்ணேதான்

		பின்கொடு எண்1

	@(எண்1 > எண்2) இல்லைஆனால்

		சிறியது = எண்2
		பெரியது = எண்1

	இல்லை

		சிறியது = எண்1
		பெரியது = எண்2

	முடி

	மீதம் = பெரியது % சிறியது

	@(மீதம் == 0) ஆனால்

  ## பெரிய எண்ணில் சிறிய எண் மீதமின்றி வகுபடுவதால், பெரிய எண்தான் மீபொம

		பின்கொடு பெரியது

	இல்லை

		தொடக்கம் = பெரியது + 1
		நிறைவு = சிறியது * பெரியது

		@(எண் = தொடக்கம், எண் <= நிறைவு, எண் = எண் + 1) ஆக

    ## ஒவ்வோர் எண்ணாக எடுத்துக்கொண்டு தரப்பட்ட இரு எண்களாலும் வகுத்துப் பார்க்கின்றோம். முதலாவதாக இரண்டாலும் மீதமின்றி வகுபடும் எண்தான் மீபொம

			மீதம்1 = எண் % சிறியது
			மீதம்2 = எண் % பெரியது

			@((மீதம்1 == 0) && (மீதம்2 == 0)) ஆனால்
				பின்கொடு எண்
			முடி

		முடி

	முடி

முடி

அ = int(உள்ளீடு("ஓர் எண்ணைத் தாருங்கள் "))
ஆ = int(உள்ளீடு("இன்னோர் எண்ணைத் தாருங்கள் "))

பதிப்பி "நீங்கள் தந்த இரு எண்களின் மீபொம (மீச்சிறு பொது மடங்கு, LCM) = ", மீபொம(அ, ஆ)


let rec gcd x y = if y = 0 then abs x else gcd y (x % y)

let lcm x y = x * y / (gcd x y)


USING: math.functions prettyprint ;
26 28 lcm .


: gcd ( a b -- n )
  begin dup while tuck mod repeat drop ;

: lcm ( a b -- n )
  over 0= over 0= or if 2drop 0 exit then
  2dup gcd abs */ ;


    integer function lcm(a,b)
    integer:: a,b
        lcm = a*b / gcd(a,b)
    end function lcm

    integer function gcd(a,b)
    integer :: a,b,t
        do while (b/=0)
            t = b
            b = mod(a,b)
            a = t
        end do
        gcd = abs(a)
    end function gcd


' FB 1.05.0 Win64

Function lcm (m As Integer, n As Integer) As Integer
  If m = 0 OrElse n = 0 Then Return 0
  If m < n Then Swap m, n '' to minimize iterations needed
  Var count = 0
  Do
    count +=1
  Loop Until (m * count) Mod n  = 0
  Return m * count
End Function

Print "lcm(12, 18) ="; lcm(12, 18)
Print "lcm(15, 12) ="; lcm(15, 12)
Print "lcm(10, 14) ="; lcm(10, 14)
Print
Print "Press any key to quit"
Sleep


10 PRINT "LCM(35, 21) = ";
20 LET MLCM = 35
30 LET NLCM = 21
40 GOSUB 200: ' Calculate LCM
50 PRINT LCM
60 END

195 ' Calculate LCM
200 LET MGCD = MLCM
210 LET NGCD = NLCM
220 GOSUB 400: ' Calculate GCD
230 LET LCM = MLCM / GCD * NLCM
240 RETURN

395 ' Calculate GCD
400 WHILE MGCD <> 0
410  LET TMP = MGCD
420  LET MGCD = NGCD MOD MGCD
430  LET NGCD = TMP
440 WEND
450 LET GCD = NGCD
460 RETURN


lcm :: (Integral a) => a -> a -> a
lcm _ 0 =  0
lcm 0 _ =  0
lcm x y =  abs ((x `quot` (gcd x y)) * y)


link numbers
procedure main()
write("lcm of 18, 36 = ",lcm(18,36))
write("lcm of 0, 9 = ",lcm(0,9))
end


import java.util.Scanner;

public class LCM{
   public static void main(String[] args){
      Scanner aScanner = new Scanner(System.in);

      //prompts user for values to find the LCM for, then saves them to m and n
      System.out.print("Enter the value of m:");
      int m = aScanner.nextInt();
      System.out.print("Enter the value of n:");
      int n = aScanner.nextInt();
      int lcm = (n == m || n == 1) ? m :(m == 1 ? n : 0);
      /* this section increases the value of mm until it is greater
      / than or equal to nn, then does it again when the lesser
      / becomes the greater--if they aren't equal. If either value is 1,
      / no need to calculate*/
      if (lcm == 0) {
         int mm = m, nn = n;
         while (mm != nn) {
             while (mm < nn) { mm += m; }
             while (nn < mm) { nn += n; }
         }
         lcm = mm;
      }
      System.out.println("lcm(" + m + ", " + n + ") = " + lcm);
   }
}


# Define the helper function to take advantage of jq's tail-recursion optimization
def lcm(m; n):
  def _lcm:
    # state is [m, n, i]
    if (.[2] % .[1]) == 0 then .[2] else (.[0:2] + [.[2] + m]) | _lcm end;
  [m, n, m] | _lcm;


:gcd { u v -- n }
    abs int swap abs int swap

    [over over mod rot drop]
    [dup]
    while
    drop
;

:lcm { m n -- n }
    over over gcd rot swap div mult
;

12 18 lcm print nl  { 36 }

"End " input


fun main(args: Array<String>) {
    fun gcd(a: Long, b: Long): Long = if (b == 0L) a else gcd(b, a % b)
    fun lcm(a: Long, b: Long): Long = a / gcd(a, b) * b
    println(lcm(15, 9))
}


define gcd(a,b) => {
	while(#b != 0) => {
		local(t = #b)
		#b = #a % #b
		#a = #t
	}
	return #a
}
define lcm(m,n) => {
	 #m == 0 || #n == 0 ? return 0
	 local(r = (#m * #n) / decimal(gcd(#m, #n)))
	 return integer(#r)->abs
}

lcm(-6, 14)
lcm(2, 0)
lcm(12, 18)
lcm(12, 22)
lcm(7, 31)


print "Least Common Multiple of 12 and 18 is "; LCM(12, 18)
end

function LCM(m, n)
    LCM = abs(m * n) / GCD(m, n)
end function

function GCD(a, b)
    while b
        c = a
        a = b
        b = c mod b
    wend
    GCD = abs(a)
end function


to abs :n
  output sqrt product :n :n
end

to gcd :m :n
  output ifelse :n = 0 [ :m ] [ gcd :n modulo :m :n ]
end

to lcm :m :n
  output quotient (abs product :m :n) gcd :m :n
end


function gcd( m, n )
    while n ~= 0 do
        local q = m
        m = n
        n = q % n
    end
    return m
end

function lcm( m, n )
    return ( m ~= 0 and n ~= 0 ) and m * n / gcd( m, n ) or 0
end

print( lcm(12,18) )


lcm(a, b);   /* a and b may be integers or polynomials */

/* In Maxima the gcd of two integers is always positive, and a * b = gcd(a, b) * lcm(a, b),
so the lcm may be negative. To get a positive lcm, simply do */

abs(lcm(a, b))


Textwindow.Write("LCM(35, 21) = ")
mlcm = 35
nlcm = 21
CalculateLCM()
TextWindow.WriteLine(lcm)

Sub CalculateLCM
  mgcd = mlcm
  ngcd = nlcm
  CalculateGCD()
  lcm = mlcm / gcd * nlcm
EndSub

Sub CalculateGCD
  While mgcd <> 0
    tmp = mgcd
    mgcd = Math.Remainder(ngcd, mgcd)
    ngcd = tmp
  EndWhile
  gcd = ngcd
EndSub


gcd = function(a, b)
    while b
        temp = b
        b = a % b
        a = temp
    end while
    return abs(a)
end function

lcm = function(a,b)
    if not a and not b then return 0
    return abs(a * b) / gcd(a, b)
end function

print lcm(18,12)


function var int: lcm(int: a2,int:b2) =
  let {
    int:a1 = max(a2,b2);
    int:b1 = min(a2,b2);
    array[0..a1,0..b1] of var int: gcd;
    constraint forall(a in 0..a1)(
      forall(b in 0..b1)(
        gcd[a,b] ==
        if (b == 0) then
          a
        else
          gcd[b, a mod b]
        endif
      )
    )
  } in (a1*b1) div gcd[a1,b1];

var int: lcm1 = lcm(18,12);
solve satisfy;
output [show(lcm1),"\n"];


((0 <) (-1 *) when) :abs
((dup 0 ==) (pop abs) (swap over mod) () linrec) :gcd
(over over gcd '* dip div) :lcm


ИПA	ИПB	*	|x|	ПC	ИПA	ИПB	/	[x]	П9
ИПA	ИПB	ПA	ИП9	*	-	ПB	x=0	05	ИПC
ИПA	/	С/П


fun gcd (a, 0) = a
      | (0, b) = b
      | (a, b) where (a < b)
               = gcd (a, b rem a)
      | (a, b) = gcd (b, a rem b)

fun lcm (a, b) = let val d = gcd (a, b)
                 in a * b div d
                 end


MODULE LeastCommonMultiple;

FROM STextIO IMPORT
  WriteString, WriteLn;
FROM SWholeIO IMPORT
  WriteInt;

PROCEDURE GCD(M, N: INTEGER): INTEGER;
VAR
  Tmp: INTEGER;
BEGIN
  WHILE M <> 0 DO
    Tmp := M;
    M := N MOD M;
    N := Tmp;
  END;
  RETURN N;
END GCD;

PROCEDURE LCM(M, N: INTEGER): INTEGER;
BEGIN
  RETURN M / GCD(M, N) * N;
END LCM;

BEGIN
  WriteString("LCM(35, 21) = ");
  WriteInt(LCM(35, 21), 1);
  WriteLn;
END LeastCommonMultiple.


def gcd(a, b)
	if (a < 1) or (b < 1)
		throw new(InvalidNumberException, "gcd cannot be calculated on values < 1")
	end

	c = 0
	while b != 0
		c = a
		a = b
		b = c % b
	end

	return a
end

def lcm(m, n)
	return (m * n) / gcd(m, n)
end

println lcm(12, 18)
println lcm(6, 14)
println lcm(1,2) = lcm(2,1)


/* NetRexx */
options replace format comments java crossref symbols nobinary

numeric digits 3000

runSample(arg)
return

-- ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
method lcm(m_, n_) public static
  L_ = m_ * n_ % gcd(m_, n_)
  return L_

-- ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
-- Euclid's algorithm - iterative implementation
method gcd(m_, n_) public static
  loop while n_ > 0
    c_ = m_ // n_
    m_ = n_
    n_ = c_
    end
  return m_

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method runSample(arg) private static
  parse arg samples
  if samples = '' | samples = '.' then
    samples = '-6 14 =    42 |' -
               '3  4 =    12 |' -
              '18 12 =    36 |' -
               '2  0 =     0 |' -
               '0 85 =     0 |' -
              '12 18 =    36 |' -
               '5 12 =    60 |' -
              '12 22 =   132 |' -
               '7 31 =   217 |' -
             '117 18 =   234 |' -
              '38 46 =   874 |' -
           '18 12 -5 =   180 |' -
           '-5 18 12 =   180 |' - -- confirm that other permutations work
           '12 -5 18 =   180 |' -
        '18 12 -5 97 = 17460 |' -
              '30 42 =   210 |' -
              '30 42 =     . |' - -- 210; no verification requested
              '18 12'             -- 36

  loop while samples \= ''
    parse samples sample '|' samples
    loop while sample \= ''
      parse sample mnvals '=' chk sample
      if chk = '' then chk = '.'
      mv = mnvals.word(1)
      loop w_ = 2 to mnvals.words mnvals
        nv = mnvals.word(w_)
        mv = mv.abs
        nv = nv.abs
        mv = lcm(mv, nv)
        end w_
      lv = mv
      select case chk
        when '.' then state = ''
        when lv  then state = '(verified)'
        otherwise     state = '(failed)'
        end
      mnvals = mnvals.space(1, ',').changestr(',', ', ')
      say 'lcm of' mnvals.right(15.max(mnvals.length)) 'is' lv.right(5.max(lv.length)) state
      end
    end

  return


proc gcd(u, v: int): auto =
  var
    u = u
    v = v
  while v != 0:
    u = u %% v
    swap u, v
  abs(u)

proc lcm(a, b: int): auto = abs(a * b) div gcd(a, b)

echo lcm(12, 18)
echo lcm(-6, 14)


class LCM {
  function : Main(args : String[]) ~ Nil {
    IO.Console->Print("lcm(35, 21) = ")->PrintLine(lcm(21,35));
  }

  function : lcm(m : Int, n : Int) ~ Int {
    return m / gcd(m, n) * n;
  }

  function : gcd(m : Int, n : Int) ~ Int {
    tmp : Int;
    while(m <> 0) { tmp := m; m := n % m; n := tmp; };
    return n;
  }
}


let rec gcd u v =
  if v <> 0 then (gcd v (u mod v))
  else (abs u)

let lcm m n =
  match m, n with
  | 0, _ | _, 0 -> 0
  | m, n -> abs (m * n) / (gcd m n)

let () =
  Printf.printf "lcm(35, 21) = %d\n" (lcm 21 35)


say lcm(18, 12)

-- calculate the greatest common denominator of a numerator/denominator pair
::routine gcd private
  use arg x, y

  loop while y \= 0
      -- check if they divide evenly
      temp = x // y
      x = y
      y = temp
  end
  return x

-- calculate the least common multiple of a numerator/denominator pair
::routine lcm private
  use arg x, y
  return x / gcd(x, y) * y


#include <order/interpreter.h>

#define ORDER_PP_DEF_8gcd ORDER_PP_FN( \
8fn(8U, 8V,                            \
    8if(8isnt_0(8V), 8gcd(8V, 8remainder(8U, 8V)), 8U)))

#define ORDER_PP_DEF_8lcm ORDER_PP_FN( \
8fn(8X, 8Y,                            \
    8if(8or(8is_0(8X), 8is_0(8Y)),     \
        0,                             \
        8quotient(8times(8X, 8Y), 8gcd(8X, 8Y)))))
// No support for negative numbers

ORDER_PP( 8to_lit(8lcm(12, 18)) )   // 36


Program LeastCommonMultiple(output);

{$IFDEF FPC}
  {$MODE DELPHI}
{$ENDIF}

function lcm(a, b: longint): longint;
begin
  result := a;
  while (result mod b) <> 0 do
    inc(result, a);
end;

begin
  writeln('The least common multiple of 12 and 18 is: ', lcm(12, 18));
end.


with javascript_semantics
?lcm(12,18)
?lcm({12,18})


def gcd /# u v -- n #/
	abs int swap abs int swap

	dup
	while
		over over mod rot drop dup
	endwhile
	drop
enddef

def lcm /# m n -- n #/
	over over gcd rot swap / *
enddef

12345 50 lcm print


(de lcm (A B)
   (abs (*/ A B (gcd A B))) )


/* Calculate the Least Common Multiple of two integers. */

LCM: procedure options (main);          /* 16 October 2013 */
   declare (m, n) fixed binary (31);

   get (m, n);
   put edit ('The LCM of ', m, ' and ', n, ' is', LCM(m, n)) (a, x(1));

LCM: procedure (m, n) returns (fixed binary (31));
   declare (m, n) fixed binary (31) nonassignable;

   if m = 0 | n = 0 then return (0);
   return (abs(m*n) / GCD(m, n));
end LCM;

GCD: procedure (a, b) returns (fixed binary (31)) recursive;
   declare (a, b) fixed binary (31);

   if b = 0 then return (a);

   return (GCD (b, mod(a, b)) );

end GCD;
end LCM;


function gcd ($a, $b)  {
    function pgcd ($n, $m)  {
        if($n -le $m) {
            if($n -eq 0) {$m}
            else{pgcd $n ($m-$n)}
        }
        else {pgcd $m $n}
    }
    $n = [Math]::Abs($a)
    $m = [Math]::Abs($b)
    (pgcd $n $m)
}
function lcm ($a, $b)  {
    [Math]::Abs($a*$b)/(gcd $a $b)
}
lcm 12 18


lcm(X, Y, Z) :-
	Z is abs(X * Y) / gcd(X,Y).


Procedure GCDiv(a, b); Euclidean algorithm
  Protected r
  While b
    r = b
    b = a%b
    a = r
  Wend
  ProcedureReturn a
EndProcedure

Procedure LCM(m,n)
  Protected t
  If m And n
    t=m*n/GCDiv(m,n)
  EndIf
  ProcedureReturn t*Sign(t)
EndProcedure


>>> import fractions
>>> def lcm(a,b): return abs(a * b) / fractions.gcd(a,b) if a and b else 0

>>> lcm(12, 18)
36
>>> lcm(-6, 14)
42
>>> assert lcm(0, 2) == lcm(2, 0) == 0
>>>


(define gcd
  A 0 -> A
  A B -> (gcd B (MOD A B)))

(define lcm A B -> (/ (* A B) (gcd A B)))


[ [ dup while
    tuck mod again ]
  drop abs ]         is gcd ( n n --> n )

[ 2dup and iff
    [ 2dup gcd
      / * abs ]
  else and ]         is lcm ( n n --> n )


"%gcd%" <- function(u, v) {ifelse(u %% v != 0, v %gcd% (u%%v), v)}

"%lcm%" <- function(u, v) { abs(u*v)/(u %gcd% v)}

print (50 %lcm% 75)


#lang racket
(lcm 3 4 5 6)        ;returns 60
(lcm 8 108)          ;returns 216
(gcd 8 108)          ;returns 4
(gcd 108 216 432)    ;returns 108


say 3 lcm 4;            # infix
say [lcm] 1..20;        # reduction
say ~(1..10 Xlcm 1..10) # cross


: gcd ( ab-n ) [ tuck mod dup ] while drop ;
: lcm ( ab-n ) 2over gcd [ * ] dip / ;


/*REXX program finds the  LCM  (Least Common Multiple)  of any number of integers.      */
numeric digits 10000                             /*can handle 10k decimal digit numbers.*/
say 'the LCM of      19  and   0                   is ───►  '     lcm(19    0            )
say 'the LCM of       0  and  85                   is ───►  '     lcm( 0   85            )
say 'the LCM of      14  and  -6                   is ───►  '     lcm(14,  -6            )
say 'the LCM of      18  and  12                   is ───►  '     lcm(18   12            )
say 'the LCM of      18  and  12  and  -5          is ───►  '     lcm(18   12,   -5      )
say 'the LCM of      18  and  12  and  -5  and  97 is ───►  '     lcm(18,  12,   -5,   97)
say 'the LCM of 2**19-1  and  2**521-1             is ───►  '     lcm(2**19-1    2**521-1)
                                                 /* [↑]   7th  &  13th  Mersenne primes.*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
lcm: procedure; parse arg $,_; $=$ _;           do i=3  to arg();  $=$ arg(i);  end  /*i*/
     parse var $ x $                                  /*obtain the first value in args. */
     x=abs(x)                                         /*use the absolute value of  X.   */
               do  while $\==''                       /*process the remainder of args.  */
               parse var $ ! $;    if !<0  then !=-!  /*pick off the next arg (ABS val).*/
               if !==0  then return 0                 /*if zero, then LCM is also zero. */
               d=x*!                                  /*calculate part of the LCM here. */
                      do  until !==0;    parse  value   x//!  !     with     !  x
                      end   /*until*/                 /* [↑]  this is a short & fast GCD*/
               x=d%x                                  /*divide the pre─calculated value.*/
               end   /*while*/                        /* [↑]  process subsequent args.  */
     return x                                         /*return with the LCM of the args.*/


see lcm(24,36)

func lcm m,n
     lcm = m*n / gcd(m,n)
     return lcm

func gcd gcd, b
     while b
           c   = gcd
           gcd = b
           b   = c % b
     end
     return gcd


print "lcm( 12, -18) = "; lcm( 12, -18)
print "lcm( 15,  12) = "; lcm( 15,  12)
print "lcm(-10, -14) = "; lcm(-10, -14)
print "lcm(  0,   1) = "; lcm(  0,   1)
end

function lcm(m, n)
    lcm = abs(m * n) / GCD(m, n)
end function

function GCD(a, b)
    while b
        c = a
        a = b
        b = c mod b
    wend
    GCD = abs(a)
end function


def gcd(a: Int, b: Int):Int=if (b==0) a.abs else gcd(b, a%b)
def lcm(a: Int, b: Int)=(a*b).abs/gcd(a,b)


>(define gcd (lambda (a b)
         (if (zero? b)
             a
             (gcd b (remainder a b)))))
>(define lcm (lambda (a b)
         (if (or (zero? a) (zero? b))
             0
             (abs (* b (floor (/ a (gcd a b))))))))
>(lcm 12 18)
36


$ include "seed7_05.s7i";

const func integer: gcd (in var integer: a, in var integer: b) is func
  result
    var integer: gcd is 0;
  local
    var integer: help is 0;
  begin
    while a <> 0 do
      help := b rem a;
      b := a;
      a := help;
    end while;
    gcd := b;
  end func;

const func integer: lcm (in integer: a, in integer: b) is
  return a div gcd(a, b) * b;

const proc: main is func
  begin
    writeln("lcm(35, 21) = " <& lcm(21, 35));
  end func;


function gcd m, n
	repeat while m is greater than 0
		put m into temp
		put n modulo m into m
		put temp into n
	end repeat
	return n
end gcd

function lcm m, n
	return m divided by gcd(m, n) times n
end lcm


function factors(n) {
	var f = {};

	for var i = 2; n > 1; i++ {
		while n % i == 0 {
			n /= i;
			f[i] = f[i] != nil ? f[i] + 1 : 1;
		}
	}

	return f;
}

function GCD(n, k) {
	let f1 = factors(n);
	let f2 = factors(k);

	let fs = map(f1, function(factor, multiplicity) {
		let m = f2[factor];
		return m == nil ? 0 : min(m, multiplicity);
	});

	let rfs = {};
	foreach(fs, function(k, v) {
		rfs[sizeof rfs] = pow(k, v);
	});

	return reduce(rfs, 1, function(x, y) { return x * y; });
}

function LCM(n, k) {
	return n * k / GCD(n, k);
}


val rec gcd = fn (x, 0) => abs x | p as (_, y) => gcd (y, Int.rem p)

val lcm = fn p as (x, y) => Int.quot (abs (x * y), gcd p)


func lcm(a:Int, b:Int) -> Int {
    return abs(a * b) / gcd_rec(a, b)
}


proc lcm {p q} {
    set m [expr {$p * $q}]
    if {!$m} {return 0}
    while 1 {
	set p [expr {$p % $q}]
	if {!$p} {return [expr {$m / $q}]}
	set q [expr {$q % $p}]
	if {!$q} {return [expr {$m / $p}]}
    }
}


// library: math: get: least: common: multiple <description></description> <version control></version control> <version>1.0.0.0.2</version> <version control></version control> (filenamemacro=getmacmu.s) [<Program>] [<Research>] [kn, ri, su, 20-01-2013 14:36:11]
INTEGER PROC FNMathGetLeastCommonMultipleI( INTEGER x1I, INTEGER x2I )
 //
 RETURN( x1I * x2I / FNMathGetGreatestCommonDivisorI( x1I, x2I ) )
 //
END

// library: math: get: greatest: common: divisor <description>greatest common divisor whole numbers. Euclid's algorithm. Recursive version</description> <version control></version control> <version>1.0.0.0.3</version> <version control></version control> (filenamemacro=getmacdi.s) [<Program>] [<Research>] [kn, ri, su, 20-01-2013 14:22:41]
INTEGER PROC FNMathGetGreatestCommonDivisorI( INTEGER x1I, INTEGER x2I )
 //
 IF ( x2I == 0 )
  //
  RETURN( x1I )
  //
 ENDIF
 //
 RETURN( FNMathGetGreatestCommonDivisorI( x2I, x1I MOD x2I ) )
 //
END

PROC Main()
 //
 STRING s1[255] = "10"
 STRING s2[255] = "20"
 REPEAT
  IF ( NOT ( Ask( "math: get: least: common: multiple: x1I = ", s1, _EDIT_HISTORY_ ) ) AND ( Length( s1 ) > 0 ) ) RETURN() ENDIF
  IF ( NOT ( Ask( "math: get: least: common: multiple: x2I = ", s2, _EDIT_HISTORY_ ) ) AND ( Length( s2 ) > 0 ) ) RETURN() ENDIF
  Warn( FNMathGetLeastCommonMultipleI( Val( s1 ), Val( s2 ) ) ) // gives e.g. 10
 UNTIL FALSE
END


// Least common multiple

function gcd(m: number, n: number): number {
  var tmp: number;
  while (m != 0) {
    tmp = m;
    m = n % m;
    n = tmp;
  }
  return n;
}

function lcm(m: number, n: number): number {
    return Math.floor(m / gcd(m, n)) * n;
}

console.log(`LCM(35, 21) = ${lcm(35, 21)}`);


Print "LCM of 12 : 18 = "; FUNC(_LCM(12,18))

End

_GCD_Iterative_Euclid Param(2)
  Local (1)
  Do While [email protected]
    [email protected] = [email protected]
    [email protected] = [email protected]
    [email protected] = [email protected] % [email protected]
  Loop
Return (ABS([email protected]))

_LCM Param(2)
If [email protected]*[email protected]
  Return (ABS([email protected]*[email protected])/FUNC(_GCD_Iterative_Euclid([email protected],[email protected])))
Else
  Return (0)
EndIf


import "math"
out (lcm 12 18) endl console


int lcm(int a, int b){
    /*Return least common multiple of two ints*/
    // check for 0's
    if (a == 0 || b == 0)
	return 0;

    // Math.abs(x) only works for doubles, Math.absf(x) for floats
    if (a < 0)
        a *= -1;
    if (b < 0)
	b *= -1;

    int x = 1;
    while (true){
        if (a * x % b == 0)
            return a*x;
        x++;
    }
}

void main(){
    int	a = 12;
    int	b = 18;

    stdout.printf("lcm(%d, %d) = %d\n",	a, b, lcm(a, b));
}


Function gcd(u As Long, v As Long) As Long
    Dim t As Long
    Do While v
        t = u
        u = v
        v = t Mod v
    Loop
    gcd = u
End Function
Function lcm(m As Long, n As Long) As Long
    lcm = Abs(m * n) / gcd(m, n)
End Function


Function LCM(a,b)
	LCM = POS((a * b)/GCD(a,b))
End Function

Function GCD(a,b)
	Do
		If a Mod b > 0 Then
			c = a Mod b
			a = b
			b = c
		Else
			GCD = b
			Exit Do
		End If
	Loop
End Function

Function POS(n)
	If n < 0 Then
		POS = n * -1
	Else
		POS = n
	End If
End Function

i = WScript.Arguments(0)
j = WScript.Arguments(1)

WScript.StdOut.Write "The LCM of " & i & " and " & j & " is " & LCM(i,j) & "."
WScript.StdOut.WriteLine


var gcd = Fn.new { |x, y|
    while (y != 0) {
        var t = y
        y = x % y
        x = t
    }
    return x.abs
}

var lcm = Fn.new { |x, y|
    if (x == 0 && y == 0) return 0
    return (x*y).abs / gcd.call(x, y)
}

var xys = [[12, 18], [-6, 14], [35, 0]]
for (xy in xys) {
    System.print("lcm(%(xy[0]), %(xy[1]))\t%("\b"*5) = %(lcm.call(xy[0], xy[1]))")
}


' Least common multiple
PROGRAM "leastcommonmultiple"
VERSION "0.0001"

DECLARE FUNCTION Entry()
INTERNAL FUNCTION Gcd(m&, n&)
INTERNAL FUNCTION Lcm(m&, n&)

FUNCTION Entry()
  PRINT "LCM(35, 21) ="; Lcm(35, 21)
END FUNCTION

FUNCTION Gcd(m&, n&)
  DO WHILE m& <> 0
    tmp& = m&
    m& = n& MOD m&
    n& = tmp&
  LOOP
  RETURN n&
END FUNCTION

FUNCTION Lcm(m&, n&)
  RETURN m& / Gcd(m&, n&) * n&
END FUNCTION

END PROGRAM


include c:\cxpl\codes;

func GCD(M,N);  \Return the greatest common divisor of M and N
int  M, N;
int  T;
[while N do     \Euclid's method
    [T:= M;  M:= N;  N:= rem(T/N)];
return M;
];

func LCM(M,N);  \Return least common multiple
int  M, N;
return abs(M*N) / GCD(M,N);

\Display the LCM of two integers entered on command line
IntOut(0, LCM(IntIn(8), IntIn(8)))


sub gcd(u, v)
    local t

    u = int(abs(u))
    v = int(abs(v))
    while(v)
        t = u
        u = v
        v = mod(t, v)
    wend
    return u
end sub

sub lcm(m, n)
    return m / gcd(m, n) * n
end sub

print "Least common multiple: ", lcm(12345, 23044)


fcn lcm(m,n){ (m*n).abs()/m.gcd(n) }  // gcd is a number method


// Jacobson and Matthews technique for generating Latin Squares. Nigel Galloway: August 5th., 2019
let R=let N=System.Random() in (fun n->N.Next(n))

let jmLS α X0=
  let X0=Array2D.copy X0
  let N=let N=[|[0..α-1];[α-1..(-1)..0]|] in (fun()->N.[R 2])
  let rec randLS i j z n g s=
    X0.[i,g]<-s; X0.[n,j]<-s
    if X0.[n,g]=s then X0.[n,g]<-z; X0
    else randLS n g s (List.find(fun n->X0.[n,g]=s)(N())) (List.find(fun g->X0.[n,g]=s)(N())) (if (R 2)=0 then let t=X0.[n,g] in X0.[n,g]<-z; t else z)
  let i,j=R α,R α
  let z  =let z=1+(R (α-1)) in if z<X0.[i,j] then z else 1+(z+1)%α
  let n,g,s=let N=[0..α-1] in (List.find(fun n->X0.[n,j]=z) N,List.find(fun n->X0.[i,n]=z) N,X0.[i,j])
  X0.[i,j]<-z; randLS i j z n g s

let asNormLS α=
  let n=Array.init (Array2D.length1 α) (fun n->(α.[n,0]-1,n))|>Map.ofArray
  let g=Array.init (Array2D.length1 α) (fun g->(α.[n.[0],g]-1,g))|>Map.ofArray
  Array2D.init (Array2D.length1 α) (Array2D.length1 α) (fun i j->α.[n.[i],g.[j]])

let randLS α=Seq.unfold(fun g->Some(g,jmLS α g))(Array2D.init α α (fun n g->1+(n+g)%α))


package main

import (
    "fmt"
    "math/rand"
    "time"
)

type (
    vector []int
    matrix []vector
    cube   []matrix
)

func toReduced(m matrix) matrix {
    n := len(m)
    r := make(matrix, n)
    for i := 0; i < n; i++ {
        r[i] = make(vector, n)
        copy(r[i], m[i])
    }
    for j := 0; j < n-1; j++ {
        if r[0][j] != j {
            for k := j + 1; k < n; k++ {
                if r[0][k] == j {
                    for i := 0; i < n; i++ {
                        r[i][j], r[i][k] = r[i][k], r[i][j]
                    }
                    break
                }
            }
        }
    }
    for i := 1; i < n-1; i++ {
        if r[i][0] != i {
            for k := i + 1; k < n; k++ {
                if r[k][0] == i {
                    for j := 0; j < n; j++ {
                        r[i][j], r[k][j] = r[k][j], r[i][j]
                    }
                    break
                }
            }
        }
    }
    return r
}

// 'm' is assumed to be 0 based
func printMatrix(m matrix) {
    n := len(m)
    for i := 0; i < n; i++ {
        for j := 0; j < n; j++ {
            fmt.Printf("%2d ", m[i][j]+1) // back to 1 based
        }
        fmt.Println()
    }
    fmt.Println()
}

// converts 4 x 4 matrix to 'flat' array
func asArray16(m matrix) [16]int {
    var a [16]int
    k := 0
    for i := 0; i < 4; i++ {
        for j := 0; j < 4; j++ {
            a[k] = m[i][j]
            k++
        }
    }
    return a
}

// converts 5 x 5 matrix to 'flat' array
func asArray25(m matrix) [25]int {
    var a [25]int
    k := 0
    for i := 0; i < 5; i++ {
        for j := 0; j < 5; j++ {
            a[k] = m[i][j]
            k++
        }
    }
    return a
}

// 'a' is assumed to be 0 based
func printArray16(a [16]int) {
    for i := 0; i < 4; i++ {
        for j := 0; j < 4; j++ {
            k := i*4 + j
            fmt.Printf("%2d ", a[k]+1) // back to 1 based
        }
        fmt.Println()
    }
    fmt.Println()
}

func shuffleCube(c cube) {
    n := len(c[0])
    proper := true
    var rx, ry, rz int
    for {
        rx = rand.Intn(n)
        ry = rand.Intn(n)
        rz = rand.Intn(n)
        if c[rx][ry][rz] == 0 {
            break
        }
    }
    for {
        var ox, oy, oz int
        for ; ox < n; ox++ {
            if c[ox][ry][rz] == 1 {
                break
            }
        }
        if !proper && rand.Intn(2) == 0 {
            for ox++; ox < n; ox++ {
                if c[ox][ry][rz] == 1 {
                    break
                }
            }
        }

        for ; oy < n; oy++ {
            if c[rx][oy][rz] == 1 {
                break
            }
        }
        if !proper && rand.Intn(2) == 0 {
            for oy++; oy < n; oy++ {
                if c[rx][oy][rz] == 1 {
                    break
                }
            }
        }

        for ; oz < n; oz++ {
            if c[rx][ry][oz] == 1 {
                break
            }
        }
        if !proper && rand.Intn(2) == 0 {
            for oz++; oz < n; oz++ {
                if c[rx][ry][oz] == 1 {
                    break
                }
            }
        }

        c[rx][ry][rz]++
        c[rx][oy][oz]++
        c[ox][ry][oz]++
        c[ox][oy][rz]++

        c[rx][ry][oz]--
        c[rx][oy][rz]--
        c[ox][ry][rz]--
        c[ox][oy][oz]--

        if c[ox][oy][oz] < 0 {
            rx, ry, rz = ox, oy, oz
            proper = false
        } else {
            proper = true
            break
        }
    }
}

func toMatrix(c cube) matrix {
    n := len(c[0])
    m := make(matrix, n)
    for i := 0; i < n; i++ {
        m[i] = make(vector, n)
    }
    for i := 0; i < n; i++ {
        for j := 0; j < n; j++ {
            for k := 0; k < n; k++ {
                if c[i][j][k] != 0 {
                    m[i][j] = k
                    break
                }
            }
        }
    }
    return m
}

// 'from' matrix is assumed to be 1 based
func makeCube(from matrix, n int) cube {
    c := make(cube, n)
    for i := 0; i < n; i++ {
        c[i] = make(matrix, n)
        for j := 0; j < n; j++ {
            c[i][j] = make(vector, n)
            var k int
            if from == nil {
                k = (i + j) % n
            } else {
                k = from[i][j] - 1
            }
            c[i][j][k] = 1
        }
    }
    return c
}

func main() {
    rand.Seed(time.Now().UnixNano())

    // part 1
    fmt.Println("PART 1: 10,000 latin Squares of order 4 in reduced form:\n")
    from := matrix{{1, 2, 3, 4}, {2, 1, 4, 3}, {3, 4, 1, 2}, {4, 3, 2, 1}}
    freqs4 := make(map[[16]int]int, 10000)
    c := makeCube(from, 4)
    for i := 1; i <= 10000; i++ {
        shuffleCube(c)
        m := toMatrix(c)
        rm := toReduced(m)
        a16 := asArray16(rm)
        freqs4[a16]++
    }
    for a, freq := range freqs4 {
        printArray16(a)
        fmt.Printf("Occurs %d times\n\n", freq)
    }

    // part 2
    fmt.Println("\nPART 2: 10,000 latin squares of order 5 in reduced form:")
    from = matrix{{1, 2, 3, 4, 5}, {2, 3, 4, 5, 1}, {3, 4, 5, 1, 2},
        {4, 5, 1, 2, 3}, {5, 1, 2, 3, 4}}
    freqs5 := make(map[[25]int]int, 10000)
    c = makeCube(from, 5)
    for i := 1; i <= 10000; i++ {
        shuffleCube(c)
        m := toMatrix(c)
        rm := toReduced(m)
        a25 := asArray25(rm)
        freqs5[a25]++
    }
    count := 0
    for _, freq := range freqs5 {
        count++
        if count > 1 {
            fmt.Print(", ")
        }
        if (count-1)%8 == 0 {
            fmt.Println()
        }
        fmt.Printf("%2d(%3d)", count, freq)
    }
    fmt.Println("\n")

    // part 3
    fmt.Println("\nPART 3: 750 latin squares of order 42, showing the last one:\n")
    var m42 matrix
    c = makeCube(nil, 42)
    for i := 1; i <= 750; i++ {
        shuffleCube(c)
        if i == 750 {
            m42 = toMatrix(c)
        }
    }
    printMatrix(m42)

    // part 4
    fmt.Println("\nPART 4: 1000 latin squares of order 256:\n")
    start := time.Now()
    c = makeCube(nil, 256)
    for i := 1; i <= 1000; i++ {
        shuffleCube(c)
    }
    elapsed := time.Since(start)
    fmt.Printf("Generated in %s\n", elapsed)
}


const Cube = Vector{Vector{Vector{Int}}}
const Mat = Vector{Vector{Int}}

function reduced(m::Mat)
    n = length(m)
    r = deepcopy(m)
    for j in 1:n-1
        if r[1][j] != j
            for k in j+1:n
                if r[1][k] == j
                    for i in 1:n
                        r[i][j], r[i][k] = r[i][k], r[i][j]
                    end
                    break
                end
            end
        end
    end
    for i in 2:n-1
        if r[i][1] != i
            for k in i+1:n
                if r[k][1] == i
                    for j in 1:n
                        r[i][j], r[k][j] = r[k][j], r[i][j]
                    end
                    break
                end
            end
        end
    end
    return r
end

""" print matrix as small integers, no punctuation """
function print_matrix(m::Mat)
    n = length(m)
    padding = max(2, Int(ceil(log(10, n+1))) + 1)
    for i in 1:n
        for j in 1:n
            print(lpad(m[i][j], padding))
        end
        println()
    end
    println()
end

function shuffle_cube(c::Cube)
    n = length(c)
    proper = true
    rx, ry, rz = 0, 0, 0
    while true
        rx, ry, rz = rand(1:n, 3)
        c[rx][ry][rz] == 0 && break
    end
    while true
        ox = something(findfirst(i -> c[i][ry][rz] == 1, 1:n), n)
        oy = something(findfirst(i -> c[rx][i][rz] == 1, 1:n), n)
        oz = something(findfirst(i -> c[rx][ry][i] == 1, 1:n), n)
        if !proper
            rand() < 1/2 && (ox = something(findlast(i -> c[i][ry][rz] == 1, 1:n), n))
            rand() < 1/2 && (oy = something(findlast(i -> c[rx][i][rz] == 1, 1:n), n))
            rand() < 1/2 && (oz = something(findlast(i -> c[rx][ry][i] == 1, 1:n), n))
        end

        c[rx][ry][rz] += 1
        c[rx][oy][oz] += 1
        c[ox][ry][oz] += 1
        c[ox][oy][rz] += 1

        c[rx][ry][oz] -= 1
        c[rx][oy][rz] -= 1
        c[ox][ry][rz] -= 1
        c[ox][oy][oz] -= 1

        if c[ox][oy][oz] < 0
            rx, ry, rz = ox, oy, oz
            proper = false
        else
            break
        end
    end
end

function matrix(c::Cube)::Mat
    n = length(c)
    m = [[0 for i in 1:n] for j in 1:n]
    for i in 1:n, j in 1:n
        for k in 1:n
            if c[i][j][k] != 0
                m[i][j] = k
                break
            end
        end
    end
    return m
end

function cube(from, n)
    c = [[[0 for i in 1:n] for j in 1:n] for k in 1:n]
    for i in 1:n, j in 1:n
        k = (from isa Nothing) ? mod1(i + j, n) : from[i][j]
        c[i][j][k] = 1
    end
    return c
end

function testJacobsenMatthews()
    # part 1
    println("PART 1: 10,000 latin Squares of order 4 in reduced form:\n")
    from = [[1, 2, 3, 4], [2, 1, 4, 3], [3, 4, 1, 2], [4, 3, 2, 1]]
    freqs4 = Dict{Array, Int}()
    c = cube(from, 4)
    for i in 1:10000
        shuffle_cube(c)
        m = matrix(c)
        rm = reduced(m)
        n = get!(freqs4, rm, 0)
        freqs4[rm] = n + 1
    end
    for (a, freq) in freqs4
        print_matrix(a)
        println("Occurs $freq times\n")
    end

    # part 2
    println("\nPART 2: 10,000 latin squares of order 5 in reduced form:\n")
    from = [[1, 2, 3, 4, 5], [2, 3, 4, 5, 1], [3, 4, 5, 1, 2], [4, 5, 1, 2, 3], [5, 1, 2, 3, 4]]
    freqs5 = Dict{Array, Int}()
    c = cube(from, 5)
    for i in 1:10000
        shuffle_cube(c)
        m = matrix(c)
        rm = reduced(m)
        n = get!(freqs5, rm, 0)
        freqs5[rm] = n + 1
    end
    for (i, freq) in enumerate(sort(collect(values(freqs5))))
        i > 1 && (print(", "); (i - 1) % 8 == 0 && println())
        print(lpad(i, 2), "(", lpad(freq, 3), ")")
    end
    println("\n")

    # part 3
    println("\nPART 3: 750 latin squares of order 42, showing the last one:\n")
    m42 = [[0 for i in 1:42] for j in 1:42]
    c = cube(nothing, 42)
    for i in 1:750
        shuffle_cube(c)
        i == 750 && (m42 = matrix(c))
    end
    print_matrix(m42)

    # part 4
    println("\nPART 4: 1000 latin squares of order 256:\n")
    @time begin
        c = cube(nothing, 256)
        for i in 1:1000
            shuffle_cube(c)
        end
    end
end

testJacobsenMatthews()


import random, sequtils, strformat, tables, times

type
  Vector = seq[int]
  Matrix = seq[Vector]
  Cube = seq[Matrix]
  Array16 = array[16, int]
  Array25 = array[25, int]

func newCube(m: Matrix; n: Positive): Cube =
  result.setLen(n)
  for i in 0..<n:
    result[i].setLen(n)
    for j in 0..<n:
      result[i][j].setLen(n)
      let k = if m.len == 0: (i + j) mod n else: m[i][j] - 1
      result[i][j][k] = 1

proc shuffle(c: var Cube) =
  let n = c[0].len
  var proper = true

  var rx, ry, rz: int
  while true:
    rx = rand(n - 1)
    ry = rand(n - 1)
    rz = rand(n - 1)
    if c[rx][ry][rz] == 0: break

  while true:
    var ox, oy, oz = 0

    while ox < n:
      if c[ox][ry][rz] == 1: break
      inc ox
    if not proper and rand(1) == 0:
      inc ox
      while ox < n:
        if c[ox][ry][rz] == 1: break
        inc ox

    while oy < n:
      if c[rx][oy][rz] == 1: break
      inc oy
    if not proper and rand(1) == 0:
      inc oy
      while oy < n:
        if c[rx][oy][rz] == 1: break
        inc oy

    while oz < n:
      if c[rx][ry][oz] == 1: break
      inc oz
    if not proper and rand(1) == 0:
      inc oz
      while oz < n:
        if c[rx][ry][oz] == 1: break
        inc oz

    inc c[rx][ry][rz]
    inc c[rx][oy][oz]
    inc c[ox][ry][oz]
    inc c[ox][oy][rz]

    dec c[rx][ry][oz]
    dec c[rx][oy][rz]
    dec c[ox][ry][rz]
    dec c[ox][oy][oz]

    if c[ox][oy][oz] < 0:
      (rx, ry, rz) = (ox, oy, oz)
      proper = false
    else:
      proper = true
      break

func toMatrix(c: Cube): Matrix =
  let n = c[0].len
  result = newSeqWith(n, newSeq[int](n))
  for i in 0..<n:
    for j in 0..<n:
      for k in 0..<n:
        if c[i][j][k] != 0:
          result[i][j] = k
          break

func toReduced(m: Matrix): Matrix =
  let n = m.len
  result = m

  for j in 0..n-2:
    if result[0][j] != j:
      for k in j+1..<n:
        if result[0][k] == j:
          for i in 0..<n:
            swap result[i][j], result[i][k]
          break

  for i in 1..n-2:
    if result[i][0] != i:
      for k in i+1..<n:
        if result[k][0] == i:
          for j in 0..<n:
            swap result[i][j], result[k][j]
          break

func asArray16(m: Matrix): Array16 =
  var k = 0
  for i in 0..3:
    for j in 0..3:
      result[k] = m[i][j]
      inc k

func asArray25(m: Matrix): Array25 =
  var k = 0
  for i in 0..4:
    for j in 0..4:
      result[k] = m[i][j]
      inc k

proc printArray16(a: Array16) =
  for i in 0..3:
    for j in 0..3:
      let k = i * 4 + j
      stdout.write &"{a[k]+1:2} "   # Back to 1 based.
    echo()
  echo()

proc printMatrix(m: Matrix) =
  let n = m.len
  for i in 0..<n:
    for j in 0..<n:
      stdout.write &"{m[i][j]+1:2} "  # Back to 1 based.
    echo()
  echo()

randomize()

# Part 1.
echo "Part 1: 10_000 latin Squares of order 4 in reduced form:\n"
const From1: Matrix = @[@[1, 2, 3, 4], @[2, 1, 4, 3], @[3, 4, 1, 2], @[4, 3, 2, 1]]
var freqs4: CountTable[Array16]
var c = newCube(From1, 4)
for _ in 1..10_000:
  c.shuffle()
  let m = c.toMatrix
  let rm = m.toReduced
  let a16 = rm.asArray16
  freqs4.inc(a16)

for a, freq in freqs4.pairs:
  printArray16(a)
  echo &"Occurs {freq} times\n"

# Part 2.
echo "\nPart 2: 10_000 latin squares of order 5 in reduced form:"
const From2: Matrix = @[@[1, 2, 3, 4, 5], @[2, 3, 4, 5, 1], @[3, 4, 5, 1, 2],
                        @[4, 5, 1, 2, 3], @[5, 1, 2, 3, 4]]
var freqs5: CountTable[Array25]
c = newCube(From2, 5)
for _ in 1..10_000:
  c.shuffle()
  let m = c.toMatrix
  let rm = m.toReduced
  let a25 = rm.asArray25
  freqs5.inc(a25)

var count = 0
for freq in freqs5.values:
  inc count
  if count > 1: stdout.write ", "
  if (count - 1) mod 8 == 0: echo()
  stdout.write &"{count:2}({freq:3})"
echo '\n'

# Part 3.
echo "\nPart 3: 750 latin squares of order 42, showing the last one:\n"
var m42: Matrix
c = newCube(@[], 42)
for i in 1..750:
  c.shuffle()
  if i == 750:
    m42 = c.toMatrix
printMatrix(m42)

# Part 4.
echo "\nPart 4: 1000 latin squares of order 256:\n"
let start = cpuTime()
c = newCube(@[], 256)
for _ in 1..1000:
  c.shuffle()
echo &"Generated in {cpuTime() - start:.3f} s."


function shuffleCube(sequence c)
    integer n = length(c), rx, ry, rz
    bool bProper = true
    while true do
        rx = rand(n)
        ry = rand(n)
        rz = rand(n)
        if c[rx][ry][rz] == 0 then exit end if
    end while
    while true do
        integer ox, oy, oz
        for i=1 to n do
            ox = i
            if c[ox][ry][rz] == 1 then exit end if
        end for
        if not bProper and rand(2)==2 then
            for i=ox+1 to n do
                ox = i
                if c[ox][ry][rz] == 1 then exit end if
            end for
        end if
        for i=1 to n do
            oy = i
            if c[rx][oy][rz] == 1 then exit end if
        end for
        if not bProper and rand(2)==2 then
            for i=oy+1 to n do
                oy = i
                if c[rx][oy][rz] == 1 then exit end if
            end for
        end if
        for i=1 to n do
            oz = i
            if c[rx][ry][oz] == 1 then exit end if
        end for
        if not bProper and rand(2)==2 then
            for i=oz+1 to n do
                oz = i
                if c[rx][ry][oz] == 1 then exit end if
            end for
        end if

        c[rx][ry][rz] += 1
        c[rx][oy][oz] += 1
        c[ox][ry][oz] += 1
        c[ox][oy][rz] += 1

        c[rx][ry][oz] -= 1
        c[rx][oy][rz] -= 1
        c[ox][ry][rz] -= 1
        c[ox][oy][oz] -= 1

        if c[ox][oy][oz] < 0 then
            {rx, ry, rz} = {ox, oy, oz}
            bProper = false
        else
            bProper = true
            exit
        end if
    end while
    return c
end function

function toMatrix(sequence c)
    integer n = length(c)
    sequence m = repeat(repeat(0,n),n)
    for i=1 to n do
        for j=1 to n do
            for k=1 to n do
                if c[i][j][k] != 0 then
                    m[i][j] = k
                    exit
                end if
            end for
        end for
    end for
    return m
end function

function toReduced(sequence m)
    integer n := length(m)
    m = deep_copy(m)
    for j=1 to n-1 do
        if m[1][j]!=j then
            for k=j+1 to n do
                if m[1][k]==j then
                    for i=1 to n do
                        atom mij = m[i][j],
                             mik = m[i][k]
                        m[i][j] = mik
                        m[i][k] = mij

                    end for
                    exit
                end if
            end for
        end if
    end for
    for i=2 to n-1 do
        if m[i][1]!=i then
            for k=i+1 to n do
                if m[k][1]==i then
                    for j=1 to n do
                        atom mij = m[i][j],
                             mkj = m[k][j]
                        m[i][j] = mkj
                        m[k][j] = mij
                    end for
                    exit
                end if
            end for
        end if
    end for
    return m
end function

function makeCube(object orig, integer n)
    sequence c = repeat(repeat(repeat(0,n),n),n)
    for i=1 to n do
        for j=1 to n do
            integer k = iff(orig==NULL?mod(i+j,n)+1:orig[i][j])
            c[i][j][k] = 1
        end for
    end for
    return c
end function

procedure main()

    printf(1,"Part 1: 10,000 latin Squares of order 4 in reduced form:\n\n")
    sequence orig = {{1, 2, 3, 4}, {2, 1, 4, 3}, {3, 4, 1, 2}, {4, 3, 2, 1}},
             c := makeCube(orig, 4), m, rm, fk
    integer freq = new_dict()
    for i=1 to 10000 do
        c = shuffleCube(c)
        m = toMatrix(c)
        rm = toReduced(m)
        setd(rm,getd(rm,freq)+1,freq)
    end for
    fk = getd_all_keys(freq)
    for i=1 to length(fk) do
        printf(1,"%v occurs %d times\n", {fk[i],getd(fk[i],freq)})
    end for

    printf(1,"\nPart 2: 10,000 latin squares of order 5 in reduced form:\n\n")
    orig = {{1, 2, 3, 4, 5}, {2, 3, 4, 5, 1}, {3, 4, 5, 1, 2},
            {4, 5, 1, 2, 3}, {5, 1, 2, 3, 4}}
    c = makeCube(orig, 5)
    destroy_dict(freq, justclear:=true)
    for i=1 to 10000 do
        c = shuffleCube(c)
        m = toMatrix(c)
        rm = toReduced(m)
        setd(rm,getd(rm,freq)+1,freq)
    end for
    fk = getd_all_keys(freq)
    for i=1 to length(fk) do
        fk[i] = sprintf("%2d(%3d)", {i,getd(fk[i],freq)})
    end for
    puts(1,join_by(fk,8,7," ","\n"))
    destroy_dict(freq)

    -- part 3
    printf(1,"\nPart 3: 750 latin squares of order 42, showing the last one:\n\n")
    c = makeCube(NULL, 42)
    for i=1 to 750 do
        c = shuffleCube(c)
    end for
    m = toMatrix(c)
    integer n := length(m)
    for i=1 to n do
        for j=1 to n do
            m[i,j] = sprintf("%2d",m[i,j])
        end for
        m[i] = join(m[i]," ")
    end for
    printf(1,"%s\n",join(m,"\n"))

    -- part 4
    printf(1,"\nPART 4: 1000 latin squares of order 256:\n\n")
    atom t0 = time()
    c = makeCube(NULL, 256)
    for i=1 to 1000 do
        c = shuffleCube(c)
    end for
    printf(1,"Generated in %s\n", elapsed(time()-t0))
end procedure
main()


# 20210729 Raku programming solution

#!/usr/bin/env raku

sub makeCube(\from, Int \n) {
   my @c = [[[ 0 xx n ] xx n ] xx n ];
   from.Bool ?? do race for ^n X ^n -> (\i,\j) { @c[i;j; { from[i;j]-1 } ] = 1 }
             !! do race for ^n X ^n -> (\i,\j) { @c[i;j; {   (i+j)%n   } ] = 1 }
   return @c
}

sub shuffleCube(@c) {
   my ($rx, $ry, $rz); my \n = +@c; my Bool \proper = $ = True;

   repeat { ($rx ,$ry, $rz) = (^n).roll: 3 } until @c[$rx;$ry;$rz] == 0;
   loop {
      my ($ox, $oy, $oz);
      for ^n { last if @c[ $ox = $_ ;$ry;$rz] == 1 }
      if !proper and (^3).roll==0 {
         for $ox^…^n { last if @c[ $ox = $_ ;$ry;$rz] == 1 }
      }
      for ^n { last if @c[$rx; $oy = $_ ;$rz] == 1 }
      if !proper and (^3).roll==0 {
         for $oy^…^n { last if @c[$rx; $oy = $_ ;$rz] == 1 }
      }
      for ^n { last if @c[$rx;$ry;  $oz = $_ ] == 1 }
      if !proper and (^3).roll==0 {
         for $oz^…^n { last if @c[$rx;$ry; $oz = $_ ] == 1 }
      }

      (@c[$rx;$ry;$rz],@c[$rx;$oy;$oz],@c[$ox;$ry;$oz],@c[$ox;$oy;$rz]) »+=»1;
      (@c[$rx;$ry;$oz],@c[$rx;$oy;$rz],@c[$ox;$ry;$rz],@c[$ox;$oy;$oz]) »-=»1;

      @c[$ox;$oy;$oz] < 0 ?? (($rx,$ry,$rz) = ($ox,$oy,$oz)) !! last ;
      proper = False
   }
}

sub toMatrix(@c) {
   my \n = +@c;
   my @m = [[0 xx n] xx n];
   for ^n X ^n -> (\i,\j) {
      for ^n -> \k { if @c[i;j;k] != 0 { @m[i;j] = k and last } }
   }
   return @m
}

sub toReduced(@m is copy) {
   my \n = +@m;
   for 0…(n-2) -> \j {
      if ( @m[0;j] != j ) {
         for j^…^n -> \k {
            if ( @m[0;k] == j ) {
               for 0…^n -> \i { (@m[i;j], @m[i;k]) = (@m[i;k], @m[i;j]) }
               last
            }
         }
      }
   }
   for 1…(n-2) -> \i {
      if ( @m[i;0] != i ) {
         for i^…^n -> \k {
            if ( @m[k;0] == i ) {
               for 0…^n -> \j { (@m[i;j], @m[k;j]) = (@m[k;j], @m[i;j]) }
               last
            }
         }
      }
   }
   return @m
}

sub printAs1based { say ($_ »+» 1).Str for @_.rotor: @_.elems.sqrt }

my (%freq, @c, @in);

say "Part 1: 10,000 latin Squares of order 4 in reduced form:\n";
@in = [[1, 2, 3, 4], [2, 1, 4, 3], [3, 4, 1, 2], [4, 3, 2, 1]];
@c = makeCube(@in, 4);
for ^10_000 {
   shuffleCube @c ;
   %freq{@c.&toMatrix.&toReduced».List.flat.Str}++
}
for %freq.kv -> $k, $v {
   printAs1based $k.split(' ');
   say "\nOccurs $v times.\n"
}

say "Part 2: 10,000 latin Squares of order 5 in reduced form:\n";
@in = [ [1,2,3,4,5], [2,3,4,5,1], [3,4,5,1,2], [4,5,1,2,3], [5,1,2,3,4] ];
%freq = ();
@c = makeCube(@in, 5);
for ^10_000 {
   shuffleCube @c ;
   %freq{@c.&toMatrix.&toReduced».List.flat.Str}++
}
for %freq.values.kv -> $i, $j { printf "%2d(%3d)%s", $i+1, $j, ' ' }

say "\n\nPart 3: 750 latin squares of order 42, showing the last one:\n";
@c = makeCube([], 42); # (1..42).pick(*)
( for ^750 { shuffleCube @c } ) and printAs1based @c.&toMatrix».List.flat ;

say "\nPart 4: 100 latin squares of order 256:\n";
my $snapshot = now;
@c = makeCube([], 256);
for ^100 { shuffleCube @c } # without hyper, will do only 100 cycles
say "Generated in { now - $snapshot } seconds."


import "random" for Random
import "/fmt" for Fmt
import "/seq" for Lst

var rand = Random.new()

var toReduced = Fn.new { |m|
    var n = m.count
    var r = List.filled(n, null)
    for (i in 0...n) r[i] = m[i].toList
    for (j in 0...n-1) {
        if (r[0][j] != j) {
            for (k in j+1...n) {
                if (r[0][k] == j) {
                    for (i in 0...n) r[i].swap(j, k)
                    break
                }
            }
        }
    }
    for (i in 1...n-1) {
        if (r[i][0] != i) {
            for (k in i+1...n) {
                if (r[k][0] == i) {
                    for (j in 0...n) {
                        var t = r[i][j]
                        r[i][j] = r[k][j]
                        r[k][j] = t
                    }
                    break
                }
            }
        }
    }
    return r
}

// 'm' is assumed to be 0 based
var printMatrix = Fn.new { |m|
    var n = m.count
    for (i in 0...n) {
        for (j in 0...n) Fmt.write("$2d ", m[i][j]+1) // back to 1 based
        System.print()
    }
    System.print()
}

// converts 4 x 4 matrix to 'flat' list
var asList16 = Fn.new { |m| Lst.flatten(m) }

// converts 5 x 5 matrix to 'flat' list
var asList25 = Fn.new { |m| Lst.flatten(m) }

// 'a' is assumed to be 0 based
var printList16 = Fn.new { |a|
    for (i in 0...4) {
        for (j in 0...4) {
            var k = i*4 + j
            Fmt.write("$2d ", a[k]+1) // back to 1 based
        }
        System.print()
    }
    System.print()
}

var shuffleCube = Fn.new { |c|
    var n = c[0].count
    var proper = true
    var rx
    var ry
    var rz
    while (true) {
        rx = rand.int(n)
        ry = rand.int(n)
        rz = rand.int(n)
        if (c[rx][ry][rz] == 0) break
    }
    while (true) {
        var ox = 0
        var oy = 0
        var oz = 0
        while (ox < n) {
            if (c[ox][ry][rz] == 1) break
            ox = ox + 1
        }
        if (!proper && rand.int(2) == 0) {
            ox = ox + 1
            while (ox < n) {
                if (c[ox][ry][rz] == 1) break
                ox = ox + 1
            }
        }
        while (oy < n) {
            if (c[rx][oy][rz] == 1) break
            oy = oy + 1
        }
        if (!proper && rand.int(2) == 0) {
            oy = oy + 1
            while (oy < n) {
                if (c[rx][oy][rz] == 1) break
                oy = oy + 1
            }
        }
        while (oz < n) {
            if (c[rx][ry][oz] == 1) break
            oz = oz + 1
        }
        if (!proper && rand.int(2) == 0) {
            oz = oz + 1
            while (oz < n) {
                if (c[rx][ry][oz] == 1) break
                oz = oz + 1
            }
        }

        c[rx][ry][rz] = c[rx][ry][rz] + 1
        c[rx][oy][oz] = c[rx][oy][oz] + 1
        c[ox][ry][oz] = c[ox][ry][oz] + 1
        c[ox][oy][rz] = c[ox][oy][rz] + 1

        c[rx][ry][oz] = c[rx][ry][oz] - 1
        c[rx][oy][rz] = c[rx][oy][rz] - 1
        c[ox][ry][rz] = c[ox][ry][rz] - 1
        c[ox][oy][oz] = c[ox][oy][oz] - 1

        if (c[ox][oy][oz] < 0) {
            rx = ox
            ry = oy
            rz = oz
            proper = false
        } else {
            proper = true
            break
        }
    }
}

var toMatrix = Fn.new { |c|
    var n = c[0].count
    var m = List.filled(n, null)
    for (i in 0...n) m[i] = List.filled(n, 0)
    for (i in 0...n) {
        for (j in 0...n) {
            for (k in 0...n) {
                if (c[i][j][k] != 0) {
                    m[i][j] = k
                    break
                }
            }
        }
    }
    return m
}

// 'from' matrix is assumed to be 1 based
var makeCube = Fn.new { |from, n|
    var c = List.filled(n, null)
    for (i in 0...n) {
        c[i] = List.filled(n, null)
        for (j in 0...n) {
            c[i][j] = List.filled(n, 0)
            var k = (!from) ? (i + j) % n : from[i][j] - 1
            c[i][j][k] = 1
        }
    }
    return c
}

// part 1
System.print("PART 1: 10,000 latin Squares of order 4 in reduced form:\n")
var from = [ [1, 2, 3, 4], [2, 1, 4, 3], [3, 4, 1, 2], [4, 3, 2, 1] ]
var freqs4 = {}
var c = makeCube.call(from, 4)
for (i in 1..10000) {
    shuffleCube.call(c)
    var m = toMatrix.call(c)
    var rm = toReduced.call(m)
    var a16 = asList16.call(rm)
    var a16s = a16.toString // can't use a list as a map key so convert it to string
    freqs4[a16s] = freqs4[a16s] ? freqs4[a16s] + 1 : 1
}
for (me in freqs4) {
    printList16.call(me.key[1..-2].split(", ").map { |n| Num.fromString(n) }.toList)
    Fmt.print("Occurs $d times\n", me.value)
}

// part 2
System.print("\nPART 2: 10,000 latin squares of order 5 in reduced form:")
from = [ [1, 2, 3, 4, 5], [2, 3, 4, 5, 1], [3, 4, 5, 1, 2],
         [4, 5, 1, 2, 3], [5, 1, 2, 3, 4] ]
var freqs5 = {}
c = makeCube.call(from, 5)
for (i in 1..10000) {
    shuffleCube.call(c)
    var m = toMatrix.call(c)
    var rm = toReduced.call(m)
    var a25 = asList25.call(rm)
    var a25s = a25.toString // can't use a list as a map key so convert it to string
    freqs5[a25s] = freqs5[a25s] ? freqs5[a25s] + 1 : 1
}
var count = 0
for (freq in freqs5.values) {
    count = count + 1
    if (count > 1) System.write(", ")
    if ((count-1) % 8 == 0) System.print()
    Fmt.write("$2d($3d)", count, freq)
}
System.print("\n")

// part 3
System.print("\nPART 3: 750 latin squares of order 42, showing the last one:\n")
var m42
c = makeCube.call(null, 42)
for (i in 1..750) {
    shuffleCube.call(c)
    if (i == 750) m42 = toMatrix.call(c)
}
printMatrix.call(m42)

// part 4
System.print("\nPART 4: 1,000 latin squares of order 256:\n")
var start = System.clock
c = makeCube.call(null, 256)
for (i in 1..1000) shuffleCube.call(c)
var elapsed = System.clock - start
Fmt.print("Generated in $s seconds", elapsed)


F countletters(s)
   DefaultDict[Char, Int] results
   L(char) s
      V c = char.lowercase()
      I c C ‘a’..‘z’
         results[c]++
   R results

:start:
L(letter, count) countletters(File(:argv[1]).read())
   print(letter‘=’count)


bdos:		equ	5	; CP/M syscalls
putch:		equ	2	; Print a character
puts:		equ	9	; Print a string
fopen:		equ	15	; Open a file
fread:		equ	20	; Read a file
fcb:		equ	5ch	; FCB for file given on command line
dma:		equ	80h	; Default DMA
		org	100h	; CP/M loads the program starting at page 1
		;; Zero out pages two and three (to keep a 16-bit counter
		;; for each possible byte in the file).
		;; We can do this because this program is small enough to
		;; fit in page 1 in its entirety.
		xra	a	; Zero A.
		mov	b,a	; Zero B too (make it loop 256 times)
		lxi	d,200h	; Start of page two
zero:		stax	d	; Zero out a byte (store A, which is zero)
		inx	d	; Next byte
		stax	d	; Zero out another byte
		inx	d	; Next byte
		dcr	b	; Decrement the loop counter.
		jnz	zero	; Continue until B comes back to zero.
		;; Open the file given on the command line.
		lxi	d,fcb	; CP/M always tries to parse the command line,
		mvi	c,fopen	; and gives us a file "object" in page zero.
		call	bdos	; We can just call fopen on it.
		inr	a	; It sets A=FF on error, so if incrementing A
		jz	error	; rolls back over to 0, that's an error.
		;; Process the file record by record.
		;; In CP/M, each file consists of a number of 128-byte
		;; records. An exact size is not kept.
		;; If a text file is not an exact multiple of 128 bytes
		;; long, the last record will contain a ^Z (26 decimal),
		;; and anything after that byte should be ignored.
read:		lxi	d,fcb	; From the file control block (the "object"),
		mvi	c,fread	; read one record. By default it ends up in
		call	bdos	; the last half of page zero.
		ana	a	; Zero carry flag.
		rar		; Low bit says if end reached
		jc	output	; If so, go print the table
		ana	a	; If any other bits are set, that's a
		jnz	error	; read error.
		;; Count the characters in the current record.
		lxi	d,dma-1	; Set DE to point just before the record
byte:		inr	e	; Go to the next byte.
		jz	read	; If end of record, go get next record.
		ldax	d	; Grab the current byte
		cpi	26	; If it is EOF, we're done.
		jz	output	; Go print the table
		mov	l,a	; Otherwise, increment the counter for this
		mvi	h,2	; character: the low byte is kept in page 2.
		inr	m	; 'm' means the value in memory at HL.
		jnz	byte	; If no rollover, we're done; count next byte
		inr	h	; But we're keeping a 16-bit counter, so
		inr	m	; if there is rollover, increment high byte.
		jmp	byte	; The high byte is in page 3 -unorthodox, but
				; it's easy to access here.
		;; We've done the whole file. For each printable
		;; ASCII character (32..126), print the character and
		;; the count.
output:		mvi	a,32	; Start at 32.
		;; Print a character and its counter
char:		mov	l,a	; Load 16-bit counter into DE. Low byte
		mvi	h,2	; is in page 2 at a;
		mov	e,m
		inr	h	; And the high byte is in page 3.
		mov	d,m
		mov	a,d	; Test if the counter is zero
		ora	e
		mov	a,l	; Put the character back in A
		jz	next	; If zero, don't print anything.
		push	psw	; If not, push the character,
		push	d	; and the counter.
		mvi	c,putch	; Print the current character
		mov	e,a
		call	bdos
		lxi	d,separator	; Then print ': '
		call 	outs
		;; Then convert the counter to ASCII
		pop	d 	; Retrieve the counter
		lxi	h,numend	; Get pointer to end of digit string
		push	h	; And put it on the stack
dgtloop:	xchg		; Put counter in HL (16-bit accumulator)
		lxi	b,-10	; Dividend is 10
		mov	d,b	; Start quotient at -1 (we'll loop once
		mov	e,b	; too many, this corrects for it)
divloop:	inx	d	; Increment the quotient,
		dad	b	; subtract 10 from the dividend,
		jc	divloop	; and keep doing it until it goes negative
		lxi	b,10+'0'	; Add 10 back to get the remainder,
		dad	b		; plus '0' to make it ASCII.
		mov	a,l
		pop	h	; Retrieve digit pointer
		dcx	h	; Decrement it (to point at current digit)
		mov	m,a	; Store the digit
		push	h	; And store the new pointer
		mov	a,d	; Check if the quotient is now zero
		ora	e
		jnz	dgtloop	; If not, do the next digit.
		pop	d	; Set DE to point at the first digit
		call	outs	; And output it as a string.
		pop	psw	; Restore the character
next:		inr	a	; Increment it
		cpi	127	; Did we just do the last character?
		jnz	char	; If not, go do the next character.
		ret		; If so, we're done.
		;; Print the error message
error:		lxi	d,errmsg
		;; Print string
outs:		mvi	c,puts
		jmp	bdos
		;; Strings
errmsg:		db	'?$'	; "Error message" (if file error)
separator:	db	': $'	; Goes in between character and number
number:		db	'00000'	; Space to keep ASCII representation of
numend:		db	13,10,'$'	; a 16-bit number, plus newline.


needs map/iter

8 var, numtasks
var tasks

0 args "Give filename as param" thrownull
f:slurp >s s:len numtasks @ n:/ n:ceil 1 a:close s:/ a:len numtasks ! constant work

m:new constant result

: print-character-count  \ m s -- m
  swap over m:@  rot   s:size 1 n:= over   -1 s:@ nip 31 n:<  and if
    -1 s:@ nip "<%d>" s:strfmt
  else
      "'%s'" s:strfmt
   then
   "%s: %d\n" s:strfmt . ;

: print-results
  tasks @ a:len ( a:pop t:result nip ( result -rot m:[]! drop ) m:each drop ) swap times drop
  result ( nip array? if ' n:+ 0 a:reduce then ) m:map
  m:keys ' s:cmp a:sort ' print-character-count m:iter drop ;

: task  \ slice --
  "" s:/ ' noop a:group
  ( nip a:len nip ) m:map ;

: start-tasks
  a:new
  ( work a:pop nip 1 ' task t:task-n a:push ) numtasks @ times
  tasks ! ;

: wait-tasks
  tasks @ t:wait ;

: app:main
  start-tasks
  wait-tasks
  print-results
  bye ;


(defun increment-alist (tbl key)
   (cond ((endp tbl) (list (cons key 1)))
         ((eql (car (first tbl)) key)
          (cons (cons key (1+ (cdr (first tbl))))
                (rest tbl)))
         (t (cons (first tbl)
                  (increment-alist (rest tbl) key)))))

(defun freq-table (xs)
   (if (endp xs)
       nil
       (increment-alist (freq-table (rest xs))
                        (first xs))))

(defun letter-freq (str)
   (freq-table (coerce str 'list)))


INCLUDE "D2:PRINTF.ACT" ;from the Action! Tool Kit

CARD ARRAY histogram(256)

PROC Clear()
  INT i

  FOR i=0 TO 255
  DO histogram(i)=0 OD
RETURN

PROC ProcessLine(CHAR ARRAY line)
  INT i

  FOR i=1 TO line(0)
  DO
    histogram(line(i))==+1
  OD
RETURN

PROC ProcessFile(CHAR ARRAY fname)
  CHAR ARRAY line(255)
  BYTE dev=[1]

  Close(dev)
  Open(dev,fname,4)
  WHILE Eof(dev)=0
  DO
    InputSD(dev,line)
    ProcessLine(line)
  OD
  Close(dev)
RETURN

PROC PrintResult()
  INT i
  CHAR ARRAY s(10)

  FOR i=0 TO 255
  DO
    IF histogram(i) THEN
      StrC(histogram(i),s)
      PrintF(" %C:%-5S",i,s)
    FI
  OD
RETURN

PROC Main()
  CHAR ARRAY fname="H6:LETTE_KJ.ACT"
  BYTE LMARGIN=$52,old

  old=LMARGIN
  LMARGIN=0 ;remove left margin on the screen

  Put(125) PutE() ;clear the screen
  PrintF("Reading ""%S""...%E%E",fname)
  ProcessFile(fname)
  PrintResult()

  LMARGIN=old ;restore left margin on the screen
RETURN