use std::iter;

// Calculating a continued fraction is quite easy with iterators, however
// writing a proper iterator adapter is less so. We settle for a macro which
// for most purposes works well enough.
//
// One limitation with this iterator based approach is that we cannot reverse
// input iterators since they are not usually DoubleEnded. To circumvent this
// we can collect the elements and then reverse them, however this isn't ideal
// as we now have to store elements equal to the number of iterations.
//
// Another is that iterators cannot be resused once consumed, so it is often
// required to make many clones of iterators.
macro_rules! continued_fraction {
    ($a:expr, $b:expr ; $iterations:expr) => (
        ($a).zip($b)
            .take($iterations)
            .collect::<Vec<_>>().iter()
            .rev()
            .fold(0 as f64, |acc: f64, &(x, y)| {
                x as f64 + (y as f64 / acc)
            })
    );

    ($a:expr, $b:expr) => (continued_fraction!($a, $b ; 1000));
}

fn main() {
    // Sqrt(2)
    let sqrt2a = (1..2).chain(iter::repeat(2));
    let sqrt2b = iter::repeat(1);
    println!("{}", continued_fraction!(sqrt2a, sqrt2b));

    // Napier's Constant
    let napiera = (2..3).chain(1..);
    let napierb = (1..2).chain(1..);
    println!("{}", continued_fraction!(napiera, napierb));

    // Pi
    let pia = (3..4).chain(iter::repeat(6));
    let pib = (1i64..).map(|x| (2 * x - 1).pow(2));
    println!("{}", continued_fraction!(pia, pib));
}


object CF extends App {
  import Stream._
  val sqrt2 = 1 #:: from(2,0) zip from(1,0)
  val napier = 2 #:: from(1) zip (1 #:: from(1))
  val pi = 3 #:: from(6,0) zip (from(1,2) map {x=>x*x})

  // reference values, source: wikipedia
  val refPi     = "3.14159265358979323846264338327950288419716939937510"
  val refNapier = "2.71828182845904523536028747135266249775724709369995"
  val refSQRT2  = "1.41421356237309504880168872420969807856967187537694"

  def calc(cf: Stream[(Int, Int)], numberOfIters: Int=200): BigDecimal = {
    (cf take numberOfIters toList).foldRight[BigDecimal](1)((a, z) => a._1+a._2/z)
  }

  def approx(cfV: BigDecimal, cfRefV: String): String = {
    val p: Pair[Char,Char] => Boolean = pair =>(pair._1==pair._2)
    ((cfV.toString+" "*34).substring(0,34) zip cfRefV.toString.substring(0,34))
      .takeWhile(p).foldRight[String]("")((a:Pair[Char,Char],z)=>a._1+z)
  }

  List(("sqrt2",sqrt2,50,refSQRT2),("napier",napier,50,refNapier),("pi",pi,3000,refPi)) foreach {t=>
    val (name,cf,iters,refV) = t
    val cfV = calc(cf,iters)
    println(name+":")
    println("ref value: "+refV.substring(0,34))
    println("cf value:  "+(cfV.toString+" "*34).substring(0,34))
    println("precision: "+approx(cfV,refV))
    println()
  }
}


#!r6rs
(import (rnrs base (6))
        (srfi :41 streams))

(define nats (stream-cons 0 (stream-map (lambda (x) (+ x 1)) nats)))

(define (build-stream fn) (stream-map fn nats))

(define (stream-cycle s . S)
  (cond
    ((stream-null? (car S)) stream-null)
    (else (stream-cons (stream-car s)
                       (apply stream-cycle (append S (list (stream-cdr s))))))))

(define (cf-floor cf) (stream-car cf))
(define (cf-num cf) (stream-car (stream-cdr cf)))
(define (cf-denom cf) (stream-cdr (stream-cdr cf)))

(define (cf-integer? x) (stream-null? (stream-cdr x)))

(define (cf->real x)
  (let refine ((x x) (n 65536))
    (cond
      ((= n 0) +inf.0)
      ((cf-integer? x) (cf-floor x))
      (else (+ (cf-floor x)
               (/ (cf-num x)
                  (refine (cf-denom x) (- n 1))))))))

(define (real->cf x)
  (let-values (((integer-part fractional-part) (div-and-mod x 1)))
    (if (= fractional-part 0.0)
        (stream (exact integer-part))
        (stream-cons
         (exact integer-part)
         (stream-cons
          1
          (real->cf (/ fractional-part)))))))

(define sqrt2 (stream-cons 1 (stream-constant 1 2)))

(define napier
  (stream-append (stream 2 1)
                 (stream-cycle (stream-cdr nats) (stream-cdr nats))))

(define pi
  (stream-cons 3
               (stream-cycle (build-stream (lambda (n) (expt (- (* 2 (+ n 1)) 1) 2)))
                             (stream-constant 6))))


extension BinaryInteger {
  @inlinable
  public func power(_ n: Self) -> Self {
    return stride(from: 0, to: n, by: 1).lazy.map({_ in self }).reduce(1, *)
  }
}

public struct CycledSequence<WrappedSequence: Sequence> {
  private var seq: WrappedSequence
  private var iter: WrappedSequence.Iterator

  init(seq: WrappedSequence) {
    self.seq = seq
    self.iter = seq.makeIterator()
  }
}

extension CycledSequence: Sequence, IteratorProtocol {
  public mutating func next() -> WrappedSequence.Element? {
    if let ele = iter.next() {
      return ele
    } else {
      iter = seq.makeIterator()

      return iter.next()
    }
  }
}

extension Sequence {
  public func cycled() -> CycledSequence<Self> {
    return CycledSequence(seq: self)
  }
}

public struct ChainedSequence<Element> {
  private var sequences: [AnySequence<Element>]
  private var iter: AnyIterator<Element>
  private var curSeq = 0

  init(chain: ChainedSequence) {
    self.sequences = chain.sequences
    self.iter = chain.iter
    self.curSeq = chain.curSeq
  }

  init<Seq: Sequence>(_ seq: Seq) where Seq.Element == Element {
    sequences = [AnySequence(seq)]
    iter = sequences[curSeq].makeIterator()
  }

  func chained<Seq: Sequence>(with seq: Seq) -> ChainedSequence where Seq.Element == Element {
    var res = ChainedSequence(chain: self)

    res.sequences.append(AnySequence(seq))

    return res
  }
}

extension ChainedSequence: Sequence, IteratorProtocol {
  public mutating func next() -> Element? {
    if let el = iter.next() {
      return el
    }

    curSeq += 1

    guard curSeq != sequences.endIndex else {
      return nil
    }

    iter = sequences[curSeq].makeIterator()

    return iter.next()
  }
}

extension Sequence {
  public func chained<Seq: Sequence>(with other: Seq) -> ChainedSequence<Element> where Seq.Element == Element {
    return ChainedSequence(self).chained(with: other)
  }
}

func continuedFraction<T: Sequence, V: Sequence>(
  _ seq1: T,
  _ seq2: V,
  iterations: Int = 1000
) -> Double where T.Element: BinaryInteger, T.Element == V.Element {
  return zip(seq1, seq2).prefix(iterations).reversed().reduce(0.0, { Double($1.0) + (Double($1.1) / $0) })
}

let sqrtA = [1].chained(with: [2].cycled())
let sqrtB = [1].cycled()

print("√2 ≈ \(continuedFraction(sqrtA, sqrtB))")

let napierA = [2].chained(with: 1...)
let napierB = [1].chained(with: 1...)

print("e ≈ \(continuedFraction(napierA, napierB))")

let piA = [3].chained(with: [6].cycled())
let piB = (1...).lazy.map({ (2 * $0 - 1).power(2) })

print("π ≈ \(continuedFraction(piA, piB))")


package require Tcl 8.6

# Term generators; yield list of pairs
proc r2 {} {
    yield {1 1}
    while 1 {yield {2 1}}
}
proc e {} {
    yield {2 1}
    while 1 {yield [list [incr n] $n]}
}
proc pi {} {
    set n 0; set a 3
    while 1 {
	yield [list $a [expr {(2*[incr n]-1)**2}]]
	set a 6
    }
}

# Continued fraction calculator
proc cf {generator {termCount 50}} {
    # Get the chunk of terms we want to work with
    set terms [list [coroutine cf.c $generator]]
    while {[llength $terms] < $termCount} {
	lappend terms [cf.c]
    }
    rename cf.c {}

    # Merge the terms to compute the result
    set val 0.0
    foreach pair [lreverse $terms] {
	lassign $pair a b
	set val [expr {$a + $b/$val}]
    }
    return $val
}

# Demonstration
puts [cf r2]
puts [cf e]
puts [cf pi 250]; # Converges more slowly


Public Const precision = 10000
Private Function continued_fraction(steps As Integer, rid_a As String, rid_b As String) As Double
    Dim res As Double
    res = 0
    For n = steps To 1 Step -1
       res = Application.Run(rid_b, n) / (Application.Run(rid_a, n) + res)
    Next n
    continued_fraction = Application.Run(rid_a, 0) + res
End Function

Function sqr2_a(n As Integer) As Integer
    sqr2_a = IIf(n = 0, 1, 2)
End Function

Function sqr2_b(n As Integer) As Integer
    sqr2_b = 1
End Function

Function nap_a(n As Integer) As Integer
    nap_a = IIf(n = 0, 2, n)
End Function

Function nap_b(n As Integer) As Integer
    nap_b = IIf(n = 1, 1, n - 1)
End Function

Function pi_a(n As Integer) As Integer
    pi_a = IIf(n = 0, 3, 6)
End Function

Function pi_b(n As Integer) As Long
    pi_b = IIf(n = 1, 1, (2 * n - 1) ^ 2)
End Function

Public Sub main()
    Debug.Print "Precision:", precision
    Debug.Print "Sqr(2):", continued_fraction(precision, "sqr2_a", "sqr2_b")
    Debug.Print "Napier:", continued_fraction(precision, "nap_a", "nap_b")
    Debug.Print "Pi:", continued_fraction(precision, "pi_a", "pi_b")
End Sub


Module Module1
    Function Calc(f As Func(Of Integer, Integer()), n As Integer) As Double
        Dim temp = 0.0
        For ni = n To 1 Step -1
            Dim p = f(ni)
            temp = p(1) / (p(0) + temp)
        Next
        Return f(0)(0) + temp
    End Function

    Sub Main()
        Dim fList = {
            Function(n As Integer) New Integer() {If(n > 0, 2, 1), 1},
            Function(n As Integer) New Integer() {If(n > 0, n, 2), If(n > 1, n - 1, 1)},
            Function(n As Integer) New Integer() {If(n > 0, 6, 3), Math.Pow(2 * n - 1, 2)}
            }

        For Each f In fList
            Console.WriteLine(Calc(f, 200))
        Next
    End Sub

End Module


with Ada.Text_IO, Ada.Numerics.Float_Random;

procedure Concurrent_Hello is
   type Messages is (Enjoy, Rosetta, Code);
   task type Writer (Message : Messages);
   task body Writer is
      Seed : Ada.Numerics.Float_Random.Generator;
   begin
      Ada.Numerics.Float_Random.Reset (Seed); -- time-dependent, see ARM A.5.2
      delay Duration (Ada.Numerics.Float_Random.Random (Seed));
      Ada.Text_IO.Put_Line (Messages'Image(Message));
   end Writer;
   Taks: array(Messages) of access Writer -- 3 Writer tasks will immediately run
     := (new Writer(Enjoy), new Writer(Rosetta), new Writer(Code));
begin
   null; -- the "environment task" doesn't need to do anything
end Concurrent_Hello;


main:(
  PROC echo = (STRING string)VOID:
      printf(($gl$,string));
  PAR(
    echo("Enjoy"),
    echo("Rosetta"),
    echo("Code")
  )
)


let words = ["Enjoy", "Rosetta", "Code"]

for word in words:
    (word) |> async (w) =>
        sleep(random())
        print(w)


' Concurrent computing using the OpenMP extension in GCC. Requires BaCon 3.6 or higher.

' Specify compiler flag
PRAGMA OPTIONS -fopenmp

' Sepcify linker flag
PRAGMA LDFLAGS -lgomp

' Declare array with text
DECLARE str$[] = { "Enjoy", "Rosetta", "Code" }

' Indicate MP optimization for FOR loop
PRAGMA omp parallel for num_threads(3)

' The actual FOR loop
FOR i = 0 TO 2
    PRINT str$[i]
NEXT


      INSTALL @lib$+"TIMERLIB"

      tID1% = FN_ontimer(100, PROCtask1, 1)
      tID2% = FN_ontimer(100, PROCtask2, 1)
      tID3% = FN_ontimer(100, PROCtask3, 1)

      ON ERROR PRINT REPORT$ : PROCcleanup : END
      ON CLOSE PROCcleanup : QUIT

      REPEAT
        WAIT 0
      UNTIL FALSE
      END

      DEF PROCtask1
      PRINT "Enjoy"
      ENDPROC

      DEF PROCtask2
      PRINT "Rosetta"
      ENDPROC

      DEF PROCtask3
      PRINT "Code"
      ENDPROC

      DEF PROCcleanup
      PROC_killtimer(tID1%)
      PROC_killtimer(tID2%)
      PROC_killtimer(tID3%)
      ENDPROC


#include <stdio.h>
#include <unistd.h>
#include <pthread.h>

pthread_mutex_t condm = PTHREAD_MUTEX_INITIALIZER;
pthread_cond_t cond = PTHREAD_COND_INITIALIZER;
int bang = 0;

#define WAITBANG() do { \
   pthread_mutex_lock(&condm); \
   while( bang == 0 ) \
   { \
      pthread_cond_wait(&cond, &condm); \
   } \
   pthread_mutex_unlock(&condm); } while(0);\

void *t_enjoy(void *p)
{
  WAITBANG();
  printf("Enjoy\n");
  pthread_exit(0);
}

void *t_rosetta(void *p)
{
  WAITBANG();
  printf("Rosetta\n");
  pthread_exit(0);
}

void *t_code(void *p)
{
  WAITBANG();
  printf("Code\n");
  pthread_exit(0);
}

typedef void *(*threadfunc)(void *);
int main()
{
   int i;
   pthread_t a[3];
   threadfunc p[3] = {t_enjoy, t_rosetta, t_code};

   for(i=0;i<3;i++)
   {
     pthread_create(&a[i], NULL, p[i], NULL);
   }
   sleep(1);
   bang = 1;
   pthread_cond_broadcast(&cond);
   for(i=0;i<3;i++)
   {
     pthread_join(a[i], NULL);
   }
}


static Random tRand = new Random();

static void Main(string[] args)
{
	Thread t = new Thread(new ParameterizedThreadStart(WriteText));
	t.Start("Enjoy");

	t = new Thread(new ParameterizedThreadStart(WriteText));
	t.Start("Rosetta");

	t = new Thread(new ParameterizedThreadStart(WriteText));
	t.Start("Code");

	Console.ReadLine();
}

private static void WriteText(object p)
{
	Thread.Sleep(tRand.Next(1000, 4000));
	Console.WriteLine(p);
}


#include <thread>
#include <iostream>
#include <vector>
#include <random>
#include <chrono>

int main()
{
  std::random_device rd;
  std::mt19937 eng(rd()); // mt19937 generator with a hardware random seed.
  std::uniform_int_distribution<> dist(1,1000);
  std::vector<std::thread> threads;

  for(const auto& str: {"Enjoy\n", "Rosetta\n", "Code\n"}) {
    // between 1 and 1000ms per our distribution
    std::chrono::milliseconds duration(dist(eng));

    threads.emplace_back([str, duration](){
      std::this_thread::sleep_for(duration);
      std::cout << str;
    });
  }

  for(auto& t: threads) t.join();

  return 0;
}


BEGIN # find composite k with no single digit factors whose factors are all substrings of k #
    # returns TRUE if the string representation of f is a substring of k str, FALSE otherwise #
    PROC is substring = ( STRING k str, INT f )BOOL:
         BEGIN
            STRING f str   = whole( f, 0 );
            INT    f len   = ( UPB f str - LWB f str ) + 1;
            BOOL   result := FALSE;
            INT f end    := ( LWB k str + f len ) - 2;
            FOR f pos FROM LWB k str TO ( UPB k str + 1 ) - f len WHILE NOT result DO
                f end +:= 1;
                result := k str[ f pos : f end ] = f str
            OD;
            result
         END # is substring # ;
    # task #
    INT required numbers = 20;
    INT k count         := 0;
    # k must be odd and > 9 #
    FOR k FROM 11 BY 2 WHILE k count < required numbers DO
        IF k MOD 3 /= 0 AND k MOD 5 /= 0 AND k MOD 7 /= 0 THEN
            # no single digit odd prime factors #
            BOOL   is candidate := TRUE;
            STRING k str         = whole( k, 0 );
            INT    v            := k;
            INT    f count      := 0;
            FOR f FROM 11 BY 2 TO ENTIER sqrt( k ) + 1 WHILE v > 1 AND is candidate DO
                IF v MOD f = 0 THEN
                    # have a factor #
                    is candidate := is substring( k str, f );
                    IF is candidate THEN
                        # the digits of f ae a substring of v #
                        WHILE v OVERAB f;
                              f count +:= 1;
                              v MOD f = 0
                        DO SKIP OD
                    FI
                FI
            OD;
            IF is candidate AND ( f count > 1 OR ( v /= k AND v > 1 ) ) THEN
                # have a composite whose factors are up to the root are substrings #
                IF v > 1 THEN
                    # there was a factor > the root #
                    is candidate := is substring( k str, v )
                FI;
                IF is candidate THEN
                    print( ( " ", whole( k, -8 ) ) );
                    k count +:= 1;
                    IF k count MOD 10 = 0 THEN print( ( newline ) ) FI
                FI
            FI
        FI
    OD
END


execute() {
    {# host.println("Enjoy");
     # host.println("Rosetta");
     # host.println("Code"); }
}


(doseq [text ["Enjoy" "Rosetta" "Code"]]
  (future (println text)))


{ exec } = require 'child_process'

for word in [ 'Enjoy', 'Rosetta', 'Code' ]
    exec "echo #{word}", (err, stdout) ->
        console.log stdout


(defun concurrency-example (&optional (out *standard-output*))
  (let ((lock (bordeaux-threads:make-lock)))
    (flet ((writer (string)
             #'(lambda ()
                 (bordeaux-threads:acquire-lock lock t)
                 (write-line string out)
                 (bordeaux-threads:release-lock lock))))
      (bordeaux-threads:make-thread (writer "Enjoy"))
      (bordeaux-threads:make-thread (writer "Rosetta"))
      (bordeaux-threads:make-thread (writer "Code")))))


valid?: function [n][
    pf: factors.prime n
    every? pf 'f ->
        and? [contains? to :string n to :string f]
             [1 <> size digits f]
]

cnt: 0
i: new 3

while [cnt < 10][
    if and? [not? prime? i][valid? i][
        print i
        cnt: cnt + 1
    ]
    'i + 2
]


// Composite numbers k with no single digit factors whose factors are all substrings of k.  Nigel Galloway: January 28th., 2022
let fG n g=let rec fN i g e l=match i<g,g=0L,i%10L=g%10L with (true,_,_)->false |(_,true,_)->true |(_,_,true)->fN(i/10L)(g/10L) e l |_->fN l e e (l/10L) in fN n g g (n/10L)
let fN(g:int64)=Open.Numeric.Primes.Prime.Factors g|>Seq.skip 1|>Seq.distinct|>Seq.forall(fun n->fG g n)
Seq.unfold(fun n->Some(n|>List.filter(fun(n:int64)->not(Open.Numeric.Primes.Prime.Numbers.IsPrime &n) && fN n),n|>List.map((+)210L)))([1L..2L..209L]
|>List.filter(fun n->n%3L>0L && n%5L>0L && n%7L>0L))|>Seq.concat|>Seq.skip 1|>Seq.take 20|>Seq.iter(printfn "%d")


package main

import (
    "fmt"
    "rcu"
    "strconv"
    "strings"
)

func main() {
    count := 0
    k := 11 * 11
    var res []int
    for count < 20 {
        if k%3 == 0 || k%5 == 0 || k%7 == 0 {
            k += 2
            continue
        }
        factors := rcu.PrimeFactors(k)
        if len(factors) > 1 {
            s := strconv.Itoa(k)
            includesAll := true
            prev := -1
            for _, f := range factors {
                if f == prev {
                    continue
                }
                fs := strconv.Itoa(f)
                if strings.Index(s, fs) == -1 {
                    includesAll = false
                    break
                }
            }
            if includesAll {
                res = append(res, k)
                count++
            }
        }
        k += 2
    }
    for _, e := range res[0:10] {
        fmt.Printf("%10s ", rcu.Commatize(e))
    }
    fmt.Println()
    for _, e := range res[10:20] {
        fmt.Printf("%10s ", rcu.Commatize(e))
    }
    fmt.Println()
}


require "channel"
require "fiber"
require "random"

done = Channel(Nil).new

"Enjoy Rosetta Code".split.map do |x|
  spawn do
    sleep Random.new.rand(0..500).milliseconds
    puts x
    done.send nil
  end
end

3.times do
  done.receive
end


import std.stdio, std.random, std.parallelism, core.thread, core.time;

void main() {
    foreach (s; ["Enjoy", "Rosetta", "Code"].parallel(1)) {
        Thread.sleep(uniform(0, 1000).dur!"msecs");
        s.writeln;
    }
}


import 'dart:math' show Random;

main(){
	enjoy()   .then( (e) => print(e) );
	rosetta() .then( (r) => print(r) );
	code()    .then( (c) => print(c) );
}

// Create random number generator
var rng = Random();

// Each function returns a future that starts after a delay
// Like using setTimeout with a Promise in Javascript
enjoy()   => Future.delayed( Duration( milliseconds: rng.nextInt( 10 ) ), () => "Enjoy");
rosetta() => Future.delayed( Duration( milliseconds: rng.nextInt( 10 ) ), () => "Rosetta");
code()    => Future.delayed( Duration( milliseconds: rng.nextInt( 10 ) ), () => "Code");


using Lazy
using Primes

function containsitsonlytwodigfactors(n)
    s = string(n)
    return !isprime(n) && all(t -> length(t) > 1 && contains(s, t), map(string, collect(keys(factor(n)))))
end

seq = @>> Lazy.range(2) filter(containsitsonlytwodigfactors)

foreach(p -> print(lpad(last(p), 9), first(p) == 10 ? "\n" : ""), enumerate(take(20, seq)))


ClearAll[CompositeAndContainsPrimeFactor]
CompositeAndContainsPrimeFactor[k_Integer] := Module[{id, pf},
  If[CompositeQ[k],
   pf = FactorInteger[k][[All, 1]];
   If[AllTrue[pf, GreaterThan[10]],
    id = IntegerDigits[k];
    AllTrue[pf, SequenceCount[id, IntegerDigits[#]] > 0 &]
    ,
    False
    ]
   ,
   False
   ]
  ]
out = Select[Range[30000000], CompositeAndContainsPrimeFactor]


program FacOfInt;
// gets factors of consecutive integers fast
// limited to 1.2e11
{$IFDEF FPC}
  {$MODE DELPHI}  {$OPTIMIZATION ON,ALL}  {$COPERATORS ON}
{$ELSE}
  {$APPTYPE CONSOLE}
{$ENDIF}
uses
  sysutils,
  strutils //Numb2USA
{$IFDEF WINDOWS},Windows{$ENDIF}
  ;
//######################################################################
//prime decomposition
const
//HCN(86) > 1.2E11 = 128,501,493,120     count of divs = 4096   7 3 1 1 1 1 1 1 1
  HCN_DivCnt  = 4096;
type
  tItem     = Uint64;
  tDivisors = array [0..HCN_DivCnt] of tItem;
  tpDivisor = pUint64;
const
  //used odd size for test only
  SizePrDeFe = 32768;//*72 <= 64kb level I or 2 Mb ~ level 2 cache
type
  tdigits = array [0..31] of Uint32;
  //the first number with 11 different prime factors =
  //2*3*5*7*11*13*17*19*23*29*31 = 2E11
  //56 byte
  tprimeFac = packed record
                 pfSumOfDivs,
                 pfRemain  : Uint64;
                 pfDivCnt  : Uint32;
                 pfMaxIdx  : Uint32;
                 pfpotPrimIdx : array[0..9] of word;
                 pfpotMax  : array[0..11] of byte;
               end;
  tpPrimeFac = ^tprimeFac;

  tPrimeDecompField = array[0..SizePrDeFe-1] of tprimeFac;
  tPrimes = array[0..65535] of Uint32;

var
  {$ALIGN 8}
  SmallPrimes: tPrimes;
  {$ALIGN 32}
  PrimeDecompField :tPrimeDecompField;
  pdfIDX,pdfOfs: NativeInt;

procedure InitSmallPrimes;
//get primes. #0..65535.Sieving only odd numbers
const
  MAXLIMIT = (821641-1) shr 1;
var
  pr : array[0..MAXLIMIT] of byte;
  p,j,d,flipflop :NativeUInt;
Begin
  SmallPrimes[0] := 2;
  fillchar(pr[0],SizeOf(pr),#0);
  p := 0;
  repeat
    repeat
      p +=1
    until pr[p]= 0;
    j := (p+1)*p*2;
    if j>MAXLIMIT then
      BREAK;
    d := 2*p+1;
    repeat
      pr[j] := 1;
      j += d;
    until j>MAXLIMIT;
  until false;

  SmallPrimes[1] := 3;
  SmallPrimes[2] := 5;
  j := 3;
  d := 7;
  flipflop := (2+1)-1;//7+2*2,11+2*1,13,17,19,23
  p := 3;
  repeat
    if pr[p] = 0 then
    begin
      SmallPrimes[j] := d;
      inc(j);
    end;
    d += 2*flipflop;
    p+=flipflop;
    flipflop := 3-flipflop;
  until (p > MAXLIMIT) OR (j>High(SmallPrimes));
end;

function OutPots(pD:tpPrimeFac;n:NativeInt):Ansistring;
var
  s: String[31];
  chk,p,i: NativeInt;
Begin
  str(n,s);
  result := Format('%15s : ',[Numb2USA(s)]);

  with pd^ do
  begin
    chk := 1;
    For n := 0 to pfMaxIdx-1 do
    Begin
      if n>0 then
        result += '*';
      p := SmallPrimes[pfpotPrimIdx[n]];
      chk *= p;
      str(p,s);
      result += s;
      i := pfpotMax[n];
      if i >1 then
      Begin
        str(pfpotMax[n],s);
        result += '^'+s;
        repeat
          chk *= p;
          dec(i);
        until i <= 1;
      end;

    end;
    p := pfRemain;
    If p >1 then
    Begin
      str(p,s);
      chk *= p;
      result += '*'+s;
    end;
  end;
end;

function CnvtoBASE(var dgt:tDigits;n:Uint64;base:NativeUint):NativeInt;
//n must be multiple of base aka n mod base must be 0
var
  q,r: Uint64;
  i : NativeInt;
Begin
  fillchar(dgt,SizeOf(dgt),#0);
  i := 0;
  n := n div base;
  result := 0;
  repeat
    r := n;
    q := n div base;
    r  -= q*base;
    n := q;
    dgt[i] := r;
    inc(i);
  until (q = 0);
  //searching lowest pot in base
  result := 0;
  while (result<i) AND (dgt[result] = 0) do
    inc(result);
  inc(result);
end;

function IncByBaseInBase(var dgt:tDigits;base:NativeInt):NativeInt;
var
  q :NativeInt;
Begin
  result := 0;
  q := dgt[result]+1;
  if q = base then
    repeat
      dgt[result] := 0;
      inc(result);
      q := dgt[result]+1;
    until q <> base;
  dgt[result] := q;
  result +=1;
end;

function SieveOneSieve(var pdf:tPrimeDecompField):boolean;
var
  dgt:tDigits;
  i,j,k,pr,fac,n,MaxP : Uint64;
begin
  n := pdfOfs;
  if n+SizePrDeFe >= sqr(SmallPrimes[High(SmallPrimes)]) then
    EXIT(FALSE);
  //init
  for i := 0 to SizePrDeFe-1 do
  begin
    with pdf[i] do
    Begin
      pfDivCnt := 1;
      pfSumOfDivs := 1;
      pfRemain := n+i;
      pfMaxIdx := 0;
      pfpotPrimIdx[0] := 0;
      pfpotMax[0] := 0;
    end;
  end;
  //first factor 2. Make n+i even
  i := (pdfIdx+n) AND 1;
  IF (n = 0) AND (pdfIdx<2)  then
    i := 2;

  repeat
    with pdf[i] do
    begin
      j := BsfQWord(n+i);
      pfMaxIdx := 1;
      pfpotPrimIdx[0] := 0;
      pfpotMax[0] := j;
      pfRemain := (n+i) shr j;
      pfSumOfDivs := (Uint64(1) shl (j+1))-1;
      pfDivCnt := j+1;
    end;
    i += 2;
  until i >=SizePrDeFe;
  //i now index in SmallPrimes
  i := 0;
  maxP := trunc(sqrt(n+SizePrDeFe))+1;
  repeat
    //search next prime that is in bounds of sieve
    if n = 0 then
    begin
      repeat
        inc(i);
        pr := SmallPrimes[i];
        k := pr-n MOD pr;
        if k < SizePrDeFe then
          break;
      until pr > MaxP;
    end
    else
    begin
      repeat
        inc(i);
        pr := SmallPrimes[i];
        k := pr-n MOD pr;
        if (k = pr) AND (n>0) then
          k:= 0;
        if k < SizePrDeFe then
          break;
      until pr > MaxP;
    end;

    //no need to use higher primes
    if pr*pr > n+SizePrDeFe then
      BREAK;

    //j is power of prime
    j := CnvtoBASE(dgt,n+k,pr);
    repeat
      with pdf[k] do
      Begin
        pfpotPrimIdx[pfMaxIdx] := i;
        pfpotMax[pfMaxIdx] := j;
        pfDivCnt *= j+1;
        fac := pr;
        repeat
          pfRemain := pfRemain DIV pr;
          dec(j);
          fac *= pr;
        until j<= 0;
        pfSumOfDivs *= (fac-1)DIV(pr-1);
        inc(pfMaxIdx);
        k += pr;
        j := IncByBaseInBase(dgt,pr);
      end;
    until k >= SizePrDeFe;
  until false;

  //correct sum of & count of divisors
  for i := 0 to High(pdf) do
  Begin
    with pdf[i] do
    begin
      j := pfRemain;
      if j <> 1 then
      begin
        pfSumOFDivs *= (j+1);
        pfDivCnt *=2;
      end;
    end;
  end;
  result := true;
end;

function NextSieve:boolean;
begin
  dec(pdfIDX,SizePrDeFe);
  inc(pdfOfs,SizePrDeFe);
  result := SieveOneSieve(PrimeDecompField);
end;

function GetNextPrimeDecomp:tpPrimeFac;
begin
  if pdfIDX >= SizePrDeFe then
    if Not(NextSieve) then
      EXIT(NIL);
  result := @PrimeDecompField[pdfIDX];
  inc(pdfIDX);
end;

function Init_Sieve(n:NativeUint):boolean;
//Init Sieve pdfIdx,pdfOfs are Global
begin
  pdfIdx := n MOD SizePrDeFe;
  pdfOfs := n-pdfIdx;
  result := SieveOneSieve(PrimeDecompField);
end;

var
  s,pr : string[31];
  pPrimeDecomp :tpPrimeFac;

  T0:Int64;
  n,i,cnt : NativeUInt;
  checked : boolean;
Begin
  InitSmallPrimes;

  T0 := GetTickCount64;
  cnt := 0;
  n := 0;
  Init_Sieve(n);
  repeat
    pPrimeDecomp:= GetNextPrimeDecomp;
    with pPrimeDecomp^ do
    begin
      //composite with smallest factor 11
      if (pfDivCnt>=4) AND (pfpotPrimIdx[0]>3) then
      begin
        str(n,s);
        for i := 0 to pfMaxIdx-1 do
        begin
          str(smallprimes[pfpotPrimIdx[i]],pr);
          checked := (pos(pr,s)>0);
          if Not(checked) then
            Break;
        end;
        if checked then
        begin
          //writeln(cnt:4,OutPots(pPrimeDecomp,n));
          if pfRemain >1 then
          begin
            str(pfRemain,pr);
            checked := (pos(pr,s)>0);
          end;
          if checked then
          begin
            inc(cnt);
            writeln(cnt:4,OutPots(pPrimeDecomp,n));
          end;
        end;
      end;
    end;
    inc(n);
  until n > 28118827;//10*1000*1000*1000+1;//
  T0 := GetTickCount64-T0;
  writeln('runtime ',T0/1000:0:3,' s');
end.


program ConcurrentComputing;

{$APPTYPE CONSOLE}

uses SysUtils, Classes, Windows;

type
  TRandomThread = class(TThread)
  private
    FString: string;
  protected
    procedure Execute; override;
  public
    constructor Create(const aString: string); overload;
  end;

constructor TRandomThread.Create(const aString: string);
begin
  inherited Create(False);
  FreeOnTerminate := True;
  FString := aString;
end;

procedure TRandomThread.Execute;
begin
  Sleep(Random(5) * 100);
  Writeln(FString);
end;

var
  lThreadArray: Array[0..2] of THandle;
begin
  Randomize;
  lThreadArray[0] := TRandomThread.Create('Enjoy').Handle;
  lThreadArray[1] := TRandomThread.Create('Rosetta').Handle;
  lThreadArray[2] := TRandomThread.Create('Stone').Handle;

  WaitForMultipleObjects(Length(lThreadArray), @lThreadArray, True, INFINITE);
end.


fun parprint -> text, return
(
   fork() -> return, throw
      println(text, return)
   | x
   return()
)
| parprint

parprint("Enjoy") ->
parprint("Rosetta") ->
parprint("Code") ->

exit()


 use strict;
use warnings;
use ntheory qw<is_prime factor gcd>;

my($values,$cnt);
LOOP: for (my $k = 11; $k < 1E10; $k += 2) {
    next if 1 < gcd($k,2*3*5*7) or is_prime $k;
    map { next if index($k, $_) < 0 } factor $k;
    $values .= sprintf "%10d", $k;
    last LOOP if ++$cnt == 20;
}
print $values =~ s/.{1,100}\K/\n/gr;


with javascript_semantics
integer count = 0, n = 11*11,
        limit = iff(platform()=JS?10:20)
atom t0 = time(), t1 = time()
while count<limit do
    if gcd(n,3*5*7)=1 then
        sequence f = prime_factors(n,true,-1)
        if length(f)>1 then
            string s = sprintf("%d",n)
            bool valid = true
            for i=1 to length(f) do
                if (i=1 or f[i]!=f[i-1])
                and not match(sprintf("%d",f[i]),s) then
                    valid = false
                    exit
                end if
            end for
            if valid then
                count += 1
                string t = join(apply(f,sprint),"x"),
                       e = elapsed(time()-t1)
                printf(1,"%2d: %,10d = %-17s (%s)\n",{count,n,t,e})
                t1 = time()
            end if
        end if
    end if
    n += 2
end while
printf(1,"Total time:%s\n",{elapsed(time()-t0)})


def base := timer.now()
for string in ["Enjoy", "Rosetta", "Code"] {
    timer <- whenPast(base + entropy.nextInt(1000), fn { println(string) })
}


(lib 'tasks) ;; use the tasks library

(define (tprint line ) ;; task definition
		(writeln _TASK  line)
		#f )

(for-each  task-run ;; run three // tasks
      (map (curry make-task tprint) '(Enjoy Rosetta code )))

   →
   #task:id:66:running     Rosetta
   #task:id:67:running     code
   #task:id:65:running     Enjoy


import "prelude.eg"
import "io.ego"

using System
using IO

def main =
    let _ = par (par [_ -> print "enjoy\n"]
                    [_ -> print "rosetta\n"])
                [_ -> print "code\n"] in nop


defmodule Concurrent do
  def computing(xs) do
    Enum.each(xs, fn x ->
      spawn(fn ->
        Process.sleep(:rand.uniform(1000))
        IO.puts x
      end)
    end)
    Process.sleep(1000)
  end
end

Concurrent.computing ["Enjoy", "Rosetta", "Code"]


use Prime::Factor;
use Lingua::EN::Numbers;

put (2..∞).hyper(:5000batch).map( {
    next if (1 < $_ gcd 210) || .is-prime || any .&prime-factors.map: -> $n { !.contains: $n };
    $_
} )[^20].batch(10)».&comma».fmt("%10s").join: "\n";


var e = Enumerator({|f|

    var c = (9.primorial)
    var a = (1..c -> grep { .is_coprime(c) })

    loop {
        var n = a.shift

        a.push(n + c)
        n.is_composite || next

        f(n) if n.factor.all {|p| Str(n).contains(p) }
    }
})

var count = 10

e.each {|n|
    say n
    break if (--count <= 0)
}


import "/math" for Int
import "/seq" for Lst
import "/fmt" for Fmt

var count = 0
var k = 11 * 11
var res = []
while (count < 20) {
    if (k % 3 == 0 || k % 5 == 0 || k % 7 == 0) {
        k = k + 2
        continue
    }
    var factors = Int.primeFactors(k)
    if (factors.count > 1) {
        Lst.prune(factors)
        var s = k.toString
        var includesAll = true
        for (f in factors) {
            if (s.indexOf(f.toString) == -1) {
                includesAll = false
                break
            }
        }
        if (includesAll) {
            res.add(k)
            count = count + 1
        }
    }
    k = k + 2
}
Fmt.print("$,10d", res[0..9])
Fmt.print("$,10d", res[10..19])


-module(hw).
-export([start/0]).

start() ->
   [ spawn(fun() ->  say(self(), X) end) || X <- ['Enjoy', 'Rosetta', 'Code'] ],
   wait(2),
   ok.

say(Pid,Str) ->
   io:fwrite("~s~n",[Str]),
   Pid ! done.

wait(N) ->
   receive
       done -> case N of
           0 -> 0;
           _N -> wait(N-1)
       end
   end.


procedure echo(sequence s)
    puts(1,s)
    puts(1,'\n')
end procedure

atom task1,task2,task3

task1 = task_create(routine_id("echo"),{"Enjoy"})
task_schedule(task1,1)

task2 = task_create(routine_id("echo"),{"Rosetta"})
task_schedule(task2,1)

task3 = task_create(routine_id("echo"),{"Code"})
task_schedule(task3,1)

task_yield()


include xpllib;         \for ItoA, StrFind and RlOutC
int  K, C;

proc Factor;            \Show certain K factors
int  L, N, F, Q;
char SA(10), SB(10);
[ItoA(K, SB);
L:= sqrt(K);            \limit for speed
N:= K;  F:= 3;
if (N&1) = 0 then return;               \reject if 2 is a factor
loop    [Q:= N/F;
        if rem(0) = 0 then              \found a factor, F
                [if F < 10 then return; \reject if too small (3, 5, 7)
                ItoA(F, SA);            \reject if not a sub-string
                if StrFind(SB, SA) = 0 then return;
                N:= Q;
                if F>N then quit;       \all factors found
                ]
        else    [F:= F+2;               \try next prime factor
                if F>L then
                        [if N=K then return;    \reject prime K
                        ItoA(N, SA);            \ (it's not composite)
                        if StrFind(SB, SA) = 0 then return;
                        quit;           \passed all restrictions
                        ];
                ];
        ];
Format(9, 0);
RlOutC(0, float(K));
C:= C+1;
if rem(C/10) = 0 then CrLf(0);
];

[C:= 0;                 \initialize element counter
K:= 11*11;              \must have at least two 2-digit composites
repeat  Factor;
        K:= K+2;        \must be odd because all factors > 2 are odd primes
until   C >= 20;
]


module Seq =
    let piter f xs =
        seq { for x in xs -> async { f x } }
        |> Async.Parallel
        |> Async.RunSynchronously
        |> ignore

let main() =  Seq.piter
                (System.Console.WriteLine:string->unit)
                ["Enjoy"; "Rosetta"; "Code";]

main()


USE: concurrency.combinators

{ "Enjoy" "Rosetta" "Code" } [ print ] parallel-each


require tasker.fs
require random.fs

: task ( str len -- )
  64 NewTask 2 swap pass
  ( str len -- )
  10 0 do
    100 random ms
    pause 2dup cr type
  loop 2drop ;

: main
  s" Enjoy"   task
  s" Rosetta" task
  s" Code"    task
  begin pause single-tasking? until ;
main


program concurrency
  implicit none
  character(len=*), parameter :: str1 = 'Enjoy'
  character(len=*), parameter :: str2 = 'Rosetta'
  character(len=*), parameter :: str3 = 'Code'
  integer                     :: i
  real                        :: h
  real, parameter             :: one_third = 1.0e0/3
  real, parameter             :: two_thirds = 2.0e0/3

  interface
     integer function omp_get_thread_num
     end function omp_get_thread_num
  end interface
  interface
     integer function omp_get_num_threads
     end function omp_get_num_threads
  end interface

  ! Use OpenMP to create a team of threads
  !$omp parallel do private(i,h)
  do i=1,20
     ! First time through the master thread output the number of threads
     ! in the team
     if (omp_get_thread_num() == 0 .and. i == 1) then
        write(*,'(a,i0,a)') 'Using ',omp_get_num_threads(),' threads'
     end if

     ! Randomize the order
     call random_number(h)

     !$omp critical
     if (h < one_third) then
        write(*,'(a)') str1
     else if (h < two_thirds) then
        write(*,'(a)') str2
     else
        write(*,'(a)') str3
     end if
     !$omp end critical
  end do
  !$omp end parallel do

end program concurrency


' FB 1.05.0 Win64
' Compiled with -mt switch (to use threadsafe runtiume)
' The 'ThreadCall' functionality in FB is based internally on LibFFi (see [https://github.com/libffi/libffi/blob/master/LICENSE] for license)

Sub thread1()
  Print "Enjoy"
End Sub

Sub thread2()
  Print "Rosetta"
End Sub

Sub thread3()
  Print "Code"
End Sub

Print "Press any key to print next batch of 3 strings or ESC to quit"
Print

Do
  Dim t1 As Any Ptr = ThreadCall thread1
  Dim t2 As Any Ptr = ThreadCall thread2
  Dim t3 As Any Ptr = ThreadCall thread3
  ThreadWait t1
  ThreadWait t2
  ThreadWait t3
  Print
  Sleep
Loop While Inkey <> Chr(27)


package main

import (
    "fmt"
    "golang.org/x/exp/rand"
    "time"
)

func main() {
    words := []string{"Enjoy", "Rosetta", "Code"}
    seed := uint64(time.Now().UnixNano())
    q := make(chan string)
    for i, w := range words {
        go func(w string, seed uint64) {
            r := rand.New(rand.NewSource(seed))
            time.Sleep(time.Duration(r.Int63n(1e9)))
            q <- w
        }(w, seed+uint64(i))
    }
    for i := 0; i < len(words); i++ {
        fmt.Println(<-q)
    }
}


'Enjoy Rosetta Code'.tokenize().collect { w ->
    Thread.start {
        Thread.sleep(1000 * Math.random() as int)
        println w
    }
}.each { it.join() }


import Control.Concurrent

main = mapM_ forkIO [process1, process2, process3] where
  process1 = putStrLn "Enjoy"
  process2 = putStrLn "Rosetta"
  process3 = putStrLn "Code"


procedure main()
   L:=[ thread write("Enjoy"), thread write("Rosetta"), thread write("Code") ]
   every wait(!L)
end


   smoutput&>({[email protected]#);:'Enjoy Rosetta Code'
Rosetta
Code
Enjoy


import java.util.concurrent.CyclicBarrier;

public class Threads
{
  public static class DelayedMessagePrinter implements Runnable
  {
    private CyclicBarrier barrier;
    private String msg;

    public DelayedMessagePrinter(CyclicBarrier barrier, String msg)
    {
      this.barrier = barrier;
      this.msg = msg;
    }

    public void run()
    {
      try
      {  barrier.await();  }
      catch (Exception e)
      {  }
      System.out.println(msg);
    }
  }

  public static void main(String[] args)
  {
    CyclicBarrier barrier = new CyclicBarrier(3);
    new Thread(new DelayedMessagePrinter(barrier, "Enjoy")).start();
    new Thread(new DelayedMessagePrinter(barrier, "Rosetta")).start();
    new Thread(new DelayedMessagePrinter(barrier, "Code")).start();
  }
}


self.addEventListener('message', function (event) {
  self.postMessage(event.data);
  self.close();
}, false);


words = ["Enjoy", "Rosetta", "Code"]

function sleepprint(s)
    sleep(rand())
    println(s)
end

@sync for word in words
    @async sleepprint(word)
end


// version 1.1.2

import java.util.concurrent.CyclicBarrier

class DelayedMessagePrinter(val barrier: CyclicBarrier, val msg: String) : Runnable {
    override fun run() {
        barrier.await()
        println(msg)
    }
}

fun main(args: Array<String>) {
    val msgs = listOf("Enjoy", "Rosetta", "Code")
    val barrier = CyclicBarrier(msgs.size)
    for (msg in msgs) Thread(DelayedMessagePrinter(barrier, msg)).start()
}


;;;
;;;   This is a straight port of the Erlang version.
;;;
;;;   You can run this under the LFE REPL as follows:
;;;
;;;   (slurp "concurrent-computing.lfe")
;;;   (start)
;;;
(defmodule concurrent-computing
  (export (start 0)))

(defun start ()
  (lc ((<- word '("Enjoy" "Rosetta" "Code")))
    (spawn (lambda () (say (self) word))))
  (wait 2)
  'ok)

(defun say (pid word)
  (lfe_io:format "~p~n" (list word))
  (! pid 'done))

(defun wait (n)
  (receive
    ('done (case n
             (0 0)
             (_n (wait (- n 1)))))))


:- object(concurrency).

    :- initialization(output).

    output :-
        threaded((
            write('Enjoy'),
            write('Rosetta'),
            write('Code')
        )).

:- end_object.


co = {}
co[1] = coroutine.create( function() print "Enjoy" end )
co[2] = coroutine.create( function() print "Rosetta" end )
co[3] = coroutine.create( function() print "Code" end )

math.randomseed( os.time() )
h = {}
i = 0
repeat
    j = math.random(3)
    if h[j] == nil then
       coroutine.resume( co[j] )
       h[j] = true
       i = i + 1
    end
until i == 3


Thread.Plan Concurrent
Module CheckIt {
      Flush  \\ empty stack of values
      Data "Enjoy", "Rosetta", "Code"
      For i=1 to 3 {
            Thread {
                  Print A$
                  Thread This Erase
            } As K
            Read M$
            Thread K Execute Static A$=M$
            Thread K Interval Random(500,1000)
            Threads
      }
      Rem : Wait 3000   ' we can use just a wait loop, or the main.task loop
      \\ main.task exit if all threads erased
      Main.Task 30 {
      }
\\ when module exit all threads from this module get a signal to stop.
\\ we can use Threads Erase to erase all threads.
\\ Also if we press Esc we do the same
}
CheckIt

\\ we can define again the module, and now we get three time each name, but not every time three same names.
\\ if we change to Threads.Plan Sequential we get always the three same names
\\ Also in concurrent plan we can use a block to ensure that statements run without other thread executed in parallel.

Module CheckIt {
      Flush  \\ empty stack of values
      Data "Enjoy", "Rosetta", "Code"
      For i=1 to 3 {
            Thread {
                  Print A$
                  Print A$
                  Print A$
                  Thread This Erase
            } As K
            Read M$
            Thread K Execute Static A$=M$
            Thread K Interval Random(500,530)
            Threads
      }
      Rem : Wait 3000   ' we can use just a wait loop, or the main.task loop
      \\ main.task exit if all threads erased
      Main.Task 30 {
      }
\\ when module exit all threads from this module get a signal to stop.
\\ we can use Threads Erase to erase all threads.
\\ Also if we press Esc we do the same
}
CheckIt


ParallelDo[
    Pause[RandomReal[]];
    Print[s],
    {s, {"Enjoy", "Rosetta", "Code"}}
]


:- module concurrent_computing.
:- interface.

:- import_module io.
:- pred main(io::di, io::uo) is cc_multi.

:- implementation.
:- import_module thread.

main(!IO) :-
   spawn(io.print_cc("Enjoy\n"), !IO),
   spawn(io.print_cc("Rosetta\n"), !IO),
   spawn(io.print_cc("Code\n"), !IO).


/**
 Concurrent computing, in Neko
*/

var thread_create = $loader.loadprim("[email protected]_create", 2);

var subtask = function(message) {
  $print(message, "\n");
}

/* The thread functions happen so fast as to look sequential */
thread_create(subtask, "Enjoy");
thread_create(subtask, "Rosetta");
thread_create(subtask, "Code");

/* slow things down */
var sys_sleep = $loader.loadprim("[email protected]_sleep", 1);
var random_new = $loader.loadprim("[email protected]_new", 0);
var random_int = $loader.loadprim("[email protected]_int", 2);

var randomsleep = function(message) {
  var r = random_new();
  var sleep = random_int(r, 3);
  sys_sleep(sleep);
  $print(message, "\n");
}

$print("\nWith random delays\n");
thread_create(randomsleep, "Enjoy");
thread_create(randomsleep, "Rosetta");
thread_create(randomsleep, "Code");

/* Let the threads complete */
sys_sleep(4);


const str = ["Enjoy", "Rosetta", "Code"]

var thr: array[3, Thread[int32]]

proc f(i:int32) {.thread.} =
  echo str[i]

for i in 0..thr.high:
  createThread(thr[i], f, int32(i))
joinThreads(thr)


bundle Default {
  class MyThread from Thread {
    New(name : String) {
      Parent(name);
    }

    method : public : Run(param : Base) ~ Nil {
      string := param->As(String);
      string->PrintLine();
    }
  }

  class Concurrent {
    New() {
    }

    function : Main(args : System.String[]) ~ Nil {
      t0 := MyThread->New("t0");
      t1 := MyThread->New("t1");
      t2 := MyThread->New("t2");

      t0->Execute("Enjoy"->As(Base));
      t1->Execute("Rosetta"->As(Base));
      t2->Execute("Code"->As(Base));
    }
  }
}


#directory "+threads"
#load "unix.cma"
#load "threads.cma"

let sleepy_print msg =
  Unix.sleep (Random.int 4);
  print_endline msg

let threads =
  List.map (Thread.create sleepy_print) ["Enjoy"; "Rosetta"; "Code"]

let () =
  Random.self_init ();
  List.iter (Thread.join) threads


#[ "Enjoy" println ] &
#[ "Rosetta" println ] &
#[ "Code" println ] &


(import (otus random!))

(for-each (lambda (str)
      (define timeout (rand! 999))
      (async (lambda ()
         (sleep timeout)
         (print str))))
   '("Enjoy" "Rosetta" "Code"))


-- this will launch 3 threads, with each thread given a message to print out.
-- I've added a stoplight to make each thread wait until given a go signal,
-- plus some sleeps to give the threads a chance to randomize the execution
-- order a little.
launcher = .launcher~new
launcher~launch

::class launcher
-- the launcher method.  Guarded is the default, but let's make this
-- explicit here
::method launch guarded

  runner1 = .runner~new(self, "Enjoy")
  runner2 = .runner~new(self, "Rosetta")
  runner3 = .runner~new(self, "Code")

  -- let's give the threads a chance to settle in to the
  -- starting line
  call syssleep 1

  guard off   -- release the launcher lock.  This is the starter's gun

-- this is a guarded method that the runners will call.  They
-- will block until the launch method releases the object guard
::method block guarded

::class runner
::method init
  use arg launcher, text
  reply  -- this creates the new thread

  call syssleep .5  -- try to mix things up by sleeping
  launcher~block    -- wait for the go signal
  call syssleep .5  -- add another sleep here
  say text


for Msg in ["Enjoy" "Rosetta" "Code"] do
   thread
      {System.showInfo Msg}
   end
end


program ConcurrentComputing;
{$IFdef FPC}
  {$MODE DELPHI}
{$ELSE}
  {$APPTYPE CONSOLE}
{$ENDIF}
uses
  {$IFDEF UNIX}
    cthreads,
  {$ENDIF}
  SysUtils, Classes;

type
  TRandomThread = class(TThread)
  private
    FString: string;
    T0 : Uint64;
  protected
    procedure Execute; override;
  public
    constructor Create(const aString: string); overload;
  end;
const
  MyStrings: array[0..2] of String = ('Enjoy ','Rosetta ','Code ');
var
  gblRunThdCnt : LongWord = 0;

constructor TRandomThread.Create(const aString: string);
begin
  inherited Create(False);
  FreeOnTerminate := True;
  FString := aString;
  interlockedincrement(gblRunThdCnt);
end;

procedure TRandomThread.Execute;
var
  i : NativeInt;
begin
  i := Random(300);
  T0 := GettickCount64;
  Sleep(i);
  //output of difference in time
  Writeln(FString,i:4,GettickCount64-T0 -i:2);
  interlockeddecrement(gblRunThdCnt);
end;

var
  lThreadArray: Array[0..9] of THandle;
  i : NativeInt;
begin
  Randomize;

  gblRunThdCnt := 0;
  For i := low(lThreadArray) to High(lThreadArray) do
    lThreadArray[i] := TRandomThread.Create(Format('%9s %4d',[myStrings[Random(3)],i])).Handle;

  while gblRunThdCnt > 0 do
    sleep(125);
end.


use threads;
use Time::HiRes qw(sleep);

$_->join for map {
    threads->create(sub {
        sleep rand;
        print shift, "\n";
    }, $_)
} qw(Enjoy Rosetta Code);


without js -- (threads)
procedure echo(string s)
    sleep(rand(100)/100)
    enter_cs()
    puts(1,s)
    puts(1,'\n')
    leave_cs()
end procedure

constant threads = {create_thread(routine_id("echo"),{"Enjoy"}),
                    create_thread(routine_id("echo"),{"Rosetta"}),
                    create_thread(routine_id("echo"),{"Code"})}

wait_thread(threads)
puts(1,"done")
{} = wait_key()


(for (N . Str) '("Enjoy" "Rosetta" "Code")
   (task (- N) (rand 1000 4000)              # Random start time 1 .. 4 sec
      Str Str                                # Closure with string value
      (println Str)                          # Task body: Print the string
      (task @) ) )                           # and stop the task


-V eps = 1e-10

F to_str(m)
   V r = ‘’
   L(row) m
      V i = L.index
      r ‘’= I i == 0 {‘[’} E ‘ ’
      L(val) row
         V j = L.index
         I j != 0
            r ‘’= ‘ ’
         r ‘’= ‘(#2.4, #2.4)’.format(val.real, val.imag)
      r ‘’= I i == m.len - 1 {‘]’} E "\n"
   R r

F conjugateTransposed(m)
   V r = [[0i] * m.len] * m.len
   L(i) 0 .< m.len
      L(j) 0 .< m.len
         r[j][i] = conjugate(m[i][j])
   R r

F mmul(m1, m2)
   V r = [[0i] * m1.len] * m1.len
   L(i) 0 .< m1.len
      L(j) 0 .< m1.len
         L(k) 0 .< m1.len
            r[i][j] += m1[i][k] * m2[k][j]
   R r

F isHermitian(m)
   L(i) 0 .< m.len
      L(j) 0 .< m.len
         I m[i][j] != conjugate(m[j][i])
            R 0B
   R 1B

F isEqual(m1, m2)
   L(i) 0 .< m1.len
      L(j) 0 .< m1.len
         I m1[i][j] != m2[i][j]
            R 0B
   R 1B

F isNormal(m)
   V h = conjugateTransposed(m)
   R isEqual(mmul(m, h), mmul(h, m))

F isIdentity(m)
   L(i) 0 .< m.len
      L(j) 0 .< m.len
         I i == j
            I abs(m[i][j] - 1.0) > :eps
               R 0B
         E
            I abs(m[i][j]) > :eps
               R 0B
   R 1B

F isUnitary(m)
   V h = conjugateTransposed(m)
   R isIdentity(mmul(m, h)) & isIdentity(mmul(h, m))

F test(m)
   print(‘Matrix’)
   print(‘------’)
   print(to_str(m))
   print(‘’)
   print(‘Conjugate transposed’)
   print(‘--------------------’)
   print(to_str(conjugateTransposed(m)))
   print(‘’)
   print(‘Hermitian: ’(I isHermitian(m) {‘true’} E ‘false’))
   print(‘Normal: ’(I isNormal(m) {‘true’} E ‘false’))
   print(‘Unitary: ’(I isUnitary(m) {‘true’} E ‘false’))

V M2 = [[3.0 + 0.0i, 2.0 + 1.0i],
        [2.0 - 1.0i, 1.0 + 0.0i]]

V M3 = [[1.0 + 0.0i, 1.0 + 0.0i, 0.0 + 0.0i],
        [0.0 + 0.0i, 1.0 + 0.0i, 1.0 + 0.0i],
        [1.0 + 0.0i, 0.0 + 0.0i, 1.0 + 0.0i]]

V SR2 = 1 / sqrt(2.0)
V SR2i = SR2 * 1i
V M4 = [[SR2 + 0.0i, SR2 + 0.0i, 0.0 + 0.0i],
        [0.0 + SR2i, 0.0 - SR2i, 0.0 + 0.0i],
        [0.0 + 0.0i, 0.0 + 0.0i, 0.0 + 1.0i]]

test(M2)
print("\n")
test(M3)
print("\n")
test(M4)


int main() {
	// Start threads and wait for them to finish
	({
		Thread.Thread(write, "Enjoy\n"),
		Thread.Thread(write, "Rosetta\n"),
		Thread.Thread(write, "Code\n")
	})->wait();

	// Exit program
	exit(0);
}


$Strings = "Enjoy","Rosetta","Code"

$SB = {param($String)Write-Output $String}

foreach($String in $Strings) {
    Start-Job -ScriptBlock $SB -ArgumentList $String | Out-Null
    }

Get-Job | Wait-Job | Receive-Job
Get-Job | Remove-Job


main :-
    thread_create(say("Enjoy"),A,[]),
    thread_create(say("Rosetta"),B,[]),
    thread_create(say("Code"),C,[]),
    thread_join(A,_),
    thread_join(B,_),
    thread_join(C,_).

say(Message) :-
    Delay is random_float,
    sleep(Delay),
    writeln(Message).


with Ada.Text_IO; use Ada.Text_IO;
with Ada.Complex_Text_IO; use Ada.Complex_Text_IO;
with Ada.Numerics.Complex_Types; use Ada.Numerics.Complex_Types;
with Ada.Numerics.Complex_Arrays; use Ada.Numerics.Complex_Arrays;
procedure ConTrans is
   subtype CM is Complex_Matrix;
   S2O2 : constant Float := 0.7071067811865;

   procedure Print (mat : CM) is begin
      for row in mat'Range(1) loop for col in mat'Range(2) loop
         Put(mat(row,col), Exp=>0, Aft=>4);
      end loop; New_Line; end loop;
   end Print;

   function almostzero(mat : CM; tol : Float) return Boolean is begin
      for row in mat'Range(1) loop for col in mat'Range(2) loop
         if abs(mat(row,col)) > tol then return False; end if;
      end loop; end loop;
      return True;
   end almostzero;

   procedure Examine (mat : CM) is
      CT : CM := Conjugate (Transpose(mat));
      isherm, isnorm, isunit : Boolean;
   begin
      isherm := almostzero(mat-CT, 1.0e-6);
      isnorm := almostzero(mat*CT-CT*mat, 1.0e-6);
      isunit := almostzero(CT-Inverse(mat), 1.0e-6);
      Print(mat);
      Put_Line("Conjugate transpose:"); Print(CT);
      Put_Line("Hermitian?: " & isherm'Img);
      Put_Line("Normal?: " & isnorm'Img);
      Put_Line("Unitary?: " & isunit'Img);
   end Examine;

   hmat : CM := ((3.0+0.0*i, 2.0+1.0*i), (2.0-1.0*i, 1.0+0.0*i));
   nmat : CM := ((1.0+0.0*i, 1.0+0.0*i, 0.0+0.0*i),
                 (0.0+0.0*i, 1.0+0.0*i, 1.0+0.0*i),
                 (1.0+0.0*i, 0.0+0.0*i, 1.0+0.0*i));
   umat : CM := ((S2O2+0.0*i, S2O2+0.0*i, 0.0+0.0*i),
                 (0.0+S2O2*i, 0.0-S2O2*i, 0.0+0.0*i),
                 (0.0+0.0*i, 0.0+0.0*i, 0.0+1.0*i));
begin
   Put_Line("hmat:"); Examine(hmat); New_Line;
   Put_Line("nmat:"); Examine(nmat); New_Line;
   Put_Line("umat:"); Examine(umat);
end ConTrans;


Global mutex = CreateMutex()

Procedure Printer(*str)
	LockMutex(mutex)
	PrintN( PeekS(*str) )
	UnlockMutex(mutex)
EndProcedure

If OpenConsole()
	LockMutex(mutex)
	thread1 = CreateThread(@Printer(), @"Enjoy")
	thread2 = CreateThread(@Printer(), @"Rosetta")
	thread3 = CreateThread(@Printer(), @"Code")
	UnlockMutex(mutex)

	WaitThread(thread1)
	WaitThread(thread2)
	WaitThread(thread3)

	Print(#CRLF$ + #CRLF$ + "Press ENTER to exit")
	Input()

	CloseConsole()
EndIf

FreeMutex(mutex)


import asyncio

async def print_(string: str) -> None:
    print(string)

async def main():
    strings = ['Enjoy', 'Rosetta', 'Code']
    coroutines = map(print_, strings)
    await asyncio.gather(*coroutines)

if __name__ == '__main__':
    asyncio.run(main())


#lang racket
(for ([str '("Enjoy" "Rosetta" "Code")])
  (thread (λ () (displayln str))))


my @words = <Enjoy Rosetta Code>;
@words.race(:batch(1)).map: { sleep rand; say $_ };


BEGIN # find and classify the complex conjugate transpose of a complex matrix #
    # returns the conjugate transpose of m #
    OP   CONJUGATETRANSPOSE = ( [,]COMPL m )[,]COMPL:
         BEGIN
            [ 2 LWB m : 2 UPB m, 1 LWB m : 1 UPB m ]COMPL result;
            FOR i FROM 1 LWB m TO 1 UPB m DO
                FOR j FROM 2 LWB m TO 2 UPB m DO
                    result[ j, i ] := CONJ m[ i, j ]
                OD
            OD;
            result
         END # CONJUGATETRANSPOSE # ;
    # returns TRUE if m is an identity matrix, FALSE otherwise #
    OP   ISIDENTITY  = ( [,]COMPL m )BOOL:
         IF 1 LWB m /= 2 LWB m OR 1 UPB m /= 2 UPB m THEN
            # non-square matrix #
            FALSE
         ELSE
            # the matrix is square #
            # returns TRUE IF v - e is nearly 0, FALSE Otherwise #
            PROC nearly equal = ( COMPL v, REAL e )BOOL: ABS re OF v - e < 1e-14 AND ABS im OF v < 1e-14;
            BOOL result := TRUE;
            FOR i FROM 1 LWB m TO 1 UPB m WHILE result DO
                IF result := nearly equal( m[ i, i ], 1 ) THEN
                    # the diagonal element is 1 - test the non-diagonals #
                    FOR j FROM 1 LWB m TO 1 UPB m WHILE result DO
                        IF i /= j THEN result := nearly equal( m[ i, j ], 0 ) FI
                    OD
                FI
            OD;
            result
         FI # ISIDENTITY # ;
    # returns m multiplied by n #
    PRIO X = 7;
    OP   X = ( [,]COMPL m, n )[,]COMPL:
         BEGIN
            [ 1 : 1 UPB m, 1 : 2 UPB n ]COMPL r;
            FOR i FROM 1 LWB m TO 1 UPB m DO
                FOR j FROM 2 LWB n TO 2 UPB n DO
                    r[ i, j ] := 0;
                    FOR k TO 2 UPB n DO
                        r[ i, j ] +:= m[ i, k ] * n[ k, j ]
                    OD
                OD
            OD;
            r
         END # X # ;
    # prints the complex matris m #
    PROC show matrix = ( [,]COMPL m )VOID:
         FOR i FROM 1 LWB m TO 1 UPB m DO
             print( ( "    " ) );
             FOR j FROM 2 LWB m TO 2 UPB m DO
                 print( ( "( ", fixed( re OF m[ i, j ], -8, 4 )
                        , ", ", fixed( im OF m[ i, j ], -8, 4 )
                        , "i )"
                        )
                      )
             OD;
             print( ( newline ) )
         OD # show matrix # ;
    # display the matrix m, its conjugate transpose and whether it is Hermitian, Normal and Unitary #
    PROC show = ( [,]COMPL m )VOID:
         BEGIN
            [,]COMPL c  = CONJUGATETRANSPOSE m;
            [,]COMPL cm = c X m;
            [,]COMPL mc = m X c;
            print( ( "Matrix:", newline ) );
            show matrix( m );
            print( ( "Conjugate Transpose:", newline ) );
            show matrix( c );
            BOOL is normal  = cm = mc;
            BOOL is unitary = IF   NOT is normal     THEN FALSE
                              ELSE     ISIDENTITY mc
                              FI;
            print( ( IF c = m      THEN "" ELSE "not " FI, "Hermitian; "
                   , IF is normal  THEN "" ELSE "not " FI, "Normal; "
                   , IF is unitary THEN "" ELSE "not " FI, "Unitary"
                   , newline
                   )
                 );
            print( ( newline ) )
         END # show # ;
    # test some matrices for Hermitian, Normal and Unitary                             #
    show( ( ( ( 3.0000 I  0.0000 ), ( 2.0000 I 1.0000 ) )
          , ( ( 2.0000 I -1.0000 ), ( 1.0000 I 0.0000 ) )
          )
        );
    show( ( ( ( 1.0000 I 0.0000 ), ( 1.0000 I  0.0000 ), ( 0.0000 I 0.0000 ) )
          , ( ( 0.0000 I 0.0000 ), ( 1.0000 I  0.0000 ), ( 1.0000 I 0.0000 ) )
          , ( ( 1.0000 I 0.0000 ), ( 0.0000 I  0.0000 ), ( 1.0000 I 0.0000 ) )
          )
        );
    REAL rh = sqrt( 0.5 );
    show( ( ( ( rh     I 0.0000 ), ( rh     I  0.0000 ), ( 0.0000 I 0.0000 ) )
          , ( ( 0.0000 I rh     ), ( 0.0000 I - rh    ), ( 0.0000 I 0.0000 ) )
          , ( ( 0.0000 I 0.0000 ), ( 0.0000 I  0.0000 ), ( 0.0000 I 1.0000 ) )
          )
        )
END


[ 'Enjoy' 'Rosetta' 'Code' ] as $words

thread talker
    $words pop "%s\n"
    repeat dup print
        500 choose ms

talker as a
talker as b
talker as c


Main(0,0)
|:
    Print["Enjoy"]
    Print["Rosetta"]
    Print["Code"]
:|


%w{Enjoy Rosetta Code}.map do |x|
    Thread.new do
        sleep rand
        puts x
    end
end.each do |t|
  t.join
end


extern crate rand;
use std::thread;
use rand::thread_rng;
use rand::distributions::{Range, IndependentSample};

fn main() {
    let mut rng = thread_rng();
    let rng_range = Range::new(0u32, 100);
    for word in "Enjoy Rosetta Code".split_whitespace() {
        let snooze_time = rng_range.ind_sample(&mut rng);
        let local_word = word.to_owned();
        std::thread::spawn(move || {
            thread::sleep_ms(snooze_time);
            println!("{}", local_word);
        });
    }
    thread::sleep_ms(1000);
}


/* Uses C99 specified complex.h, complex datatype has to be defined and operation provided if used on non-C99 compilers */

#include<stdlib.h>
#include<stdio.h>
#include<complex.h>

typedef struct
{
  int rows, cols;
  complex **z;
} matrix;

matrix
transpose (matrix a)
{
  int i, j;
  matrix b;

  b.rows = a.cols;
  b.cols = a.rows;

  b.z = malloc (b.rows * sizeof (complex *));

  for (i = 0; i < b.rows; i++)
    {
      b.z[i] = malloc (b.cols * sizeof (complex));
      for (j = 0; j < b.cols; j++)
        {
          b.z[i][j] = conj (a.z[j][i]);
        }
    }

  return b;
}

int
isHermitian (matrix a)
{
  int i, j;
  matrix b = transpose (a);

  if (b.rows == a.rows && b.cols == a.cols)
    {
      for (i = 0; i < b.rows; i++)
        {
          for (j = 0; j < b.cols; j++)
            {
              if (b.z[i][j] != a.z[i][j])
                return 0;
            }
        }
    }

  else
    return 0;

  return 1;
}

matrix
multiply (matrix a, matrix b)
{
  matrix c;
  int i, j;

  if (a.cols == b.rows)
    {
      c.rows = a.rows;
      c.cols = b.cols;

      c.z = malloc (c.rows * (sizeof (complex *)));

      for (i = 0; i < c.rows; i++)
        {
          c.z[i] = malloc (c.cols * sizeof (complex));
          c.z[i][j] = 0 + 0 * I;
          for (j = 0; j < b.cols; j++)
            {
              c.z[i][j] += a.z[i][j] * b.z[j][i];
            }
        }

    }

  return c;
}

int
isNormal (matrix a)
{
  int i, j;
  matrix a_ah, ah_a;

  if (a.rows != a.cols)
    return 0;

  a_ah = multiply (a, transpose (a));
  ah_a = multiply (transpose (a), a);

  for (i = 0; i < a.rows; i++)
    {
      for (j = 0; j < a.cols; j++)
        {
          if (a_ah.z[i][j] != ah_a.z[i][j])
            return 0;
        }
    }

  return 1;
}

int
isUnitary (matrix a)
{
  matrix b;
  int i, j;
  if (isNormal (a) == 1)
    {
      b = multiply (a, transpose(a));

      for (i = 0; i < b.rows; i++)
        {
          for (j = 0; j < b.cols; j++)
            {
              if ((i == j && b.z[i][j] != 1) || (i != j && b.z[i][j] != 0))
                return 0;
            }
        }
      return 1;
    }
  return 0;
}

int
main ()
{
  complex z = 3 + 4 * I;
  matrix a, aT;
  int i, j;
  printf ("Enter rows and columns :");
  scanf ("%d%d", &a.rows, &a.cols);

  a.z = malloc (a.rows * sizeof (complex *));
  printf ("Randomly Generated Complex Matrix A is : ");
  for (i = 0; i < a.rows; i++)
    {
      printf ("\n");
      a.z[i] = malloc (a.cols * sizeof (complex));
      for (j = 0; j < a.cols; j++)
        {
          a.z[i][j] = rand () % 10 + rand () % 10 * I;
          printf ("\t%f + %fi", creal (a.z[i][j]), cimag (a.z[i][j]));
        }
    }

  aT = transpose (a);

  printf ("\n\nTranspose of Complex Matrix A is : ");
  for (i = 0; i < aT.rows; i++)
    {
      printf ("\n");
      aT.z[i] = malloc (aT.cols * sizeof (complex));
      for (j = 0; j < aT.cols; j++)
        {
          aT.z[i][j] = rand () % 10 + rand () % 10 * I;
          printf ("\t%f + %fi", creal (aT.z[i][j]), cimag (aT.z[i][j]));
        }
    }

  printf ("\n\nComplex Matrix A %s hermitian",
          isHermitian (a) == 1 ? "is" : "is not");
  printf ("\n\nComplex Matrix A %s unitary",
          isUnitary (a) == 1 ? "is" : "is not");
  printf ("\n\nComplex Matrix A %s normal",
          isNormal (a) == 1 ? "is" : "is not");

  return 0;
}


import scala.actors.Futures
List("Enjoy", "Rosetta", "Code").map { x =>
    Futures.future {
      Thread.sleep((Math.random * 1000).toInt)
       println(x)
    }
}.foreach(_())


(parallel-execute (lambda () (print "Enjoy"))
                  (lambda () (print "Rosetta"))
                  (lambda () (print "Code")))


var a = <Enjoy Rosetta Code>

a.map{|str|
    {   Sys.sleep(1.rand)
        say str
    }.fork
}.map{|thr| thr.wait }


#include <cassert>
#include <cmath>
#include <complex>
#include <iomanip>
#include <iostream>
#include <sstream>
#include <vector>

template <typename scalar_type> class complex_matrix {
public:
    using element_type = std::complex<scalar_type>;

    complex_matrix(size_t rows, size_t columns)
        : rows_(rows), columns_(columns), elements_(rows * columns) {}

    complex_matrix(size_t rows, size_t columns, element_type value)
        : rows_(rows), columns_(columns), elements_(rows * columns, value) {}

    complex_matrix(size_t rows, size_t columns,
        const std::initializer_list<std::initializer_list<element_type>>& values)
        : rows_(rows), columns_(columns), elements_(rows * columns) {
        assert(values.size() <= rows_);
        size_t i = 0;
        for (const auto& row : values) {
            assert(row.size() <= columns_);
            std::copy(begin(row), end(row), &elements_[i]);
            i += columns_;
        }
    }

    size_t rows() const { return rows_; }
    size_t columns() const { return columns_; }

    const element_type& operator()(size_t row, size_t column) const {
        assert(row < rows_);
        assert(column < columns_);
        return elements_[row * columns_ + column];
    }
    element_type& operator()(size_t row, size_t column) {
        assert(row < rows_);
        assert(column < columns_);
        return elements_[row * columns_ + column];
    }

    friend bool operator==(const complex_matrix& a, const complex_matrix& b) {
        return a.rows_ == b.rows_ && a.columns_ == b.columns_ &&
               a.elements_ == b.elements_;
    }

private:
    size_t rows_;
    size_t columns_;
    std::vector<element_type> elements_;
};

template <typename scalar_type>
complex_matrix<scalar_type> product(const complex_matrix<scalar_type>& a,
                                    const complex_matrix<scalar_type>& b) {
    assert(a.columns() == b.rows());
    size_t arows = a.rows();
    size_t bcolumns = b.columns();
    size_t n = a.columns();
    complex_matrix<scalar_type> c(arows, bcolumns);
    for (size_t i = 0; i < arows; ++i) {
        for (size_t j = 0; j < n; ++j) {
            for (size_t k = 0; k < bcolumns; ++k)
                c(i, k) += a(i, j) * b(j, k);
        }
    }
    return c;
}

template <typename scalar_type>
complex_matrix<scalar_type>
conjugate_transpose(const complex_matrix<scalar_type>& a) {
    size_t rows = a.rows(), columns = a.columns();
    complex_matrix<scalar_type> b(columns, rows);
    for (size_t i = 0; i < columns; i++) {
        for (size_t j = 0; j < rows; j++) {
            b(i, j) = std::conj(a(j, i));
        }
    }
    return b;
}

template <typename scalar_type>
std::string to_string(const std::complex<scalar_type>& c) {
    std::ostringstream out;
    const int precision = 6;
    out << std::fixed << std::setprecision(precision);
    out << std::setw(precision + 3) << c.real();
    if (c.imag() > 0)
        out << " + " << std::setw(precision + 2) << c.imag() << 'i';
    else if (c.imag() == 0)
        out << " + " << std::setw(precision + 2) << 0.0 << 'i';
    else
        out << " - " << std::setw(precision + 2) << -c.imag() << 'i';
    return out.str();
}

template <typename scalar_type>
void print(std::ostream& out, const complex_matrix<scalar_type>& a) {
    size_t rows = a.rows(), columns = a.columns();
    for (size_t row = 0; row < rows; ++row) {
        for (size_t column = 0; column < columns; ++column) {
            if (column > 0)
                out << ' ';
            out << to_string(a(row, column));
        }
        out << '\n';
    }
}

template <typename scalar_type>
bool is_hermitian_matrix(const complex_matrix<scalar_type>& matrix) {
    if (matrix.rows() != matrix.columns())
        return false;
    return matrix == conjugate_transpose(matrix);
}

template <typename scalar_type>
bool is_normal_matrix(const complex_matrix<scalar_type>& matrix) {
    if (matrix.rows() != matrix.columns())
        return false;
    auto c = conjugate_transpose(matrix);
    return product(c, matrix) == product(matrix, c);
}

bool is_equal(const std::complex<double>& a, double b) {
    constexpr double e = 1e-15;
    return std::abs(a.imag()) < e && std::abs(a.real() - b) < e;
}

template <typename scalar_type>
bool is_identity_matrix(const complex_matrix<scalar_type>& matrix) {
    if (matrix.rows() != matrix.columns())
        return false;
    size_t rows = matrix.rows();
    for (size_t i = 0; i < rows; ++i) {
        for (size_t j = 0; j < rows; ++j) {
            if (!is_equal(matrix(i, j), scalar_type(i == j ? 1 : 0)))
                return false;
        }
    }
    return true;
}

template <typename scalar_type>
bool is_unitary_matrix(const complex_matrix<scalar_type>& matrix) {
    if (matrix.rows() != matrix.columns())
        return false;
    auto c = conjugate_transpose(matrix);
    auto p = product(c, matrix);
    return is_identity_matrix(p) && p == product(matrix, c);
}

template <typename scalar_type>
void test(const complex_matrix<scalar_type>& matrix) {
    std::cout << "Matrix:\n";
    print(std::cout, matrix);
    std::cout << "Conjugate transpose:\n";
    print(std::cout, conjugate_transpose(matrix));
    std::cout << std::boolalpha;
    std::cout << "Hermitian: " << is_hermitian_matrix(matrix) << '\n';
    std::cout << "Normal: " << is_normal_matrix(matrix) << '\n';
    std::cout << "Unitary: " << is_unitary_matrix(matrix) << '\n';
}

int main() {
    using matrix = complex_matrix<double>;

    matrix matrix1(3, 3, {{{2, 0}, {2, 1}, {4, 0}},
                          {{2, -1}, {3, 0}, {0, 1}},
                          {{4, 0}, {0, -1}, {1, 0}}});

    double n = std::sqrt(0.5);
    matrix matrix2(3, 3, {{{n, 0}, {n, 0}, {0, 0}},
                          {{0, -n}, {0, n}, {0, 0}},
                          {{0, 0}, {0, 0}, {0, 1}}});

    matrix matrix3(3, 3, {{{2, 2}, {3, 1}, {-3, 5}},
                          {{2, -1}, {4, 1}, {0, 0}},
                          {{7, -5}, {1, -4}, {1, 0}}});

    test(matrix1);
    std::cout << '\n';
    test(matrix2);
    std::cout << '\n';
    test(matrix3);
    return 0;
}


import Foundation

let myList = ["Enjoy", "Rosetta", "Code"]

for word in myList {
    dispatch_async(dispatch_get_global_queue(0, 0)) {
        NSLog(word)
    }
}

dispatch_main()


structure TTd  =  Thread.Thread ;
structure TTm  =  Thread.Mutex  ;

val threadedStringList =  fn tasks:string list  =>
 let
  val mx        =  TTm.mutex () ;
  val taskstore =  ref tasks ;
  fun makeFastRand () =  Real.rem (Time.toReal (Time.now ()),1.0)
  val doTask =  fn () =>
   let
    val mytask :  string  ref   = ref "" ;
   in
   (   TTm.lock mx ; mytask :=  hd ( !taskstore ) ;  taskstore:= tl (!taskstore) ; TTm.unlock mx ;
       Posix.Process.sleep (Time.fromReal (makeFastRand ())) ;
       TTm.lock mx ; print ( !mytask ^ "\n")  ;   TTm.unlock mx ;
       TTd.exit ()
   )
   end
in

 List.tabulate ( length tasks , fn i => TTd.fork (doTask , []) )

end ;


after [expr int(1000*rand())] {puts "Enjoy"}
after [expr int(1000*rand())] {puts "Rosetta"}
after [expr int(1000*rand())] {puts "Code"}


(echo "Enjoy" & echo "Rosetta"& echo "Code"&)


(defun matrix-multiply (m1 m2)
 (mapcar
  (lambda (row)
   (apply #'mapcar
    (lambda (&rest column)
     (apply #'+ (mapcar #'* row column))) m2)) m1))

(defun identity-p (m &optional (tolerance 1e-6))
 "Is m an identity matrix?"
  (loop for row in m
    for r = 1 then (1+ r) do
      (loop for col in row
        for c = 1 then (1+ c) do
          (if (eql r c)
            (unless (< (abs (- col 1)) tolerance) (return-from identity-p nil))
            (unless (< (abs col) tolerance) (return-from identity-p nil)) )))
  T )

(defun conjugate-transpose (m)
  (apply #'mapcar #'list (mapcar #'(lambda (r) (mapcar #'conjugate r)) m)) )

(defun hermitian-p (m)
  (equalp m (conjugate-transpose m)))

(defun normal-p (m)
  (let ((m* (conjugate-transpose m)))
    (equalp (matrix-multiply m m*) (matrix-multiply m* m)) ))

(defun unitary-p (m)
  (identity-p (matrix-multiply m (conjugate-transpose m))) )


Private Sub Enjoy()
    Debug.Print "Enjoy"
End Sub
Private Sub Rosetta()
    Debug.Print "Rosetta"
End Sub
Private Sub Code()
    Debug.Print "Code"
End Sub
Public Sub concurrent()
    when = Now + TimeValue("00:00:01")
    Application.OnTime when, "Enjoy"
    Application.OnTime when, "Rosetta"
    Application.OnTime when, "Code"
End Sub


Imports System.Threading

Module Module1
   Public rnd As New Random

   Sub Main()
       Dim t1 As New Thread(AddressOf Foo)
       Dim t2 As New Thread(AddressOf Foo)
       Dim t3 As New Thread(AddressOf Foo)

       t1.Start("Enjoy")
       t2.Start("Rosetta")
       t3.Start("Code")

       t1.Join()
       t2.Join()
       t3.Join()

   End Sub

   Sub Foo(ByVal state As Object)
       Thread.Sleep(rnd.Next(1000))
       Console.WriteLine(state)
   End Sub

End Module


import time
import rand
import rand.pcg32
import rand.seed

fn main() {
    words := ['Enjoy', 'Rosetta', 'Code']
    seed_u64 := u64(time.now().unix_time_milli())
    q := chan string{}
    for i, w in words {
        go fn (q chan string, w string, seed_u64 u64) {
            mut rng := pcg32.PCG32RNG{}
            time_seed := seed.time_seed_array(2)
            seed_arr := [u32(seed_u64), u32(seed_u64 >> 32), time_seed[0], time_seed[1]]
            rng.seed(seed_arr)
            time.sleep(time.Duration(rng.i64n(1_000_000_000)))
            q <- w
        }(q, w, seed_u64 + u64(i))
    }
    for _ in 0 .. words.len {
        println(<-q)
    }
}


import std.stdio, std.complex, std.math, std.range, std.algorithm,
       std.numeric;

T[][] conjugateTranspose(T)(in T[][] m) pure nothrow @safe {
    auto r = new typeof(return)(m[0].length, m.length);
    foreach (immutable nr, const row; m)
        foreach (immutable nc, immutable c; row)
            r[nc][nr] = c.conj;
    return r;
}

bool isRectangular(T)(in T[][] M) pure nothrow @safe @nogc {
    return M.all!(row => row.length == M[0].length);
}

T[][] matMul(T)(in T[][] A, in T[][] B) pure nothrow /*@safe*/
in {
    assert(A.isRectangular && B.isRectangular &&
           !A.empty && !B.empty && A[0].length == B.length);
} body {
    auto result = new T[][](A.length, B[0].length);
    auto aux = new T[B.length];

    foreach (immutable j; 0 .. B[0].length) {
        foreach (immutable k, const row; B)
            aux[k] = row[j];
        foreach (immutable i, const ai; A)
            result[i][j] = dotProduct(ai, aux);
    }

    return result;
}

/// Check any number of complex matrices for equality within
/// some bits of mantissa.
bool areEqual(T)(in Complex!T[][][] matrices, in size_t nBits=20)
pure nothrow /*@safe*/ {
    static bool allSame(U)(in U[] v) pure nothrow @nogc {
        return v[1 .. $].all!(c => c == v[0]);
    }

    bool allNearSame(in Complex!T[] v) pure nothrow @nogc {
        auto v0 = v[0].Complex!T; // To avoid another cast.
        return v[1 .. $].all!(c => feqrel(v0.re, c.re) >= nBits &&
                                   feqrel(v0.im, c.im) >= nBits);
    }

    immutable x = matrices.map!(m => m.length).array;
    if (!allSame(x))
        return false;
    immutable y = matrices.map!(m => m[0].length).array;
    if (!allSame(y))
        return false;
    foreach (immutable s; 0 .. x[0])
        foreach (immutable t; 0 .. y[0])
            if (!allNearSame(matrices.map!(m => m[s][t]).array))
                return false;
    return true;
}

bool isHermitian(T)(in Complex!T[][] m, in Complex!T[][] ct)
pure nothrow /*@safe*/ {
    return [m, ct].areEqual;
}

bool isNormal(T)(in Complex!T[][] m, in Complex!T[][] ct)
pure nothrow /*@safe*/ {
    return [matMul(m, ct), matMul(ct, m)].areEqual;
}

auto complexIdentitymatrix(in size_t side) pure nothrow /*@safe*/ {
    return side.iota.map!(r => side.iota.map!(c => complex(r == c)).array).array;
}

bool isUnitary(T)(in Complex!T[][] m, in Complex!T[][] ct)
pure nothrow /*@safe*/ {
    immutable mct = matMul(m, ct);
    immutable ident = mct.length.complexIdentitymatrix;
    return [mct, matMul(ct, m), ident].areEqual;
}

void main() /*@safe*/ {
    alias C = complex;
    immutable x = 2 ^^ 0.5 / 2;

    immutable data = [[[C(3.0,  0.0), C(2.0, 1.0)],
                       [C(2.0, -1.0), C(1.0, 0.0)]],

                      [[C(1.0, 0.0), C(1.0, 0.0), C(0.0, 0.0)],
                       [C(0.0, 0.0), C(1.0, 0.0), C(1.0, 0.0)],
                       [C(1.0, 0.0), C(0.0, 0.0), C(1.0, 0.0)]],

                      [[C(x,    0.0), C(x,   0.0), C(0.0, 0.0)],
                       [C(0.0, -x),   C(0.0, x),   C(0.0, 0.0)],
                       [C(0.0,  0.0), C(0.0, 0.0), C(0.0, 1.0)]]];

    foreach (immutable mat; data) {
        enum mFormat = "[%([%(%1.3f, %)],\n %)]]";
        writefln("Matrix:\n" ~ mFormat, mat);
        immutable ct = conjugateTranspose(mat);
        "Its conjugate transpose:".writeln;
        writefln(mFormat, ct);
        writefln("Hermitian? %s.", isHermitian(mat, ct));
        writefln("Normal?    %s.", isNormal(mat, ct));
        writefln("Unitary?   %s.\n", isUnitary(mat, ct));
    }
}


import "random" for Random

var words = ["Enjoy", "Rosetta", "Code"]
var rand = Random.new()
for (h in 1..3) {
    var fibers = List.filled(3, null)
    for (i in 0..2) fibers[i] = Fiber.new { System.print(words[i]) }
    var called = List.filled(3, false)
    var j = 0
    while (j < 3) {
        var k = rand.int(3)
        if (!called[k]) {
            fibers[k].call()
            called[k] = true
            j = j + 1
        }
    }
    System.print()
}


int Key, Process;
[Key:= SharedMem(4);    \allocate 4 bytes of memory common to all processes
Process:= Fork(2);      \start 2 child processes
case Process of
  0:  [Lock(Key);  Text(0, "Enjoy");    CrLf(0);  Unlock(Key)]; \parent process
  1:  [Lock(Key);  Text(0, "Rosetta");  CrLf(0);  Unlock(Key)]; \child process
  2:  [Lock(Key);  Text(0, "Code");     CrLf(0);  Unlock(Key)]  \child process
other [Lock(Key);  Text(0, "Error");    CrLf(0);  Unlock(Key)];
Join(Process);          \wait for all child processes to finish
]


// Conjugate transpose. Nigel Galloway: January 10th., 2022
let fN g=let g=g|>List.map(List.map(fun(n,g)->System.Numerics.Complex(n,g)))|>MathNet.Numerics.LinearAlgebra.MatrixExtensions.matrix in (g,g.ConjugateTranspose())
let fG n g=(MathNet.Numerics.LinearAlgebra.Matrix.inverse n-g)|>MathNet.Numerics.LinearAlgebra.Matrix.forall(fun(n:System.Numerics.Complex)->abs n.Real<1e-14&&abs n.Imaginary<1e-14)
let test=[fN [[(3.0,0.0);(2.0,1.0)];[(2.0,-1.0);(1.0,0.0)]];fN [[(1.0,0.0);(1.0,0.0);(0.0,0.0)];[(0.0,0.0);(1.0,0.0);(1.0,0.0)];[(1.0,0.0);(0.0,0.0);(1.0,0.0)]];fN [[(1.0/sqrt 2.0,0.0);(1.0/sqrt 2.0,0.0);(0.0,0.0)];[(0.0,1.0/sqrt 2.0);(0.0,-1.0/sqrt 2.0);(0.0,0.0)];[(0.0,0.0);(0.0,0.0);(0.0,1.0)]]]
test|>List.iter(fun(n,g)->printfn $"Matrix\n------\n%A{n}\nConjugate transposed\n--------------------\n%A{g}\nIs hermitian: %A{n.IsHermitian()}\nIs normal:    %A{n*g=g*n}\nIs unitary:   %A{fG n g}\n")


fcn{println("Enjoy")}.launch();  // thread
fcn{println("Rosetta")}.strand();  // co-op thread
fcn{println("Code")}.future();  // another thread type


USING: kernel math.functions math.matrices sequences ;
IN: rosetta.hermitian

: conj-t ( matrix -- conjugate-transpose )
    flip [ [ conjugate ] map ] map ;

: hermitian-matrix? ( matrix -- ? )
    dup conj-t = ;

: normal-matrix? ( matrix -- ? )
    dup conj-t [ m. ] [ swap m. ] 2bi = ;

: unitary-matrix? ( matrix -- ? )
    [ dup conj-t m. ] [ length identity-matrix ] bi = ;


gfortran -std=f2008 -Wall -fopenmp -ffree-form -fall-intrinsics -fimplicit-none f.f08 -o f


'complex type and operators for it
type complex
    real as double
    imag as double
end type

operator + ( a as complex, b as complex ) as complex
    dim as complex r
    r.real = a.real + b.real
    r.imag = a.imag + b.imag
    return r
end operator

operator * ( a as complex, b as complex ) as complex
    dim as complex r
    r.real = a.real*b.real - a.imag*b.imag
    r.imag = a.real*b.imag + b.real*a.imag
    return r
end operator

operator = ( a as complex, b as complex ) as boolean
    if not a.real = b.real then return false
    if not a.imag = b.imag then return false
    return true
end operator

function complex_conjugate( a as complex ) as complex
    dim as complex r
    r.real =  a.real
    r.imag = -a.imag
    return r
end function

'matrix type and operations for it
'reuses code from the matrix multiplication task
type Matrix
    dim as complex m( any , any )
    declare constructor ( )
    declare constructor ( byval x as uinteger )
end type

constructor Matrix ( )
end constructor

constructor Matrix ( byval x as uinteger )
    redim this.m( x - 1 , x - 1 )
end constructor

operator * ( byref a as Matrix , byref b as Matrix ) as Matrix
    dim as Matrix ret
    dim as uinteger i, j, k
    redim ret.m( ubound( a.m , 1 ) , ubound( a.m , 1 ) )
    for i = 0 to ubound( a.m , 1 )
        for j = 0 to ubound( b.m , 2 )
            for k = 0 to ubound( b.m , 1 )
                ret.m( i , j ) += a.m( i , k ) * b.m( k , j )
            next k
        next j
    next i
    return ret
end operator

function conjugate_transpose( byref a as Matrix ) as Matrix
    dim as Matrix ret
    dim as uinteger i, j
    redim ret.m( ubound( a.m , 1 ) , ubound( a.m , 1 ) )
    for i = 0 to ubound( a.m , 1 )
        for j = 0 to ubound( a.m , 2 )
            ret.m( i, j ) = complex_conjugate(a.m( j, i ))
        next j
    next i
    return ret
end function

'tests if matrices are unitary, hermitian, or normal

operator = (byref a as Matrix, byref b as matrix) as boolean
    dim as integer i, j
    if ubound(a.m, 1) <> ubound(b.m, 1) then return false
    for i = 0 to ubound( a.m , 1 )
        for j = 0 to ubound( a.m , 2 )
            if not a.m(i,j)=b.m(i,j) then return false
        next j
    next i
    return true
end operator

function is_identity( byref a as Matrix ) as boolean
    dim as integer i, j
    for i = 0 to ubound( a.m , 1 )
        for j = 0 to ubound( a.m , 2 )
            if i  = j and ( not a.m(i,j).real = 1.0 or not a.m(i,j).imag = 0.0 ) then return false
            if i <> j and ( not a.m(i,j).real = 0.0 or not a.m(i,j).imag = 0.0 ) then return false
        next j
    next i
    return true
end function

function is_hermitian( byref a as Matrix ) as boolean
    if a = conjugate_transpose(a) then return true
    return false
end function

function is_normal( byref a as Matrix ) as boolean
    dim as Matrix aa = conjugate_transpose(a)
    if a*aa = aa*a then return true else return false
end function

function is_unitary( byref a as Matrix ) as boolean
    dim as Matrix aa = conjugate_transpose(a)
    if not is_identity( a*aa ) or not is_identity( aa*a ) then return false
    return true
end function

'''now some example matrices
dim as Matrix A = Matrix(2)   'an identity matrix
A.m(0,0).real = 1.0 : A.m(0,0).imag = 0.0 : A.m(0,1).real = 0.0 : A.m(0,1).imag = 0.0
A.m(1,0).real = 0.0 : A.m(1,0).imag = 0.0 : A.m(1,1).real = 1.0 : A.m(1,1).imag = 0.0

dim as Matrix B = Matrix(2)   'a hermitian matrix
B.m(0,0).real = 1.0 : B.m(0,0).imag = 0.0 : B.m(0,1).real = 1.0 : B.m(0,1).imag = -1.0
B.m(1,0).real = 1.0 : B.m(1,0).imag = 1.0 : B.m(1,1).real = 1.0 : B.m(1,1).imag = 0.0

dim as Matrix C = Matrix(2)   'a random matrix
C.m(0,0).real = rnd : C.m(0,0).imag = rnd : C.m(0,1).real = rnd : C.m(0,1).imag = rnd
C.m(1,0).real = rnd : C.m(1,0).imag = rnd : C.m(1,1).real = rnd : C.m(1,1).imag = rnd

print is_hermitian(A), is_normal(A), is_unitary(A)
print is_hermitian(B), is_normal(B), is_unitary(B)
print is_hermitian(C), is_normal(C), is_unitary(C)


package main

import (
    "fmt"
    "math"
    "math/cmplx"
)

// a type to represent matrices
type matrix struct {
    ele  []complex128
    cols int
}

// conjugate transpose, implemented here as a method on the matrix type.
func (m *matrix) conjTranspose() *matrix {
    r := &matrix{make([]complex128, len(m.ele)), len(m.ele) / m.cols}
    rx := 0
    for _, e := range m.ele {
        r.ele[rx] = cmplx.Conj(e)
        rx += r.cols
        if rx >= len(r.ele) {
            rx -= len(r.ele) - 1
        }
    }
    return r
}

// program to demonstrate capabilites on example matricies
func main() {
    show("h", matrixFromRows([][]complex128{
        {3, 2 + 1i},
        {2 - 1i, 1}}))

    show("n", matrixFromRows([][]complex128{
        {1, 1, 0},
        {0, 1, 1},
        {1, 0, 1}}))

    show("u", matrixFromRows([][]complex128{
        {math.Sqrt2 / 2, math.Sqrt2 / 2, 0},
        {math.Sqrt2 / -2i, math.Sqrt2 / 2i, 0},
        {0, 0, 1i}}))
}

func show(name string, m *matrix) {
    m.print(name)
    ct := m.conjTranspose()
    ct.print(name + "_ct")

    fmt.Println("Hermitian:", m.equal(ct, 1e-14))

    mct := m.mult(ct)
    ctm := ct.mult(m)
    fmt.Println("Normal:", mct.equal(ctm, 1e-14))

    i := eye(m.cols)
    fmt.Println("Unitary:", mct.equal(i, 1e-14) && ctm.equal(i, 1e-14))
}

// two constructors
func matrixFromRows(rows [][]complex128) *matrix {
    m := &matrix{make([]complex128, len(rows)*len(rows[0])), len(rows[0])}
    for rx, row := range rows {
        copy(m.ele[rx*m.cols:(rx+1)*m.cols], row)
    }
    return m
}

func eye(n int) *matrix {
    r := &matrix{make([]complex128, n*n), n}
    n++
    for x := 0; x < len(r.ele); x += n {
        r.ele[x] = 1
    }
    return r
}

// print method outputs matrix to stdout
func (m *matrix) print(heading string) {
    fmt.Print("\n", heading, "\n")
    for e := 0; e < len(m.ele); e += m.cols {
        fmt.Printf("%6.3f ", m.ele[e:e+m.cols])
        fmt.Println()
    }
}

// equal method uses ε to allow for floating point error.
func (a *matrix) equal(b *matrix, ε float64) bool {
    for x, aEle := range a.ele {
        if math.Abs(real(aEle)-real(b.ele[x])) > math.Abs(real(aEle))*ε ||
            math.Abs(imag(aEle)-imag(b.ele[x])) > math.Abs(imag(aEle))*ε {
            return false
        }
    }
    return true
}

// mult method taken from matrix multiply task
func (m1 *matrix) mult(m2 *matrix) (m3 *matrix) {
    m3 = &matrix{make([]complex128, (len(m1.ele)/m1.cols)*m2.cols), m2.cols}
    for m1c0, m3x := 0, 0; m1c0 < len(m1.ele); m1c0 += m1.cols {
        for m2r0 := 0; m2r0 < m2.cols; m2r0++ {
            for m1x, m2x := m1c0, m2r0; m2x < len(m2.ele); m2x += m2.cols {
                m3.ele[m3x] += m1.ele[m1x] * m2.ele[m2x]
                m1x++
            }
            m3x++
        }
    }
    return m3
}


import Data.Complex (Complex(..), conjugate)
import Data.List (transpose)

type Matrix a = [[a]]

main :: IO ()
main =
  mapM_
    (\a -> do
       putStrLn "\nMatrix:"
       mapM_ print a
       putStrLn "Conjugate Transpose:"
       mapM_ print (conjTranspose a)
       putStrLn $ "Hermitian? " ++ show (isHermitianMatrix a)
       putStrLn $ "Normal? " ++ show (isNormalMatrix a)
       putStrLn $ "Unitary? " ++ show (isUnitaryMatrix a))
    ([ [[3, 2 :+ 1], [2 :+ (-1), 1]]
     , [[1, 1, 0], [0, 1, 1], [1, 0, 1]]
     , [ [sqrt 2 / 2 :+ 0, sqrt 2 / 2 :+ 0, 0]
       , [0 :+ sqrt 2 / 2, 0 :+ (-sqrt 2 / 2), 0]
       , [0, 0, 0 :+ 1]
       ]
     ] :: [Matrix (Complex Double)])

isHermitianMatrix, isNormalMatrix, isUnitaryMatrix
  :: RealFloat a
  => Matrix (Complex a) -> Bool
isHermitianMatrix = mTest id conjTranspose

isNormalMatrix = mTest mmct (mmul =<< conjTranspose)

isUnitaryMatrix = mTest mmct (ident . length)

mTest
  :: RealFloat a
  => (a2 -> Matrix (Complex a)) -> (a2 -> Matrix (Complex a)) -> a2 -> Bool
mTest f g = (approxEqualMatrix . f) <*> g

mmct
  :: RealFloat a
  => Matrix (Complex a) -> Matrix (Complex a)
mmct = mmul <*> conjTranspose

approxEqualMatrix
  :: (Fractional a, Ord a)
  => Matrix (Complex a) -> Matrix (Complex a) -> Bool
approxEqualMatrix a b =
  length a == length b &&
  length (head a) == length (head b) &&
  and (zipWith approxEqualComplex (concat a) (concat b))
  where
    approxEqualComplex (rx :+ ix) (ry :+ iy) =
      abs (rx - ry) < eps && abs (ix - iy) < eps
    eps = 1e-14

mmul
  :: Num a
  => Matrix a -> Matrix a -> Matrix a
mmul a b =
  [ [ sum (zipWith (*) row column)
    | column <- transpose b ]
  | row <- a ]

ident
  :: Num a
  => Int -> Matrix a
ident size =
  [ [ fromIntegral $ div a b * div b a
    | a <- [1 .. size] ]
  | b <- [1 .. size] ]

conjTranspose
  :: Num a
  => Matrix (Complex a) -> Matrix (Complex a)
conjTranspose = map (map conjugate) . transpose


ct =: [email protected]|:                      NB.  Conjugate transpose (ct A is A_ct)


# transpose/0 expects its input to be a rectangular matrix
# (an array of equal-length arrays):
def transpose:
  if (.[0] | length) == 0 then []
  else [map(.[0])] + (map(.[1:]) | transpose)
  end ;


// version 1.1.3

typealias C = Complex
typealias Vector = Array<C>
typealias Matrix = Array<Vector>

class Complex(val real: Double, val imag: Double) {

    operator fun plus(other: Complex) =
        Complex(this.real + other.real, this.imag + other.imag)

    operator fun times(other: Complex) =
        Complex(this.real * other.real - this.imag * other.imag,
                this.real * other.imag + this.imag * other.real)

    fun conj() = Complex(this.real, -this.imag)

    /* tolerable equality allowing for rounding of Doubles */
    infix fun teq(other: Complex) =
        Math.abs(this.real - other.real) <= 1e-14 &&
        Math.abs(this.imag - other.imag) <= 1e-14

    override fun toString() = "${"%.3f".format(real)} " + when {
        imag > 0.0   -> "+ ${"%.3f".format(imag)}i"
        imag == 0.0  -> "+ 0.000i"
        else         -> "- ${"%.3f".format(-imag)}i"
    }
}

fun Matrix.conjTranspose(): Matrix {
    val rows = this.size
    val cols = this[0].size
    return Matrix(cols) { i -> Vector(rows) { j -> this[j][i].conj() } }
}

operator fun Matrix.times(other: Matrix): Matrix {
    val rows1 = this.size
    val cols1 = this[0].size
    val rows2 = other.size
    val cols2 = other[0].size
    require(cols1 == rows2)
    val result = Matrix(rows1) { Vector(cols2) { C(0.0, 0.0) } }
    for (i in 0 until rows1) {
        for (j in 0 until cols2) {
            for (k in 0 until rows2) {
                result[i][j] += this[i][k] * other[k][j]
            }
        }
    }
    return result
}

/* tolerable matrix equality using the same concept as for complex numbers */
infix fun Matrix.teq(other: Matrix): Boolean {
    if (this.size != other.size || this[0].size != other[0].size) return false
    for (i in 0 until this.size) {
        for (j in 0 until this[0].size) if (!(this[i][j] teq other[i][j])) return false
    }
    return true
}

fun Matrix.isHermitian() = this teq this.conjTranspose()

fun Matrix.isNormal(): Boolean {
    val ct = this.conjTranspose()
    return (this * ct) teq (ct * this)
}

fun Matrix.isUnitary(): Boolean {
    val ct = this.conjTranspose()
    val prod = this * ct
    val ident = identityMatrix(prod.size)
    val prod2 = ct * this
    return (prod teq ident) && (prod2 teq ident)
}

fun Matrix.print() {
    val rows = this.size
    val cols = this[0].size
    for (i in 0 until rows) {
        for (j in 0 until cols) {
            print(this[i][j])
            print(if(j < cols - 1) ",  " else "\n")
        }
    }
    println()
}

fun identityMatrix(n: Int): Matrix {
    require(n >= 1)
    val ident = Matrix(n) { Vector(n) { C(0.0, 0.0) } }
    for (i in 0 until n) ident[i][i] = C(1.0, 0.0)
    return ident
}

fun main(args: Array<String>) {
    val x = Math.sqrt(2.0) / 2.0
    val matrices = arrayOf(
        arrayOf(
            arrayOf(C(3.0,  0.0), C(2.0, 1.0)),
            arrayOf(C(2.0, -1.0), C(1.0, 0.0))
        ),
        arrayOf(
            arrayOf(C(1.0, 0.0), C(1.0, 0.0), C(0.0, 0.0)),
            arrayOf(C(0.0, 0.0), C(1.0, 0.0), C(1.0, 0.0)),
            arrayOf(C(1.0, 0.0), C(0.0, 0.0), C(1.0, 0.0))
        ),
        arrayOf(
            arrayOf(C(x,   0.0), C(x,   0.0), C(0.0, 0.0)),
            arrayOf(C(0.0,  -x), C(0.0,   x), C(0.0, 0.0)),
            arrayOf(C(0.0, 0.0), C(0.0, 0.0), C(0.0, 1.0))
        )
    )

    for (m in matrices) {
        println("Matrix:")
        m.print()
        val mct = m.conjTranspose()
        println("Conjugate transpose:")
        mct.print()
        println("Hermitian? ${mct.isHermitian()}")
        println("Normal?    ${mct.isNormal()}")
        println("Unitary?   ${mct.isUnitary()}\n")
    }
}


M:=<<3|2+I>,<2-I|1>>:

with(LinearAlgebra):
IsNormal:=A->EqualEntries(A^%H.A,A.A^%H):

M^%H;
HermitianTranspose(M);
type(M,'Matrix'(hermitian));
IsNormal(M);
IsUnitary(M);


NormalMatrixQ[a_List?MatrixQ] := Module[{b = [email protected]@a},a.b === b.a]
UnitaryQ[m_List?MatrixQ] := ([email protected]@m.m == [email protected]@m)

m = {{1, 2I, 3}, {3+4I, 5, I}};
m //MatrixForm
->
(1	2I	3
3+4I	5	I)

ConjugateTranspose[m] //MatrixForm
->
(1	3-4I
-2I	5
3	-I)

{[email protected]#, [email protected]#, [email protected]#}&@m
-> {False, False, False}


import complex, strformat

type Matrix[M, N: static Positive] = array[M, array[N, Complex[float]]]

const Eps = 1e-10   # Tolerance used for float comparisons.

####################################################################################################
# Templates.

template `[]`(m: Matrix; i, j: Natural): Complex[float] =
  ## Allow to get value of an element using m[i, j] syntax.
  m[i][j]

template `[]=`(m: var Matrix; i, j: Natural; val: Complex[float]) =
  ## Allow to set value of an element using m[i, j] syntax.
  m[i][j] = val

####################################################################################################
# General operations.

func `$`(m: Matrix): string =
  ## Return the string representation of a matrix using one line per row.

  for i, row in m:
    result.add(if i == 0: '[' else: ' ')
    for j, val in row:
      if j != 0: result.add(' ')
      result.add(&"({val.re:7.4f}, {val.im:7.4f})")
    result.add(if i == m.high: ']' else: '\n')

#---------------------------------------------------------------------------------------------------

func conjugateTransposed[M, N: static int](m: Matrix[M, N]): Matrix[N, M] =
  ## Return the conjugate transpose of a matrix.

  for i in 0..<m.M:
    for j in 0..<m.N:
      result[j, i] = m[i, j].conjugate()

#---------------------------------------------------------------------------------------------------

func `*`[M, K, N: static int](m1: Matrix[M, K]; m2: Matrix[K, N]): Matrix[M, N] =
  # Compute the product of two matrices.

  for i in 0..<M:
    for j in 0..<N:
      for k in 0..<K:
        result[i, j] = result[i, j] + m1[i, k] * m2[k, j]

####################################################################################################
# Properties.

func isHermitian(m: Matrix): bool =
  ## Check if a matrix is hermitian.

  when m.M != m.N:
    {.error: "hermitian test only allowed for square matrices".}
  else:
    for i in 0..<m.M:
      for j in i..<m.N:
        if m[i, j] != m[j, i].conjugate:
          return false
    result = true

#---------------------------------------------------------------------------------------------------

func isNormal(m: Matrix): bool =
  ## Check if a matrix is normal.

  when m.M != m.N:
    {.error: "normal test only allowed for square matrices".}
  else:
    let h = m.conjugateTransposed
    result = m * h == h * m

#---------------------------------------------------------------------------------------------------

func isIdentity(m: Matrix): bool =
  ## Check if a matrix is the identity matrix.

  when m.M != m.N:
    {.error: "identity test only allowed for square matrices".}
  else:
    for i in 0..<m.M:
      for j in 0..<m.N:
        if i == j:
          if abs(m[i, j] - 1.0) > Eps:
            return false
        else:
          if abs(m[i, j]) > Eps:
            return false
    result = true

#---------------------------------------------------------------------------------------------------

func isUnitary(m: Matrix): bool =
  ## Check if a matrix is unitary.

  when m.M != m.N:
    {.error: "unitary test only allowed for square matrices".}
  else:
    let h = m.conjugateTransposed
    result = (m * h).isIdentity and (h * m).isIdentity

#———————————————————————————————————————————————————————————————————————————————————————————————————

when isMainModule:

  import math

  proc test(m: Matrix) =
    echo "\n"
    echo "Matrix"
    echo "------"
    echo m
    echo ""
    echo "Conjugate transposed"
    echo "--------------------"
    echo m.conjugateTransposed

    when m.M == m.N:
      # Only for squares matrices.
      echo ""
      echo "Hermitian: ", m.isHermitian
      echo "Normal: ", m.isNormal
      echo "Unitary: ", m.isUnitary

  #-------------------------------------------------------------------------------------------------

  # Non square matrix.
  const M1: Matrix[2, 3] = [[1.0 + im 2.0, 3.0 + im 0.0, 2.0 + im 5.0],
                            [3.0 - im 1.0, 2.0 + im 0.0, 0.0 + im 3.0]]

    # Square matrices.
  const M2: Matrix[2, 2] = [[3.0 + im 0.0, 2.0 + im 1.0],
                            [2.0 - im 1.0, 1.0 + im 0.0]]

  const M3: Matrix[3, 3] = [[1.0 + im 0.0, 1.0 + im 0.0, 0.0 + im 0.0],
                            [0.0 + im 0.0, 1.0 + im 0.0, 1.0 + im 0.0],
                            [1.0 + im 0.0, 0.0 + im 0.0, 1.0 + im 0.0]]

  const SR2 = 1 / sqrt(2.0)
  const M4: Matrix[3, 3] = [[SR2 + im 0.0, SR2 + im 0.0, 0.0 + im 0.0],
                            [0.0 + im SR2, 0.0 - im SR2, 0.0 + im 0.0],
                            [0.0 + im 0.0, 0.0 + im 0.0, 0.0 + im 1.0]]

  test(M1)
  test(M2)
  test(M3)
  test(M4)


conjtranspose(M)=conj(M~)
isHermitian(M)=M==conj(M~)
isnormal(M)=my(H=conj(M~));H*M==M*H
isunitary(M)=M*conj(M~)==1


use strict;
use English;
use Math::Complex;
use Math::MatrixReal;

my @examples = (example1(), example2(), example3());
foreach my $m (@examples) {
    print "Starting matrix:\n", cmat_as_string($m), "\n";
    my $m_ct = conjugate_transpose($m);
    print "Its conjugate transpose:\n", cmat_as_string($m_ct), "\n";
    print "Is Hermitian? ", (cmats_are_equal($m, $m_ct) ? 'TRUE' : 'FALSE'), "\n";
    my $product = $m_ct * $m;
    print "Is normal? ", (cmats_are_equal($product, $m * $m_ct) ? 'TRUE' : 'FALSE'), "\n";
    my $I = identity(($m->dim())[0]);
    print "Is unitary? ", (cmats_are_equal($product, $I) ? 'TRUE' : 'FALSE'), "\n";
    print "\n";
}
exit 0;

sub cmats_are_equal {
    my ($m1, $m2) = @ARG;
    my $max_norm = 1.0e-7;
    return abs($m1 - $m2) < $max_norm;  # Math::MatrixReal overloads abs().
}

# Note that Math::Complex and Math::MatrixReal both overload '~', for
# complex conjugates and matrix transpositions respectively.
sub conjugate_transpose {
    my $m_T = ~ shift;
    my $result = $m_T->each(sub {~ $ARG[0]});
    return $result;
}

sub cmat_as_string {
    my $m = shift;
    my $n_rows = ($m->dim())[0];
    my @row_strings = map { q{[} . join(q{, }, $m->row($ARG)->as_list) . q{]} }
                          (1 .. $n_rows);
    return join("\n", @row_strings);
}

sub identity {
    my $N = shift;
    my $m = new Math::MatrixReal($N, $N);
    $m->one();
    return $m;
}

sub example1 {
    my $m = new Math::MatrixReal(2, 2);
    $m->assign(1, 1, cplx(3, 0));
    $m->assign(1, 2, cplx(2, 1));
    $m->assign(2, 1, cplx(2, -1));
    $m->assign(2, 2, cplx(1, 0));
    return $m;
}

sub example2 {
    my $m = new Math::MatrixReal(3, 3);
    $m->assign(1, 1, cplx(1, 0));
    $m->assign(1, 2, cplx(1, 0));
    $m->assign(1, 3, cplx(0, 0));
    $m->assign(2, 1, cplx(0, 0));
    $m->assign(2, 2, cplx(1, 0));
    $m->assign(2, 3, cplx(1, 0));
    $m->assign(3, 1, cplx(1, 0));
    $m->assign(3, 2, cplx(0, 0));
    $m->assign(3, 3, cplx(1, 0));
    return $m;
}

sub example3 {
    my $m = new Math::MatrixReal(3, 3);
    $m->assign(1, 1, cplx(0.70710677, 0));
    $m->assign(1, 2, cplx(0.70710677, 0));
    $m->assign(1, 3, cplx(0, 0));
    $m->assign(2, 1, cplx(0, -0.70710677));
    $m->assign(2, 2, cplx(0, 0.70710677));
    $m->assign(2, 3, cplx(0, 0));
    $m->assign(3, 1, cplx(0, 0));
    $m->assign(3, 2, cplx(0, 0));
    $m->assign(3, 3, cplx(0, 1));
    return $m;
}