use std::io::{self, Write};
use std::fs::{DirBuilder, File};
use std::path::Path;
use std::{process,fmt};

const FILE_NAME: &'static str = "output.txt";
const DIR_NAME : &'static str = "docs";

fn main() {
    create(".").and(create("/"))
               .unwrap_or_else(|e| error_handler(e,1));
}

fn create<P>(root: P) -> io::Result<File>
    where P: AsRef<Path>
{
    let f_path = root.as_ref().join(FILE_NAME);
    let d_path = root.as_ref().join(DIR_NAME);
    DirBuilder::new().create(d_path).and(File::create(f_path))
}

fn error_handler<E: fmt::Display>(error: E, code: i32) -> ! {
    let _ = writeln!(&mut io::stderr(), "Error: {}", error);
    process::exit(code)
}


import java.io.File

object CreateFile extends App {
  try { new File("output.txt").createNewFile() }
  catch { case e: Exception => println(s"Exception caught: $e with creating output.txt") }
  try { new File(s"${File.separator}output.txt").createNewFile() }
  catch { case e: Exception => println(s"Exception caught: $e with creating ${File.separator}output.txt") }
  try { new File("docs").mkdir() }
  catch { case e: Exception => println(s"Exception caught: $e with creating directory docs") }
  try { new File(s"${File.separator}docs").mkdir() }
  catch { case e: Exception => println(s"Exception caught: $e with creating directory ${File.separator}docs") }
}


(open-output-file "output.txt")
(open-output-file "/output.txt")


$ include "seed7_05.s7i";
  include "osfiles.s7i";

const proc: main is func
  local
    var file: aFile is STD_NULL;
  begin
    aFile := open("output.txt", "w");
    close(aFile);
    mkdir("docs");
    aFile := open("/output.txt", "w");
    close(aFile);
    mkdir("/docs");
  end func;


set the folder to "~/Desktop"
put "" into file "docs/output.txt"
set the folder to "/"
put empty into file "/docs/output.txt"


# Here
%f'output.txt' -> create;
%d'docs'       -> create;

# Root dir
Dir.root + %f'output.txt' -> create;
Dir.root + %d'docs'       -> create;


(File newNamed: 'output.txt') touch.
(Directory current / 'output.txt') touch.


(FileDirectory on: 'c:\') newFileNamed: 'output.txt'; createDirectory: 'docs'.


        output(.file,1,'output.txt');  endfile(1)  ;* Macro Spitbol
*       output(.file,1,,'output.txt'); endfile(1)  ;* CSnobol
        host(1,'mkdir docs')

        output(.file,1,'/output.txt');  endfile(1) ;* Macro Spitbol
*       output(.file,1,,'/output.txt'); endfile(1) ;* CSnobol
        host(1,'mkdir /docs')
end


BEGIN
  DECLARE UTL_FILE_HANDLER UTL_FILE.FILE_TYPE;
  DECLARE DIR_ALIAS_CURRENT VARCHAR(128);
  DECLARE DIR_ALIAS_ROOT VARCHAR(128);
  DECLARE DIRECTORY VARCHAR(1024);
  DECLARE FILENAME VARCHAR(255);

  SET DIR_ALIAS_CURRENT = 'outputFileCurrent';
  SET DIRECTORY = '/home/db2inst1/doc';
  SET FILENAME = 'output.txt';

  CALL UTL_DIR.CREATE_OR_REPLACE_DIRECTORY(DIR_ALIAS_CURRENT, DIRECTORY);
  SET UTL_FILE_HANDLER = UTL_FILE.FOPEN(DIR_ALIAS_CURRENT, FILENAME, 'a');
  CALL UTL_FILE.FFLUSH(UTL_FILE_HANDLER);
  CALL UTL_FILE.FCLOSE(UTL_FILE_HANDLER);

  SET DIR_ALIAS_ROOT = 'outputFileRoot';
  SET DIRECTORY = '/doc';

  CALL UTL_DIR.CREATE_OR_REPLACE_DIRECTORY(DIR_ALIAS_ROOT, DIRECTORY);
  SET UTL_FILE_HANDLER = UTL_FILE.FOPEN(DIR_ALIAS_ROOT, FILENAME, 'a');
  CALL UTL_FILE.FFLUSH(UTL_FILE_HANDLER);
  CALL UTL_FILE.FCLOSE(UTL_FILE_HANDLER);
END @


/*
*Use '/' for *nix. Use whatever your root directory is on Windows.
*Must be run as admin.
*/
.shell mkdir "docs";
.shell mkdir "/docs";
.output output.txt
.output /output.txt


let val out = TextIO.openOut "output.txt" in
  TextIO.closeOut out
end;

OS.FileSys.mkDir "docs";


file open f using output.txt, write replace
file close f
mkdir docs

file open f using \output.txt, write replace
file close f
mkdir \docs


close [open output.txt w]
close [open [file nativename /output.txt] w]

file mkdir docs
file mkdir [file nativename /docs]


needs shell
" output.txt" "W" file.open file.close
" /output.txt" "W" file.open file.close

( Create the directories with permissions set to 777)
" docs" &777 mkdir
" /docs" &777 mkdir


$$ MODE TUSCRIPT
- create file
ERROR/STOP CREATE ("output.txt",FDF-o,-std-)
- create directory
ERROR/STOP CREATE ("docs",project,-std-)


touch output.txt /output.txt   # create both output.txt and /output.txt
mkdir /docs
mkdir docs    # create both /docs and docs


decl file f
f.create "output.txt"
f.createdir "docs"

# in the root directory
f.create "/output.txt"
f.createdir "/docs"


Public Sub create_file()
    Dim FileNumber As Integer
    FileNumber = FreeFile
    MkDir "docs"
    Open "docs\output.txt" For Output As #FreeFile
    Close #FreeFile
    MkDir "C:\docs"
    Open "C:\docs\output.txt" For Output As #FreeFile
    Close #FreeFile
End Sub


Set objFSO = CreateObject("Scripting.FileSystemObject")

'current directory
objFSO.CreateFolder(".\docs")
objFSO.CreateTextFile(".\docs\output.txt")

'root directory
objFSO.CreateFolder("\docs")
objFSO.CreateTextFile("\docs\output.txt")


// In current directory
File_Open("input.txt") Ins_Char(' ') Del_Char(-1) Buf_Close()
File_Mkdir("docs")

// In the root directory
File_Open("/input.txt") Ins_Char(' ') Del_Char(-1) Buf_Close()
File_Mkdir("/docs")


 'Current Directory
IO.Directory.CreateDirectory("docs")
IO.File.Create("output.txt").Close()

 'Root
IO.Directory.CreateDirectory("\docs")
IO.File.Create("\output.txt").Close()

 'Root, platform independent
IO.Directory.CreateDirectory(IO.Path.DirectorySeparatorChar & "docs")
IO.File.Create(IO.Path.DirectorySeparatorChar & "output.txt").Close()


import "io" for File

// file is closed automatically after creation
File.create("output.txt") {}

// check size
System.print("%(File.size("output.txt")) bytes")


; syscall numbers for readability. :]

%define sys_mkdir 39
%define sys_creat 8

section .data
	fName       db 'doc/output.txt',0
	rfName      db '/output.txt',0
	dName       db 'doc',0

	err_msg     db "Something went wrong! :[",0xa
	err_len     equ $-err_msg

section .text
global _start

_start:

nop
	mov ebx, dName              ; Directory name
	mov eax, sys_mkdir          ; Specify sys_mkdir call
	mov ecx, 0750o              ; permission (rwxr-x---)
	int 0x80                    ; Make kernel call

	mov ebx, fName              ; File name
	mov eax, sys_creat          ; Specify sys_creat call
	mov ecx, 0640o              ; permission (rw-r-----)
	int 0x80                    ; Make kernel call
	test eax, eax               ; eax AND eax
	js _ragequit                ; If EAX is less than zero
                                    ; THEN Display Message Error

	mov ebx, rfName             ; File name Root
	mov eax, sys_creat          ; Specify sys_creat call
	mov ecx, 0777o              ; permission (rwxrwxrwx)
	int 0x80                    ; Make kernel call
	cmp eax, 0
	jle _exit                   ; IF EAX is less or equal than zero
                                    ; THEN jump to EXIT
                                    ; ELSE Display Message Error

	_ragequit:
		mov edx, err_len        ; Pass offset of the message error
		mov ecx, err_msg        ; Pass the length of the message error
		mov eax, 4              ; Specify sys_write call
		mov ebx, 2              ; Specify File Descriptor 2: Error Output
		int 0x80                ; Make kernel call

	_exit:
		push 0x1
		mov eax, 1              ; Code for Exit Syscall
		push eax
		int 0x80                ; Make kernel call
		ret


open "output.txt" for writing as #1
close #1

system("mkdir " + "f:\docs")
if open(2, "f:\docs\output.txt") then
    print "Subdirectory or file already exists"
else
    open "f:\docs\output.txt" for writing as #2
    close #2
end if


$ ls -l docs
ls: cannot access docs: No such file or directory
$ zkl
zkl: fcn createOutputTxt(dir){ dir=dir+"/docs"; File.mkdir(dir); File(dir+"/output.txt","w") }
Void
zkl: createOutputTxt(".")
File(./docs/output.txt)
zkl: createOutputTxt("/")
Stack trace for VM#1 ():
   [email protected] addr:16  args(1) reg(0)
   [email protected] addr:9  args(0) reg(0) R
   startup.__constructor addr:2271  args(0) reg(1) ER
   startup.__constructor addr:2207  args(0) reg(22)
Exception thrown: IOError(File.mkdir(//docs): Permission denied)
zkl: ^D
$ ls -l docs
total 0
-rw-r--r-- 1 craigd craigd 0 Oct 27 22:08 output.txt


F det(mm)
   V m = copy(mm)
   V result = 1.0

   L(j) 0 .< m.len
      V imax = j
      L(i) j + 1 .< m.len
         I m[i][j] > m[imax][j]
            imax = i

      I imax != j
         swap(&m[imax], &m[j])
         result = -result

      I abs(m[j][j]) < 1e-12
         R Float.infinity

      L(i) j + 1 .< m.len
         V mult = -m[i][j] / m[j][j]
         L(k) 0 .< m.len
            m[i][k] += mult * m[j][k]

   L(i) 0 .< m.len
      result *= m[i][i]
   R result

F cramerSolve(aa, detA, b, col)
   V a = copy(aa)
   L(i) 0 .< a.len
      a[i][col] = b[i]
   R det(a) / detA

V A = [[2.0, -1.0,  5.0,  1.0],
       [3.0,  2.0,  2.0, -6.0],
       [1.0,  3.0,  3.0, -1.0],
       [5.0, -2.0, -3.0,  3.0]]

V B = [-3.0, -32.0, -47.0, 49.0]

V detA = det(A)

L(i) 0 .< A.len
   print(‘#3.3’.format(cramerSolve(A, detA, B, i)))


with Ada.Text_IO;
with Ada.Numerics.Generic_Real_Arrays;

procedure Cramers_Rules is

   type Real is new Float;
   --  This is the type we want to use in the matrix and vector

   package Real_Arrays is
      new Ada.Numerics.Generic_Real_Arrays (Real);

   use Real_Arrays;

   function Solve_Cramer (M : in Real_Matrix;
                          V : in Real_Vector)
                         return Real_Vector
   is
      Denominator : Real;
      Nom_Matrix  : Real_Matrix (M'Range (1),
                                 M'Range (2));
      Numerator   : Real;
      Result      : Real_Vector (M'Range (1));
   begin
      if
        M'Length (2) /= V'Length or
        M'Length (1) /= M'Length (2)
      then
         raise Constraint_Error with "Dimensions does not match";
      end if;

      Denominator := Determinant (M);

      for Col in V'Range loop
         Nom_Matrix := M;

         --  Substitute column
         for Row in V'Range loop
            Nom_Matrix (Row, Col) := V (Row);
         end loop;

         Numerator    := Determinant (Nom_Matrix);
         Result (Col) := Numerator / Denominator;
      end loop;

      return Result;
   end Solve_Cramer;

   procedure Put (V : Real_Vector) is
      use Ada.Text_IO;
      package Real_IO is
         new Ada.Text_IO.Float_IO (Real);
   begin
      Put ("[");
      for E of V loop
         Real_IO.Put (E, Exp => 0, Aft => 2);
         Put (" ");
      end loop;
      Put ("]");
      New_Line;
   end Put;

   M : constant Real_Matrix := ((2.0, -1.0,  5.0,  1.0),
                                (3.0,  2.0,  2.0, -6.0),
                                (1.0,  3.0,  3.0, -1.0),
                                (5.0, -2.0, -3.0,  3.0));
   V : constant Real_Vector := (-3.0, -32.0, -47.0, 49.0);
   R : constant Real_Vector := Solve_Cramer (M, V);
begin
   Put (R);
end Cramers_Rules;


# returns the solution of a.x = b via Cramer's rule                    #
#         this is for REAL arrays, could define additional operators   #
#         for INT, COMPL, etc.                                         #
PRIO CRAMER = 1;
OP   CRAMER = ( [,]REAL a, []REAL b )[]REAL:
     IF 1 UPB a /= 2 UPB a
     OR 1 LWB a /= 2 LWB a
     OR 1 UPB a /=   UPB b
     THEN
        # the array sizes and bounds do not match                       #
        print( ( "Invaid parameters to CRAMER", newline ) );
        stop
     ELIF REAL deta = DET a;
          det a = 0
     THEN
        # a is singular                                                 #
        print( ( "Singular matrix for CRAMER", newline ) );
        stop
     ELSE
        # the arrays have matching bounds                               #
        [ LWB b : UPB b ]REAL result;
        FOR col FROM LWB b TO UPB b DO
            # form a matrix from a with the col'th column replaced by b #
            [ 1 LWB a : 1 UPB a, 2 LWB a : 2 UPB a ]REAL m := a;
            m[ : , col ] := b[ : AT 1 ];
            # col'th result elemet as per Cramer's rule                 #
            result[ col ] := DET m / det a
        OD;
        result
     FI; # CRAMER #

# test CRAMER using the matrix and column vector specified in the task  #
[,]REAL a = ( (  2, -1,  5,  1 )
            , (  3,  2,  2, -6 )
            , (  1,  3,  3, -1 )
            , (  5, -2, -3,  3 )
            );
[]REAL  b = (  -3
            , -32
            , -47
            ,  49
            );
[]REAL  solution = a CRAMER b;
FOR c FROM LWB solution TO UPB solution DO
    print( ( " ", fixed( solution[ c ], -8, 4 ) ) )
OD;
print( ( newline ) )


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

typedef struct {
    int n;
    double **elems;
} SquareMatrix;

SquareMatrix init_square_matrix(int n, double elems[n][n]) {
    SquareMatrix A = {
        .n = n,
        .elems = malloc(n * sizeof(double *))
    };
    for(int i = 0; i < n; ++i) {
        A.elems[i] = malloc(n * sizeof(double));
        for(int j = 0; j < n; ++j)
            A.elems[i][j] = elems[i][j];
    }

    return A;
}

SquareMatrix copy_square_matrix(SquareMatrix src) {
    SquareMatrix dest;
    dest.n = src.n;
    dest.elems = malloc(dest.n * sizeof(double *));
    for(int i = 0; i < dest.n; ++i) {
        dest.elems[i] = malloc(dest.n * sizeof(double));
        for(int j = 0; j < dest.n; ++j)
            dest.elems[i][j] = src.elems[i][j];
    }

    return dest;
}

double det(SquareMatrix A) {
    double det = 1;

    for(int j = 0; j < A.n; ++j) {
        int i_max = j;
        for(int i = j; i < A.n; ++i)
            if(A.elems[i][j] > A.elems[i_max][j])
                i_max = i;

        if(i_max != j) {
            for(int k = 0; k < A.n; ++k) {
                double tmp = A.elems[i_max][k];
                A.elems[i_max][k] = A.elems[j][k];
                A.elems[j][k]     = tmp;
            }

            det *= -1;
        }

        if(abs(A.elems[j][j]) < 1e-12) {
            puts("Singular matrix!");
            return NAN;
        }

        for(int i = j + 1; i < A.n; ++i) {
            double mult = -A.elems[i][j] / A.elems[j][j];
            for(int k = 0; k < A.n; ++k)
                A.elems[i][k] += mult * A.elems[j][k];
        }
    }

    for(int i = 0; i < A.n; ++i)
        det *= A.elems[i][i];

    return det;
}

void deinit_square_matrix(SquareMatrix A) {
    for(int i = 0; i < A.n; ++i)
        free(A.elems[i]);
    free(A.elems);
}

double cramer_solve(SquareMatrix A, double det_A, double *b, int var) {
    SquareMatrix tmp = copy_square_matrix(A);
    for(int i = 0; i < tmp.n; ++i)
        tmp.elems[i][var] = b[i];

    double det_tmp = det(tmp);
    deinit_square_matrix(tmp);

    return det_tmp / det_A;
}

int main(int argc, char **argv) {
#define N 4
    double elems[N][N] = {
        { 2, -1,  5,  1},
        { 3,  2,  2, -6},
        { 1,  3,  3, -1},
        { 5, -2, -3,  3}
    };
    SquareMatrix A = init_square_matrix(N, elems);

    SquareMatrix tmp = copy_square_matrix(A);
    int det_A = det(tmp);
    deinit_square_matrix(tmp);

    double b[] = {-3, -32, -47, 49};

    for(int i = 0; i < N; ++i)
        printf("%7.3lf\n", cramer_solve(A, det_A, b, i));

    deinit_square_matrix(A);
    return EXIT_SUCCESS;
}


using System;
using System.Collections.Generic;
using static System.Linq.Enumerable;

public static class CramersRule
{
    public static void Main() {
        var equations = new [] {
            new [] { 2, -1,  5,  1,  -3 },
            new [] { 3,  2,  2, -6, -32 },
            new [] { 1,  3,  3, -1, -47 },
            new [] { 5, -2, -3,  3,  49 }
        };
        var solution = SolveCramer(equations);
        Console.WriteLine(solution.DelimitWith(", "));
    }

    public static int[] SolveCramer(int[][] equations) {
        int size = equations.Length;
        if (equations.Any(eq => eq.Length != size + 1)) throw new ArgumentException($"Each equation must have {size+1} terms.");
        int[,] matrix = new int[size, size];
        int[] column = new int[size];
        for (int r = 0; r < size; r++) {
            column[r] = equations[r][size];
            for (int c = 0; c < size; c++) {
                matrix[r, c] = equations[r][c];
            }
        }
        return Solve(new SubMatrix(matrix, column));
    }

    private static int[] Solve(SubMatrix matrix) {
        int det = matrix.Det();
        if (det == 0) throw new ArgumentException("The determinant is zero.");

        int[] answer = new int[matrix.Size];
        for (int i = 0; i < matrix.Size; i++) {
            matrix.ColumnIndex = i;
            answer[i] = matrix.Det() / det;
        }
        return answer;
    }

    //Extension method from library.
    static string DelimitWith<T>(this IEnumerable<T> source, string separator = " ") =>
        string.Join(separator ?? " ", source ?? Empty<T>());

    private class SubMatrix
    {
        private int[,] source;
        private SubMatrix prev;
        private int[] replaceColumn;

        public SubMatrix(int[,] source, int[] replaceColumn) {
            this.source = source;
            this.replaceColumn = replaceColumn;
            this.prev = null;
            this.ColumnIndex = -1;
            Size = replaceColumn.Length;
        }

        private SubMatrix(SubMatrix prev, int deletedColumnIndex = -1) {
            this.source = null;
            this.prev = prev;
            this.ColumnIndex = deletedColumnIndex;
            Size = prev.Size - 1;
        }

        public int ColumnIndex { get; set; }
        public int Size { get; }

        public int this[int row, int column] {
            get {
                if (source != null) return column == ColumnIndex ? replaceColumn[row] : source[row, column];
                return prev[row + 1, column < ColumnIndex ? column : column + 1];
            }
        }

        public int Det() {
            if (Size == 1) return this[0, 0];
            if (Size == 2) return this[0, 0] * this[1, 1] - this[0, 1] * this[1, 0];
            SubMatrix m = new SubMatrix(this);
            int det = 0;
            int sign = 1;
            for (int c = 0; c < Size; c++) {
                m.ColumnIndex = c;
                int d = m.Det();
                det += this[0, c] * d * sign;
                sign = -sign;
            }
            return det;
        }

        public void Print() {
            for (int r = 0; r < Size; r++) {
                Console.WriteLine(Range(0, Size).Select(c => this[r, c]).DelimitWith(", "));
            }
            Console.WriteLine();
        }
    }

}


#include <algorithm>
#include <iostream>
#include <vector>

class SubMatrix {
    const std::vector<std::vector<double>> *source;
    std::vector<double> replaceColumn;
    const SubMatrix *prev;
    size_t sz;
    int colIndex = -1;

public:
    SubMatrix(const std::vector<std::vector<double>> &src, const std::vector<double> &rc) : source(&src), replaceColumn(rc), prev(nullptr), colIndex(-1) {
        sz = replaceColumn.size();
    }

    SubMatrix(const SubMatrix &p) : source(nullptr), prev(&p), colIndex(-1) {
        sz = p.size() - 1;
    }

    SubMatrix(const SubMatrix &p, int deletedColumnIndex) : source(nullptr), prev(&p), colIndex(deletedColumnIndex) {
        sz = p.size() - 1;
    }

    int columnIndex() const {
        return colIndex;
    }
    void columnIndex(int index) {
        colIndex = index;
    }

    size_t size() const {
        return sz;
    }

    double index(int row, int col) const {
        if (source != nullptr) {
            if (col == colIndex) {
                return replaceColumn[row];
            } else {
                return (*source)[row][col];
            }
        } else {
            if (col < colIndex) {
                return prev->index(row + 1, col);
            } else {
                return prev->index(row + 1, col + 1);
            }
        }
    }

    double det() const {
        if (sz == 1) {
            return index(0, 0);
        }
        if (sz == 2) {
            return index(0, 0) * index(1, 1) - index(0, 1) * index(1, 0);
        }
        SubMatrix m(*this);
        double det = 0.0;
        int sign = 1;
        for (size_t c = 0; c < sz; ++c) {
            m.columnIndex(c);
            double d = m.det();
            det += index(0, c) * d * sign;
            sign = -sign;
        }
        return det;
    }
};

std::vector<double> solve(SubMatrix &matrix) {
    double det = matrix.det();
    if (det == 0.0) {
        throw std::runtime_error("The determinant is zero.");
    }

    std::vector<double> answer(matrix.size());
    for (int i = 0; i < matrix.size(); ++i) {
        matrix.columnIndex(i);
        answer[i] = matrix.det() / det;
    }
    return answer;
}

std::vector<double> solveCramer(const std::vector<std::vector<double>> &equations) {
    int size = equations.size();
    if (std::any_of(
        equations.cbegin(), equations.cend(),
        [size](const std::vector<double> &a) { return a.size() != size + 1; }
    )) {
        throw std::runtime_error("Each equation must have the expected size.");
    }

    std::vector<std::vector<double>> matrix(size);
    std::vector<double> column(size);
    for (int r = 0; r < size; ++r) {
        column[r] = equations[r][size];
        matrix[r].resize(size);
        for (int c = 0; c < size; ++c) {
            matrix[r][c] = equations[r][c];
        }
    }

    SubMatrix sm(matrix, column);
    return solve(sm);
}

template<typename T>
std::ostream &operator<<(std::ostream &os, const std::vector<T> &v) {
    auto it = v.cbegin();
    auto end = v.cend();

    os << '[';
    if (it != end) {
        os << *it++;
    }
    while (it != end) {
        os << ", " << *it++;
    }

    return os << ']';
}

int main() {
    std::vector<std::vector<double>> equations = {
        { 2, -1,  5,  1,  -3},
        { 3,  2,  2, -6, -32},
        { 1,  3,  3, -1, -47},
        { 5, -2, -3,  3,  49},
    };

    auto solution = solveCramer(equations);
    std::cout << solution << '\n';

    return 0;
}


(defun minor (m col)
  (loop with dim = (1- (array-dimension m 0))
        with result = (make-array (list dim dim))
        for i from 1 to dim
        for r = (1- i)
        do (loop with c = 0
                 for j to dim
                 when (/= j col)
                   do (setf (aref result r c) (aref m i j))
                      (incf c))
        finally (return result)))

(defun det (m)
  (assert (= (array-rank m) 2))
  (assert (= (array-dimension m 0) (array-dimension m 1)))
  (let ((dim (array-dimension m 0)))
    (if (= dim 1)
        (aref m 0 0)
        (loop for col below dim
              for sign = 1 then (- sign)
              sum (* sign (aref m 0 col) (det (minor m col)))))))

(defun replace-column (m col values)
  (let* ((dim (array-dimension m 0))
         (result (make-array (list dim dim))))
    (dotimes (r dim result)
      (dotimes (c dim)
        (setf (aref result r c)
              (if (= c col) (aref values r) (aref m r c)))))))

(defun solve (m v)
  (loop with dim = (array-dimension m 0)
        with det = (det m)
        for col below dim
        collect (/ (det (replace-column m col v)) det)))

(solve #2A((2 -1  5  1)
           (3  2  2 -6)
           (1  3  3 -1)
           (5 -2 -3  3))
       #(-3 -32 -47 49))


import std.array : array, uninitializedArray;
import std.range : iota;
import std.stdio : writeln;
import std.typecons : tuple;

alias vector = double[4];
alias matrix = vector[4];

auto johnsonTrotter(int n) {
    auto p = iota(n).array;
    auto q = iota(n).array;
    auto d = uninitializedArray!(int[])(n);
    d[] = -1;
    auto sign = 1;
    int[][] perms;
    int[] signs;

    void permute(int k) {
        if (k >= n) {
            perms ~= p.dup;
            signs ~= sign;
            sign *= -1;
            return;
        }
        permute(k + 1);
        foreach (i; 0..k) {
            auto z = p[q[k] + d[k]];
            p[q[k]] = z;
            p[q[k] + d[k]] = k;
            q[z] = q[k];
            q[k] += d[k];
            permute(k + 1);
        }
        d[k] *= -1;
    }

    permute(0);
    return tuple!("sigmas", "signs")(perms, signs);
}

auto determinant(matrix m) {
    auto jt = johnsonTrotter(m.length);
    auto sum = 0.0;
    foreach (i,sigma; jt.sigmas) {
        auto prod = 1.0;
        foreach (j,s; sigma) {
            prod *= m[j][s];
        }
        sum += jt.signs[i] * prod;
    }
    return sum;
}

auto cramer(matrix m, vector d) {
    auto divisor = determinant(m);
    auto numerators = uninitializedArray!(matrix[])(m.length);
    foreach (i; 0..m.length) {
        foreach (j; 0..m.length) {
            foreach (k; 0..m.length) {
                numerators[i][j][k] = m[j][k];
            }
        }
    }
    vector v;
    foreach (i; 0..m.length) {
        foreach (j; 0..m.length) {
            numerators[i][j][i] = d[j];
        }
    }
    foreach (i; 0..m.length) {
        v[i] = determinant(numerators[i]) / divisor;
    }
    return v;
}

void main() {
    matrix m = [
        [2.0, -1.0,  5.0,  1.0],
        [3.0,  2.0,  2.0, -6.0],
        [1.0,  3.0,  3.0, -1.0],
        [5.0, -2.0, -3.0,  3.0]
    ];
    vector d = [-3.0, -32.0, -47.0, 49.0];
    auto wxyz = cramer(m, d);
    writeln("w = ", wxyz[0], ", x = ", wxyz[1], ", y = ", wxyz[2], ", z = ", wxyz[3]);
}


(lib 'matrix)
(string-delimiter "")
(define (cramer A B (X)) ;; --> vector X
	(define ∆ (determinant A))
	(for/vector [(i (matrix-col-num A))]
		(set! X (matrix-set-col! (array-copy A) i B))
		(// (determinant X) ∆)))

(define (task)
	(define A (list->array
  	'( 2 -1 5 1 3 2 2 -6 1 3 3 -1 5 -2 -3 3) 4 4))
	(define B #(-3 -32 -47 49))
	(writeln "Solving A * X = B")
	(array-print A)
	(writeln "B = " B)
	(writeln "X = " (cramer A B)))


USING: kernel math math.matrices.laplace prettyprint sequences ;
IN: rosetta-code.cramers-rule

: replace-col ( elt n seq -- seq' ) flip [ set-nth ] keep flip ;

: solve ( m v -- seq )
    dup length <iota> [
        rot [ replace-col ] keep [ determinant ] [email protected] /
    ] 2with map ;

: cramers-rule-demo ( -- )
    {
        { 2 -1  5  1 }
        { 3  2  2 -6 }
        { 1  3  3 -1 }
        { 5 -2 -3  3 }
    }
    { -3 -32 -47 49 } solve . ;

MAIN: cramers-rule-demo


Function determinant(matrix() As Double) As Double
      Dim As long n=Ubound(matrix,1),sign=1
      Dim As Double det=1,s=1
      Dim As Double b(1 To n,1 To n)
      For c As long=1 To n
            For d As long=1 To n
                  b(c,d)=matrix(c,d)
            Next d
      Next c
      #macro pivot(num)
      For p1 As long  = num To n - 1
            For p2 As long  = p1 + 1 To n
                  If Abs(b(p1,num))<Abs(b(p2,num)) Then
                        sign=-sign
                        For g As long=1 To n
                              Swap b(p1,g),b(p2,g)
                        Next g
                  End If
            Next p2
      Next p1
      #endmacro
      For k As long=1 To n-1
            pivot(k)
            For row As long =k To n-1
                  If b(row+1,k)=0 Then Exit For
                  Var f=b(k,k)/b(row+1,k)
                  s=s*f
                  For g As long=1 To n
                        b((row+1),g)=(b((row+1),g)*f-b(k,g))/f
                  Next g
            Next row
      Next k
      For z As long=1 To n
            det=det*b(z,z)
      Next z
      Return sign*det
End Function

'CRAMER COLUMN SWAPS
Sub swapcolumn(m() As Double,c() As Double,_new() As Double,column As long)
      Redim _new(1 To Ubound(m,1),1 To Ubound(m,1))
      For x As long=1 To Ubound(m,1)
            For y As long=1 To Ubound(m,1)
                  _new(x,y)=m(x,y)
            Next y
      Next x
      For z As long=1 To Ubound(m,1)
            _new(z,column)=c(z)
      Next z
End Sub

Sub solve(mat() As Double,rhs() As Double,_out() As Double)
      redim _out(Lbound(mat,1) To Ubound(mat,1))
      Redim As Double result(Lbound(mat,1) To Ubound(mat,1),Lbound(mat,1) To Ubound(mat,1))
      Dim As Double maindeterminant=determinant(mat())
      If Abs(maindeterminant) < 1e-12 Then Print "singular":Exit Sub
      For column As Long=1 To Ubound(mat,1)
            swapcolumn(mat(),rhs(),result(),column)
            _out(column)= determinant(result())/maindeterminant
      Next
End Sub

Dim As Double MainMat(1 To ...,1 To ...)={{2,-1,5,1}, _
                                          {3,2,2,-6}, _
                                          {1,3,3,-1}, _
                                          {5,-2,-3,3}}

Dim As Double rhs(1 To ...)={-3,-32,-47,49}

Redim ans() As Double
solve(MainMat(),rhs(),ans())

For n As Long=1 To Ubound(ans)
      Print Csng(ans(n))
Next
Sleep


package main

import (
    "fmt"

    "gonum.org/v1/gonum/mat"
)

var m = mat.NewDense(4, 4, []float64{
    2, -1, 5, 1,
    3, 2, 2, -6,
    1, 3, 3, -1,
    5, -2, -3, 3,
})

var v = []float64{-3, -32, -47, 49}

func main() {
    x := make([]float64, len(v))
    b := make([]float64, len(v))
    d := mat.Det(m)
    for c := range v {
        mat.Col(b, c, m)
        m.SetCol(c, v)
        x[c] = mat.Det(m) / d
        m.SetCol(c, b)
    }
    fmt.Println(x)
}


class CramersRule {
    static void main(String[] args) {
        Matrix mat = new Matrix(Arrays.asList(2d, -1d, 5d, 1d),
                Arrays.asList(3d, 2d, 2d, -6d),
                Arrays.asList(1d, 3d, 3d, -1d),
                Arrays.asList(5d, -2d, -3d, 3d))
        List<Double> b = Arrays.asList(-3d, -32d, -47d, 49d)
        println("Solution = " + cramersRule(mat, b))
    }

    private static List<Double> cramersRule(Matrix matrix, List<Double> b) {
        double denominator = matrix.determinant()
        List<Double> result = new ArrayList<>()
        for (int i = 0; i < b.size(); i++) {
            result.add(matrix.replaceColumn(b, i).determinant() / denominator)
        }
        return result
    }

    private static class Matrix {
        private List<List<Double>> matrix

        @Override
        String toString() {
            return matrix.toString()
        }

        @SafeVarargs
        Matrix(List<Double>... lists) {
            matrix = new ArrayList<>()
            for (List<Double> list : lists) {
                matrix.add(list)
            }
        }

        Matrix(List<List<Double>> mat) {
            matrix = mat
        }

        double determinant() {
            if (matrix.size() == 1) {
                return get(0, 0)
            }
            if (matrix.size() == 2) {
                return get(0, 0) * get(1, 1) - get(0, 1) * get(1, 0)
            }
            double sum = 0
            double sign = 1
            for (int i = 0; i < matrix.size(); i++) {
                sum += sign * get(0, i) * coFactor(0, i).determinant()
                sign *= -1
            }
            return sum
        }

        private Matrix coFactor(int row, int col) {
            List<List<Double>> mat = new ArrayList<>()
            for (int i = 0; i < matrix.size(); i++) {
                if (i == row) {
                    continue
                }
                List<Double> list = new ArrayList<>()
                for (int j = 0; j < matrix.size(); j++) {
                    if (j == col) {
                        continue
                    }
                    list.add(get(i, j))
                }
                mat.add(list)
            }
            return new Matrix(mat)
        }

        private Matrix replaceColumn(List<Double> b, int column) {
            List<List<Double>> mat = new ArrayList<>()
            for (int row = 0; row < matrix.size(); row++) {
                List<Double> list = new ArrayList<>()
                for (int col = 0; col < matrix.size(); col++) {
                    double value = get(row, col)
                    if (col == column) {
                        value = b.get(row)
                    }
                    list.add(value)
                }
                mat.add(list)
            }
            return new Matrix(mat)
        }

        private double get(int row, int col) {
            return matrix.get(row).get(col)
        }
    }
}


import Data.Matrix

solveCramer :: (Ord a, Fractional a) => Matrix a -> Matrix a -> Maybe [a]
solveCramer a y
  | da == 0 = Nothing
  | otherwise = Just $ map (\i -> d i / da) [1..n]
  where da = detLU a
        d i = detLU $ submatrix 1 n 1 n $ switchCols i (n+1) ay
        ay = a <|> y
        n = ncols a

task = solveCramer a y
  where a = fromLists [[2,-1, 5, 1]
                      ,[3, 2, 2,-6]
                      ,[1, 3, 3,-1]
                      ,[5,-2,-3, 3]]
        y = fromLists [[-3], [-32], [-47], [49]]


import java.util.ArrayList;
import java.util.Arrays;
import java.util.List;

public class CramersRule {

    public static void main(String[] args) {
        Matrix mat = new Matrix(Arrays.asList(2d, -1d, 5d, 1d),
                                Arrays.asList(3d, 2d, 2d, -6d),
                                Arrays.asList(1d, 3d, 3d, -1d),
                                Arrays.asList(5d, -2d, -3d, 3d));
        List<Double> b = Arrays.asList(-3d, -32d, -47d, 49d);
        System.out.println("Solution = " + cramersRule(mat, b));
    }

    private static List<Double> cramersRule(Matrix matrix, List<Double> b) {
        double denominator = matrix.determinant();
        List<Double> result = new ArrayList<>();
        for ( int i = 0 ; i < b.size() ; i++ ) {
            result.add(matrix.replaceColumn(b, i).determinant() / denominator);
        }
        return result;
    }

    private static class Matrix {

        private List<List<Double>> matrix;

        @Override
        public String toString() {
            return matrix.toString();
        }

        @SafeVarargs
        public Matrix(List<Double> ... lists) {
            matrix = new ArrayList<>();
            for ( List<Double> list : lists) {
                matrix.add(list);
            }
        }

        public Matrix(List<List<Double>> mat) {
            matrix = mat;
        }

        public double determinant() {
            if ( matrix.size() == 1 ) {
                return get(0, 0);
            }
            if ( matrix.size() == 2 ) {
                return get(0, 0) * get(1, 1) - get(0, 1) * get(1, 0);
            }
            double sum = 0;
            double sign = 1;
            for ( int i = 0 ; i < matrix.size() ; i++ ) {
                sum += sign * get(0, i) * coFactor(0, i).determinant();
                sign *= -1;
            }
            return sum;
        }

        private Matrix coFactor(int row, int col) {
            List<List<Double>> mat = new ArrayList<>();
            for ( int i = 0 ; i < matrix.size() ; i++ ) {
                if ( i == row ) {
                    continue;
                }
                List<Double> list = new ArrayList<>();
                for ( int j = 0 ; j < matrix.size() ; j++ ) {
                    if ( j == col ) {
                        continue;
                    }
                    list.add(get(i, j));
                }
                mat.add(list);
            }
            return new Matrix(mat);
        }

        private Matrix replaceColumn(List<Double> b, int column) {
            List<List<Double>> mat = new ArrayList<>();
            for ( int row = 0 ; row < matrix.size() ; row++ ) {
                List<Double> list = new ArrayList<>();
                for ( int col = 0 ; col < matrix.size() ; col++ ) {
                    double value = get(row, col);
                    if ( col == column ) {
                        value = b.get(row);
                    }
                    list.add(value);
                }
                mat.add(list);
            }
            return new Matrix(mat);
        }

        private double get(int row, int col) {
            return matrix.get(row).get(col);
        }

    }

}


var matrix = [
	[2, -1,  5,  1],
	[3,  2,  2, -6],
	[1,  3,  3, -1],
	[5, -2, -3,  3]
];
var freeTerms = [-3, -32, -47, 49];

var result = cramersRule(matrix,freeTerms);
console.log(result);

/**
 * Compute Cramer's Rule
 * @param  {array} matrix    x,y,z, etc. terms
 * @param  {array} freeTerms
 * @return {array}           solution for x,y,z, etc.
 */
function cramersRule(matrix,freeTerms) {
	var det = detr(matrix),
		returnArray = [],
		i,
		tmpMatrix;

	for(i=0; i < matrix[0].length; i++) {
		var tmpMatrix = insertInTerms(matrix, freeTerms,i)
		returnArray.push(detr(tmpMatrix)/det)
	}
	return returnArray;
}

/**
 * Inserts single dimensional array into
 * @param  {array} matrix multidimensional array to have ins inserted into
 * @param  {array} ins single dimensional array to be inserted vertically into matrix
 * @param  {array} at  zero based offset for ins to be inserted into matrix
 * @return {array}     New multidimensional array with ins replacing the at column in matrix
 */
function insertInTerms(matrix, ins, at) {
	var tmpMatrix = clone(matrix),
		i;
	for(i=0; i < matrix.length; i++) {
		tmpMatrix[i][at] = ins[i];
	}
	return tmpMatrix;
}
/**
 * Compute the determinate of a matrix.  No protection, assumes square matrix
 * function borrowed, and adapted from MIT Licensed numericjs library (www.numericjs.com)
 * @param  {array} m Input Matrix (multidimensional array)
 * @return {number}   result rounded to 2 decimal
 */
function detr(m) {
	var ret = 1,
		k,
		A=clone(m),
		n=m[0].length,
		alpha;

	for(var j =0; j < n-1; j++) {
		k=j;
		for(i=j+1;i<n;i++) { if(Math.abs(A[i][j]) > Math.abs(A[k][j])) { k = i; } }
		if(k !== j) {
		    temp = A[k]; A[k] = A[j]; A[j] = temp;
		    ret *= -1;
		}
		Aj = A[j];
		for(i=j+1;i<n;i++) {
			Ai = A[i];
            alpha = Ai[j]/Aj[j];
            for(k=j+1;k<n-1;k+=2) {
                k1 = k+1;
                Ai[k] -= Aj[k]*alpha;
                Ai[k1] -= Aj[k1]*alpha;
            }
            if(k!==n) { Ai[k] -= Aj[k]*alpha; }
        }
        if(Aj[j] === 0) { return 0; }
        ret *= Aj[j];
	    }
    return Math.round(ret*A[j][j]*100)/100;
}

/**
 * Clone two dimensional Array using ECMAScript 5 map function and EcmaScript 3 slice
 * @param  {array} m Input matrix (multidimensional array) to clone
 * @return {array}   New matrix copy
 */
function clone(m) {
	return m.map(function(a){return a.slice();});
}


# The minor of the input matrix after removing the specified row and column.
# Assumptions: the input is square and the indices are hunky dory.
def minor(rowNum; colNum):
  . as $in
  | (length - 1) as $len
  | reduce range(0; $len) as $i (null;
      reduce range(0; $len) as $j (.;
        if $i < rowNum and $j < colNum
        then .[$i][$j] = $in[$i][$j]
        elif $i >= rowNum and $j < colNum
        then .[$i][$j] = $in[$i+1][$j]
        elif $i < rowNum and $j >= colNum
        then .[$i][$j] = $in[$i][$j+1]
        else .[$i][$j] = $in[$i+1][$j+1]
        end) );

# The determinant using Laplace expansion.
# Assumption: the matrix is square
def det:
 . as $a
 | length as $nr
 | if $nr == 1 then .[0][0]
   elif $nr == 2 then .[1][1] * .[0][0] - .[0][1] * .[1][0]
   else reduce range(0; $nr) as $i (
     { sign: 1, sum: 0 };
     ($a|minor(0; $i)) as $m
     | .sum += .sign * $a[0][$i] * ($m|det)
     | .sign *= -1 )
     | .sum
   end ;

# Solve A X = D using Cramer's method
# a is assumed to be a JSON array representing the 2-d square matrix A
# d is assumed to be a JSON array representing the 1-d vector D
def cramer(a; d):
  (a | length) as $n
  | (a | det) as $ad
  | if $ad == 0 then "matrix determinant is 0" | error
  | reduce range(0; $n) as $c (null;
      (reduce range(0; $n) as $r (a; .[$r][$c] = d[$r])) as $aa
      | .[$c] = ($aa|det) / $ad ) ;

def a: [
    [2, -1,  5,  1],
    [3,  2,  2, -6],
    [1,  3,  3, -1],
    [5, -2, -3,  3]
];

def d:
  [ -3, -32, -47, 49 ] ;

"Solution is \(cramer(a; d))"


function cramersolve(A::Matrix, b::Vector)
    return collect(begin B = copy(A); B[:, i] = b; det(B) end for i in eachindex(b)) ./ det(A)
end

A = [2 -1  5  1
     3  2  2 -6
     1  3  3 -1
     5 -2 -3  3]

b = [-3, -32, -47, 49]

@show cramersolve(A, b)


// version 1.1.3

typealias Vector = DoubleArray
typealias Matrix = Array<Vector>

fun johnsonTrotter(n: Int): Pair<List<IntArray>, List<Int>> {
    val p = IntArray(n) { it }  // permutation
    val q = IntArray(n) { it }  // inverse permutation
    val d = IntArray(n) { -1 }  // direction = 1 or -1
    var sign = 1
    val perms = mutableListOf<IntArray>()
    val signs = mutableListOf<Int>()

    fun permute(k: Int) {
        if (k >= n) {
            perms.add(p.copyOf())
            signs.add(sign)
            sign *= -1
            return
        }
        permute(k + 1)
        for (i in 0 until k) {
            val z = p[q[k] + d[k]]
            p[q[k]] = z
            p[q[k] + d[k]] = k
            q[z] = q[k]
            q[k] += d[k]
            permute(k + 1)
        }
        d[k] *= -1
    }

    permute(0)
    return perms to signs
}

fun determinant(m: Matrix): Double {
    val (sigmas, signs) = johnsonTrotter(m.size)
    var sum = 0.0
    for ((i, sigma) in sigmas.withIndex()) {
        var prod = 1.0
        for ((j, s) in sigma.withIndex()) prod *= m[j][s]
        sum += signs[i] * prod
    }
    return sum
}

fun cramer(m: Matrix, d: Vector): Vector {
    val divisor = determinant(m)
    val numerators = Array(m.size) { Matrix(m.size) { m[it].copyOf() } }
    val v = Vector(m.size)
    for (i in 0 until m.size) {
        for (j in 0 until m.size) numerators[i][j][i] = d[j]
    }
    for (i in 0 until m.size) v[i] = determinant(numerators[i]) / divisor
    return v
}

fun main(args: Array<String>) {
    val m = arrayOf(
        doubleArrayOf(2.0, -1.0,  5.0,  1.0),
        doubleArrayOf(3.0,  2.0,  2.0, -6.0),
        doubleArrayOf(1.0,  3.0,  3.0, -1.0),
        doubleArrayOf(5.0, -2.0, -3.0,  3.0)
    )
    val d = doubleArrayOf(-3.0, -32.0, -47.0, 49.0)
    val (w, x, y, z) = cramer(m, d)
    println("w = $w, x = $x, y = $y, z = $z")
}


local matrix = require "matrix" -- https://github.com/davidm/lua-matrix

local function cramer(mat, vec)
  -- Check if matrix is quadratic
  assert(#mat == #mat[1], "Matrix is not square!")
  -- Check if vector has the same size of the matrix
  assert(#mat == #vec, "Vector has not the same size of the matrix!")

  local size = #mat
  local main_det = matrix.det(mat)

  local aux_mats = {}
  local dets = {}
  local result = {}
  for i = 1, size do
    -- Construct the auxiliary matrixes
    aux_mats[i] = matrix.copy(mat)
    for j = 1, size do
      aux_mats[i][j][i] = vec[j]
    end

    -- Calculate the auxiliary determinants
    dets[i] = matrix.det(aux_mats[i])

    -- Calculate results
    result[i] = dets[i]/main_det
  end

  return result
end

-----------------------------------------------

local A = {{ 2, -1,  5,  1},
           { 3,  2,  2, -6},
           { 1,  3,  3, -1},
           { 5, -2, -3,  3}}
local b = {-3, -32, -47, 49}

local result = cramer(A, b)
print("Result: " .. table.concat(result, ", "))


type
  SquareMatrix[N: static Positive] = array[N, array[N, float]]
  Vector[N: static Positive] = array[N, float]

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

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

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

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

func det(m: SquareMatrix): float =
  ## Return the determinant of matrix "m".

  var m = m
  result = 1

  for j in 0..m.high:
    var imax = j
    for i in (j + 1)..m.high:
      if m[i, j] > m[imax, j]:
        imax = i

    if imax != j:
      swap m[iMax], m[j]
      result = -result

    if abs(m[j, j]) < 1e-12:
      return NaN

    for i in (j + 1)..m.high:
      let mult = -m[i, j] / m[j, j]
      for k in 0..m.high:
        m[i, k] += mult * m[j, k]

  for i in 0..m.high:
    result *= m[i, i]

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

func cramerSolve(a: SquareMatrix; detA: float; b: Vector; col: Natural): float =
  ## Apply Cramer rule on matrix "a", using vector "b" to replace column "col".

  when a.N != b.N:
    {.error: "incompatible matrix and vector sizes".}

  else:
    var a = a
    for i in 0..a.high:
      a[i, col] = b[i]
    result = det(a) / detA

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

import strformat

const

  A: SquareMatrix[4] = [[2.0, -1.0,  5.0,  1.0],
                        [3.0,  2.0,  2.0, -6.0],
                        [1.0,  3.0,  3.0, -1.0],
                        [5.0, -2.0, -3.0,  3.0]]

  B: Vector[4] = [-3.0, -32.0, -47.0, 49.0]

let detA = det(A)
if detA == NaN:
  echo "Singular matrix!"
  quit(QuitFailure)

for i in 0..A.high:
  echo &"{cramerSolve(A, detA, B, i):7.3f}"


use Math::Matrix;

sub cramers_rule {
    my ($A, $terms) = @_;
    my @solutions;
    my $det = $A->determinant;
    foreach my $i (0 .. $#{$A}) {
        my $Ai = $A->clone;
        foreach my $j (0 .. $#{$terms}) {
            $Ai->[$j][$i] = $terms->[$j];
        }
        push @solutions, $Ai->determinant / $det;
    }
    @solutions;
}

my $matrix = Math::Matrix->new(
    [2, -1,  5,  1],
    [3,  2,  2, -6],
    [1,  3,  3, -1],
    [5, -2, -3,  3],
);

my $free_terms = [-3, -32, -47, 49];
my ($w, $x, $y, $z) = cramers_rule($matrix, $free_terms);

print "w = $w\n";
print "x = $x\n";
print "y = $y\n";
print "z = $z\n";


requires("0.8.4")
with javascript_semantics

constant inf = 1e300*1e300,
         nan = -(inf/inf)

function det(sequence a)
    atom res = 1

    a = deep_copy(a)
    integer l = length(a)
    for j=1 to l do
        integer i_max = j
        for i=j+1 to l do
            if a[i][j] > a[i_max][j] then
                i_max = i
            end if
        end for
        if i_max != j then
            sequence aim = a[i_max]
            a[i_max] = a[j]
            a[j] = aim
            res *= -1
        end if

        if abs(a[j][j]) < 1e-12 then
            puts(1,"Singular matrix!")
            return nan
        end if

        for i=j+1 to l do
            atom mult = -a[i][j] / a[j][j]
            for k=1 to l do
                a[i][k] += mult * a[j][k]
            end for
        end for
    end for

    for i=1 to l do
        res *= a[i][i]
    end for
    return res
end function

function cramer_solve(sequence a, atom det_a, sequence b, integer v)
    a = deep_copy(a)
    for i=1 to length(a) do
      a[i][v] = b[i]
    end for
    return det(a)/det_a
end function

sequence a = {{2,-1, 5, 1},
              {3, 2, 2,-6},
              {1, 3, 3,-1},
              {5,-2,-3, 3}},
         b = {-3,-32,-47,49}
integer det_a = det(a)
for i=1 to length(a) do
    printf(1, "%7.3f\n", cramer_solve(a, det_a, b, i))
end for


removeElement([_|Tail], 0, Tail).
removeElement([Head|Tail], J, [Head|X]) :-
    J_2 is J - 1,
    removeElement(Tail, J_2, X).

removeColumn([], _, []).
removeColumn([Matrix_head|Matrix_tail], J, [X|Y]) :-
    removeElement(Matrix_head, J, X),
    removeColumn(Matrix_tail, J, Y).

removeRow([_|Matrix_tail], 0, Matrix_tail).
removeRow([Matrix_head|Matrix_tail], I, [Matrix_head|X]) :-
    I_2 is I - 1,
    removeRow(Matrix_tail, I_2, X).

cofactor(Matrix, I, J, X) :-
    removeRow(Matrix, I, Matrix_2),
    removeColumn(Matrix_2, J, Matrix_3),
    det(Matrix_3, Y),
    X is (-1) ** (I + J) * Y.

det_summand(_, _, [], 0).
det_summand(Matrix, J, B, X) :-
    B = [B_head|B_tail],
    cofactor(Matrix, 0, J, Z),
    J_2 is J + 1,
    det_summand(Matrix, J_2, B_tail, Y),
    X is B_head * Z + Y.

det([[X]], X).
det(Matrix, X) :-
    Matrix = [Matrix_head|_],
    det_summand(Matrix, 0, Matrix_head, X).

replaceElement([_|Tail], 0, New, [New|Tail]).
replaceElement([Head|Tail], J, New, [Head|Y]) :-
    J_2 is J - 1,
    replaceElement(Tail, J_2, New, Y).

replaceColumn([], _, _, []).
replaceColumn([Matrix_head|Matrix_tail], J, [Column_head|Column_tail], [X|Y]) :-
    replaceElement(Matrix_head, J, Column_head, X),
    replaceColumn(Matrix_tail, J, Column_tail, Y).

cramerElements(_, B, L, []) :- length(B, L).
cramerElements(A, B, J, [X_J|Others]) :-
    replaceColumn(A, J, B, A_J),
    det(A_J, Det_A_J),
    det(A, Det_A),
    X_J is Det_A_J / Det_A,
    J_2 is J + 1,
    cramerElements(A, B, J_2, Others).

cramer(A, B, X) :- cramerElements(A, B, 0, X).

results(X) :-
    A = [
            [2, -1,  5,  1],
            [3,  2,  2, -6],
            [1,  3,  3, -1],
            [5, -2, -3,  3]
        ],
    B = [-3, -32, -47, 49],
    cramer(A, B, X).


def det(m,n):
 if n==1: return m[0][0]
 z=0
 for r in range(n):
  k=m[:]
  del k[r]
  z+=m[r][0]*(-1)**r*det([p[1:]for p in k],n-1)
 return z
w=len(t)
d=det(h,w)
if d==0:r=[]
else:r=[det([r[0:i]+[s]+r[i+1:]for r,s in zip(h,t)],w)/d for i in range(w)]
print(r)


#lang typed/racket
(require math/matrix)

(define A (matrix [[2 -1  5  1]
                   [3  2  2 -6]
                   [1  3  3 -1]
                   [5 -2 -3  3]]))

(define B (col-matrix [ -3
                       -32
                       -47
                        49]))

(matrix->vector (matrix-solve A B))


/* REXX Use Cramer's rule to compute solutions of given linear equations  */
Numeric Digits 20
names='w x y z'
M='  2  -1   5   1',
  '  3   2   2  -6',
  '  1   3   3  -1',
  '  5  -2  -3   3'
v=' -3',
  '-32',
  '-47',
  ' 49'
Call mk_mat(m)                      /* M -> a.i.j                    */
Do j=1 To dim                       /* Show the input                */
  ol=''
  Do i=1 To dim
    ol=ol format(a.i.j,6)
    End
  ol=ol format(word(v,j),6)
  Say ol
  End
Say copies('-',35)

d=det(m)                            /* denominator determinant       */

Do k=1 To dim                       /* construct nominator matrix    */
  Do j=1 To dim
    Do i=1 To dim
      If i=k Then
        b.i.j=word(v,j)
      Else
        b.i.j=a.i.j
      End
    End
  Call show_b
  d.k=det(mk_str())                 /* numerator determinant         */
  Say word(names,k) '=' d.k/d       /* compute value of variable k   */
  End
Exit

mk_mat: Procedure Expose a. dim     /* Turn list into matrix a.i.j */
  Parse Arg list
  dim=sqrt(words(list))
  k=0
  Do j=1 To dim
    Do i=1 To dim
      k=k+1
      a.i.j=word(list,k)
      End
    End
  Return

mk_str: Procedure Expose b. dim     /* Turn matrix b.i.j into list   */
  str=''
Do j=1 To dim
  Do i=1 To dim
    str=str b.i.j
    End
  End
Return str

show_b: Procedure Expose b. dim     /* show numerator matrix         */
  do j=1 To dim
    ol=''
    Do i=1 To dim
      ol=ol format(b.i.j,6)
      end
    Call dbg ol
    end
  Return

det: Procedure                      /* compute determinant           */
Parse Arg list
n=words(list)
call dbg 'det:' list
do dim=1 To 10
  If dim**2=n Then Leave
  End
call dbg 'dim='dim
If dim=2 Then Do
  det=word(list,1)*word(list,4)-word(list,2)*word(list,3)
  call dbg 'det=>'det
  Return det
  End
k=0
Do j=1 To dim
  Do i=1 To dim
    k=k+1
    a.i.j=word(list,k)
    End
  End
Do j=1 To dim
  ol=j
  Do i=1 To dim
    ol=ol format(a.i.j,6)
    End
  call dbg ol
  End
det=0
Do i=1 To dim
  ol=''
  Do j=2 To dim
    Do ii=1 To dim
      If ii<>i Then
        ol=ol a.ii.j
      End
    End
  call dbg 'i='i 'ol='ol
  If i//2 Then
    det=det+a.i.1*det(ol)
  Else
    det=det-a.i.1*det(ol)
  End
Call dbg 'det=>>>'det
Return det
sqrt: Procedure
/* REXX ***************************************************************
* EXEC to calculate the square root of a = 2 with high precision
**********************************************************************/
  Parse Arg x,prec
  If prec<9 Then prec=9
  prec1=2*prec
  eps=10**(-prec1)
  k = 1
  Numeric Digits 3
  r0= x
  r = 1
  Do i=1 By 1 Until r=r0 | (abs(r*r-x)<eps)
    r0 = r
    r  = (r + x/r) / 2
    k  = min(prec1,2*k)
    Numeric Digits (k + 5)
    End
  Numeric Digits prec
  r=r+0
  Return r

dbg: Return


require 'matrix'

def cramers_rule(a, terms)
  raise ArgumentError, " Matrix not square"  unless a.square?
  cols = a.to_a.transpose
  cols.each_index.map do |i|
    c = cols.dup
    c[i] = terms
    Matrix.columns(c).det / a.det
  end
end

matrix = Matrix[
    [2, -1,  5,  1],
    [3,  2,  2, -6],
    [1,  3,  3, -1],
    [5, -2, -3,  3],
]

vector = [-3, -32, -47, 49]
puts cramers_rule(matrix, vector)


use std::ops::{Index, IndexMut};

fn main() {
    let m = matrix(
        vec![
            2., -1., 5., 1., 3., 2., 2., -6., 1., 3., 3., -1., 5., -2., -3., 3.,
        ],
        4,
    );
    let mm = m.solve(&vec![-3., -32., -47., 49.]);
    println!("{:?}", mm);
}

#[derive(Clone)]
struct Matrix {
    elts: Vec<f64>,
    dim: usize,
}

impl Matrix {
    // Compute determinant using cofactor method
    // Using Gaussian elimination would have been more efficient, but it also solves the linear
    // system, so…
    fn det(&self) -> f64 {
        match self.dim {
            0 => 0.,
            1 => self[0][0],
            2 => self[0][0] * self[1][1] - self[0][1] * self[1][0],
            d => {
                let mut acc = 0.;
                let mut signature = 1.;
                for k in 0..d {
                    acc += signature * self[0][k] * self.comatrix(0, k).det();
                    signature *= -1.
                }
                acc
            }
        }
    }

    // Solve linear systems using Cramer's method
    fn solve(&self, target: &Vec<f64>) -> Vec<f64> {
        let mut solution: Vec<f64> = vec![0.; self.dim];
        let denominator = self.det();
        for j in 0..self.dim {
            let mut mm = self.clone();
            for i in 0..self.dim {
                mm[i][j] = target[i]
            }
            solution[j] = mm.det() / denominator
        }
        solution
    }

    // Compute the cofactor matrix for determinant computations
    fn comatrix(&self, k: usize, l: usize) -> Matrix {
        let mut v: Vec<f64> = vec![];
        for i in 0..self.dim {
            for j in 0..self.dim {
                if i != k && j != l {
                    v.push(self[i][j])
                }
            }
        }
        matrix(v, self.dim - 1)
    }
}

fn matrix(elts: Vec<f64>, dim: usize) -> Matrix {
    assert_eq!(elts.len(), dim * dim);
    Matrix { elts, dim }
}

impl Index<usize> for Matrix {
    type Output = [f64];

    fn index(&self, i: usize) -> &Self::Output {
        let m = self.dim;
        &self.elts[m * i..m * (i + 1)]
    }
}

impl IndexMut<usize> for Matrix {
    fn index_mut(&mut self, i: usize) -> &mut Self::Output {
        let m = self.dim;
        &mut self.elts[m * i..m * (i + 1)]
    }
}


func cramers_rule(A, terms) {
    gather {
        for i in ^A {
            var Ai = A.map{.map{_}}
            for j in ^terms {
                Ai[j][i] = terms[j]
            }
            take(Ai.det)
        }
    } »/» A.det
}

var matrix = [
    [2, -1,  5,  1],
    [3,  2,  2, -6],
    [1,  3,  3, -1],
    [5, -2, -3,  3],
]

var free_terms = [-3, -32, -47, 49]
var (w, x, y, z) = cramers_rule(matrix, free_terms)...

say "w = #{w}"
say "x = #{x}"
say "y = #{y}"
say "z = #{z}"


package require math::linearalgebra
namespace path ::math::linearalgebra

# Setting matrix to variable A and size to n
set A [list { 2 -1  5  1} { 3  2  2 -6} { 1  3  3 -1} { 5 -2 -3  3}]
set n [llength $A]
# Setting right side of equation
set right {-3 -32 -47 49}

# Calculating determinant of A
set detA [det $A]

# Apply Cramer's rule
for {set i 0} {$i < $n} {incr i} {
  set tmp $A                    ;# copy A to tmp
  setcol tmp $i $right          ;# replace column i with right side vector
  set detTmp [det $tmp]         ;# calculate determinant of tmp
  set v [expr $detTmp / $detA]  ;# divide two determinants
  puts [format "%0.4f" $v]      ;# format and display result
}


Sub CramersRule()
    OrigM = [{2,  -1, 5, 1; 3,2,2,-6;1,3,3,-1;5,-2,-3,3}]
    OrigD = [{-3;-32;-47;49}]

    MatrixSize = UBound(OrigM)
    DetOrigM = WorksheetFunction.MDeterm(OrigM)

    For i = 1 To MatrixSize
        ChangeM = OrigM

        For j = 1 To MatrixSize
            ChangeM(j, i) = OrigD(j, 1)
        Next j

        DetChangeM = WorksheetFunction.MDeterm(ChangeM)
        Debug.Print i & ": " & DetChangeM / DetOrigM
    Next i
End Sub


Imports System.Runtime.CompilerServices
Imports System.Linq.Enumerable

Module Module1
    <Extension()>
    Function DelimitWith(Of T)(source As IEnumerable(Of T), Optional seperator As String = " ") As String
        Return String.Join(seperator, source)
    End Function

    Private Class SubMatrix
        Private ReadOnly source As Integer(,)
        Private ReadOnly prev As SubMatrix
        Private ReadOnly replaceColumn As Integer()

        Public Sub New(source As Integer(,), replaceColumn As Integer())
            Me.source = source
            Me.replaceColumn = replaceColumn
            prev = Nothing
            ColumnIndex = -1
            Size = replaceColumn.Length
        End Sub

        Public Sub New(prev As SubMatrix, Optional deletedColumnIndex As Integer = -1)
            source = Nothing
            replaceColumn = Nothing
            Me.prev = prev
            ColumnIndex = deletedColumnIndex
            Size = prev.Size - 1
        End Sub

        Public Property ColumnIndex As Integer
        Public ReadOnly Property Size As Integer

        Default Public ReadOnly Property Index(row As Integer, column As Integer) As Integer
            Get
                If Not IsNothing(source) Then
                    Return If(column = ColumnIndex, replaceColumn(row), source(row, column))
                Else
                    Return prev(row + 1, If(column < ColumnIndex, column, column + 1))
                End If
            End Get
        End Property

        Public Function Det() As Integer
            If Size = 1 Then Return Me(0, 0)
            If Size = 2 Then Return Me(0, 0) * Me(1, 1) - Me(0, 1) * Me(1, 0)
            Dim m As New SubMatrix(Me)
            Dim detVal = 0
            Dim sign = 1
            For c = 0 To Size - 1
                m.ColumnIndex = c
                Dim d = m.Det()
                detVal += Me(0, c) * d * sign
                sign = -sign
            Next
            Return detVal
        End Function

        Public Sub Print()
            For r = 0 To Size - 1
                Dim rl = r
                Console.WriteLine(Range(0, Size).Select(Function(c) Me(rl, c)).DelimitWith(", "))
            Next
            Console.WriteLine()
        End Sub
    End Class

    Private Function Solve(matrix As SubMatrix) As Integer()
        Dim det = matrix.Det()
        If det = 0 Then Throw New ArgumentException("The determinant is zero.")

        Dim answer(matrix.Size - 1) As Integer
        For i = 0 To matrix.Size - 1
            matrix.ColumnIndex = i
            answer(i) = matrix.Det() / det
        Next
        Return answer
    End Function

    Public Function SolveCramer(equations As Integer()()) As Integer()
        Dim size = equations.Length
        If equations.Any(Function(eq) eq.Length <> size + 1) Then Throw New ArgumentException($"Each equation must have {size + 1} terms.")
        Dim matrix(size - 1, size - 1) As Integer
        Dim column(size - 1) As Integer
        For r = 0 To size - 1
            column(r) = equations(r)(size)
            For c = 0 To size - 1
                matrix(r, c) = equations(r)(c)
            Next
        Next
        Return Solve(New SubMatrix(matrix, column))
    End Function

    Sub Main()
        Dim equations = {
            ({2, -1, 5, 1, -3}),
            ({3, 2, 2, -6, -32}),
            ({1, 3, 3, -1, -47}),
            ({5, -2, -3, 3, 49})
        }
        Dim solution = SolveCramer(equations)
        Console.WriteLine(solution.DelimitWith(", "))
    End Sub

End Module


import "/matrix" for Matrix

var cramer = Fn.new { |a, d|
    var n = a.numRows
    var x = List.filled(n, 0)
    var ad = a.det
    for (c in 0...n) {
        var aa = a.copy()
        for (r in 0...n) aa[r, c] = d[r, 0]
        x[c] = aa.det/ad
    }
    return x
}

var a = Matrix.new([
    [2, -1,  5,  1],
    [3,  2,  2, -6],
    [1,  3,  3, -1],
    [5, -2, -3,  3]
])

var d = Matrix.new([
    [- 3],
    [-32],
    [-47],
    [ 49]
])

var x = cramer.call(a, d)
System.print("Solution is %(x)")


READ:	equ	3Fh		; MS-DOS syscalls
WRITE:	equ	40h
BUFSZ:	equ	4000h		; Buffer size
	cpu	8086
	bits	16
	org	100h
section	.text
read:	mov	ah,READ		; Read into buffer
	xor	bx,bx		; From STDIN (file 0)
	mov	cx,BUFSZ
	mov	dx,buffer
	int	21h
	test	ax,ax		; Did we read anything?
	jz	done		; If not, stop
	xchg	ax,cx		; Write as many bytes as read
	mov	ah,WRITE
	inc	bx		; To STDOUT (file 1)
	int	21h
	jmp	read		; Go get more
done:	ret
section	.bss
buffer:	resb	BUFSZ


PROC Main()
  CHAR c

  DO
    c=GetD(7)
    Put(c)
  UNTIL c=27 ;repeat until Esc key is pressed
  OD
RETURN


with Ada.Text_IO;

procedure Copy_Stdin_To_Stdout is
   use Ada.Text_IO;
   C : Character;
begin
   while not End_Of_File loop
      Get_Immediate (C);
      Put (C);
   end loop;
end Copy_Stdin_To_Stdout;


file f;
data b;
f.stdin;
while (f.b_line(b) ^ -1) {
    o_(b, "\n");
}


BEGIN
    BOOL at eof := FALSE;
    # set the EOF handler for stand in to a procedure that sets "at eof" to true #
    # and returns true so processing can continue                                #
    on logical file end( stand in, ( REF FILE f )BOOL: at eof := TRUE );
    # copy stand in to stand out                                                 #
    WHILE STRING line; read( ( line, newline ) ); NOT at eof DO write( ( line, newline ) ) OD
END


get "libhdr"

let start() be
$(  let c = rdch()
    if c = endstreamch then finish
    wrch(c)
$) repeat


#include <stdio.h>

int main(){
  char c;
  while ( (c=getchar()) != EOF ){
    putchar(c);
  }
  return 0;
}


using System;

class Program
{
    static void Main(string[] args)
    {
        Console.OpenStandardInput().CopyTo(Console.OpenStandardOutput());
    }
}


#include <iostream>
#include <iterator>

int main() {
    using namespace std;
    noskipws(cin);
    copy(
        istream_iterator<char>(cin),
        istream_iterator<char>(),
        ostream_iterator<char>(cout)
    );
    return 0;
}


start_up = proc ()
    pi: stream := stream$primary_input()
    po: stream := stream$primary_output()

    while true do
         stream$putc(po, stream$getc(pi))
    end except when end_of_file:
         return
    end
end start_up


10 print chr$(147);chr$(14);
11 print "0:Keyboard  1:Tape  2:RS-232  3:Screen"
12 print "4-7:printers/plotters"
13 print "8-11:Disk Drives":print
14 input "Input device";d1
15 if d1=1 or d1>=8 then input "Filename for INPUT";i$
16 input "Output device";d2
17 if d2=1 or d2>=8 then input "Filename for OUTPUT";o$
18 print:if d1=0 then print "Begin typing. Press CTRL-Z to end.":print
20 open 5,d1,5,"0:"+i$+",s,r"
30 open 2,d2,2,"@0:"+o$+",s,w"
40 get#5,a$
50 if (d1=0 and a$=chr$(26)) or (d1>0 and st>0) then close 5:close 2:end
60 print#2,a$;
70 goto 40


#|Loops while reading and collecting characters from STDIN until EOF (C-Z or C-D)
Then concatenates the characters into a string|#
(format t
  (concatenate 'string
    (loop for x = (read-char *query-io*) until (or (char= x #\Sub) (char= x #\Eot)) collecting x)))


STDIN.each_line do |line|
  puts line
end


import std.stdio;

void main() {
    foreach (line; stdin.byLine) {
        writeln(line);
    }
}


import 'dart:io';

void main() {
  var line = stdin.readLineSync();
  stdout.write(line);
}


\util.g

proc nonrec main() void:
    char c;
    while
        /* I/O is line-oriented, so first read characters
         * from the current line while that is possible */
        while read(c) do write(c) od;
        case ioerror()
            /* Then once it fails, if the line is empty,
             * try to go to the next line. */
            incase CH_MISSING:
                readln();
                writeln();
                true
            /* If it failed for another reason (which will be
             * EOF here), stop. */
            default:
                false
        esac
    do od
corp


let copy()=let n,g=stdin,stdout
           let rec fN()=match n.ReadLine() with "EOF"->g.Write "" |i->g.WriteLine i; fN()
           fN()
copy()


USING: io kernel ;

[ read1 dup ] [ write1 ] while drop


#define FIN 255  'eof is already a reserved word
#include "crt/stdio.bi"  'provides the C functions getchar and putchar
dim as ubyte char
do
    char = getchar()
    if char = FIN then exit do else putchar(char)
loop


package main

import (
    "bufio"
    "io"
    "os"
)

func main() {
    r := bufio.NewReader(os.Stdin)
    w := bufio.NewWriter(os.Stdout)
    for {
        b, err := r.ReadByte()
        if err == io.EOF {
            return
        }
        w.WriteByte(b)
        w.Flush()
    }
}


class StdInToStdOut {
    static void main(args) {
        try (def reader = System.in.newReader()) {
            def line
            while ((line = reader.readLine()) != null) {
                println line
            }
        }
    }
}


import java.util.Scanner;

public class CopyStdinToStdout {

    public static void main(String[] args) {
        try (Scanner scanner = new Scanner(System.in);) {
            String s;
            while ( (s = scanner.nextLine()).compareTo("") != 0 ) {
                System.out.println(s);
            }
        }
    }

}


while !eof(stdin)
    write(stdout, read(stdin, UInt8))
end


fun main() {
    var c: Int
    do {
        c = System.`in`.read()
        System.out.write(c)
    } while (c >= 0)
}


while { $stdin eof? not. } do {
  $stdout putln: $stdin readln.
}.


lua -e 'for x in io.lines() do print(x) end'


try
  while true do
    output_char stdout (input_char stdin)
  done
with End_of_file -> ()


(bytestream->port (port->bytestream stdin) stdout)


program writeInput(input, output);
var
	buffer: char;
begin
	while not EOF() do
	begin
		read(buffer); // shorthand for read(input, buffer)
		write(buffer); // shorthand for write(output, buffer)
	end;
end.


without js
while true do
    integer ch = wait_key()
    if ch=#1B then exit end if
    puts(1,ch)
end while


%File: stdin_to_stdout.pl
:- initialization(main).

main :- repeat,
	get_char(X),
	put_char(X),
	X == end_of_file,
	fail.


python -c 'import sys; sys.stdout.write(sys.stdin.read())'


#lang racket

(let loop ()
  (match (read-char)
    [(? eof-object?) (void)]
    [c (display c)
       (loop)]))


/*REXX pgm copies data from STDIN──►STDOUT (default input stream──►default output stream*/

  do while chars()\==0                           /*repeat loop until no more characters.*/
  call charin  , x                               /*read  a char from the  input stream. */
  call charout , x                               /*write "   "    "   "   output   "    */
  end   /*while*/                                /*stick a fork in it,  we're all done. */


? "give input: " give str
? "output: " + str


use std::io;

fn main() {
    io::copy(&mut io::stdin().lock(), &mut io::stdout().lock());
}


object CopyStdinToStdout extends App {
  io.Source.fromInputStream(System.in).getLines().foreach(println)
}


(do ((c (read-char) (read-char)))
    ((eof-object? c) 'done)
  (display c))


$ include "seed7_05.s7i";
  include "fileutil.s7i";

const proc: main is func
  begin
    copyFile(IN, OUT);
  end func;


"using Stream class's bulk copy method:"
Stdin copyToEndInto:Stdout.

"line wise"
[Stdin atEnd] whileFalse:[ Stdout nextPutLine:(Stdin nextLine) ].

"character wise"
[Stdin atEnd] whileFalse:[ Stdout nextPut:(Stdin next) ].

"no EOF test, but handle EOF Exception"
[
    [ Stdout nextPut:(Stdin next) ] loop.
] on: StreamError do:[]


fun copyLoop () =
  case TextIO.input TextIO.stdIn of
    "" => ()
  | tx => copyLoop (TextIO.output (TextIO.stdOut, tx))

val () = copyLoop ()


package require Tcl 8.5

chan copy stdin stdout
# fcopy stdin stdout for older versions


do
  s=wscript.stdin.readline
  wscript.stdout.writeline s
loop until asc(left(s,1))=26


import "io" for Stdin, Stdout

Stdin.isRaw = true // prevents echoing to the terminal
while (true) {
    var byte = Stdin.readByte()         // read a byte from stdin
    if (byte == 13) break               // break when enter key pressed
    System.write(String.fromByte(byte)) // write the byte (in string form) to stdout
    Stdout.flush()                      // flush output
}
System.print()
Stdin.isRaw = false


int C;
loop    [C:= ChIn(1);
        if C = $1A \EOF\ then quit;
        ChOut(0, C);
        ]


UInt32 seed = 0
F nonrandom(n)
   :seed = 1664525 * :seed + 1013904223
   R Int(:seed >> 16) % n

F rand9999()
   R nonrandom(9000) + 1000

F tag(tag, txt, attr = ‘’)
   R ‘<’tag‘’attr‘>’txt‘</’tag‘>’

V header = tag(‘tr’, ‘,X,Y,Z’.split(‘,’).map(txt -> tag(‘th’, txt)).join(‘’))"\n"
V rows = (1..5).map(i -> tag(‘tr’, tag(‘td’, i, ‘ style="font-weight: bold;"’)‘’(0.<3).map(j -> tag(‘td’, rand9999())).join(‘’))).join("\n")
V table = tag(‘table’, "\n"header‘’rows"\n")
print(table)


*        Create an HTML table      19/02/2017
CREHTML  CSECT
         USING  CREHTML,R13
         B      72(R15)
         DC     17F'0'
         STM    R14,R12,12(R13)
         ST     R13,4(R15)
         ST     R15,8(R13)
         LR     R13,R15            end of prolog
         LA     R8,RND
         XPRNT  PGBODY,64
         XPRNT  PGTAB,64

         SR     R6,R6              row=0
       DO WHILE=(C,R6,LE,NROWS)    do row=0 to nrows
       IF LTR,R6,Z,R6 THEN           if row=0
         XPRNT  PGTRTH,64

       ELSE     ,                    else
         XDECO  R6,XDEC                edit row
         MVC    PGTR+8(1),XDEC+11      output row heading
         XPRNT  PGTR,64
.
       ENDIF    ,                    endif
         LA     R7,1                 col=1
       DO WHILE=(C,R7,LE,NCOLS)      do col=1 to ncols
       IF LTR,R6,Z,R6 THEN             if row=0
         LR     R1,R7                    col
         LA     R4,TCAR-1(R1)            tcar(col)
         MVC    PGTH+4(1),0(R4)          output heading
         XPRNT  PGTH,64                  .
       ELSE     ,                      else
         L      R2,0(R8)                 value
         XDECO  R2,XDEC                  edit value
         MVC    PGTD+18(4),XDEC+8        output cell value
         XPRNT  PGTD,64                  ....
         LA     R8,4(R8)                 next value
       ENDIF    ,                      endif
         LA     R7,1(R7)               col++
       ENDDO    ,                    enddo col
         XPRNT  PGETR,64

         LA     R6,1(R6)             row++
       ENDDO    ,                  enddo row
         XPRNT  PGETAB,64

         XPRNT  PGEBODY,64
         L      R13,4(0,R13)       epilog
         LM     R14,R12,12(R13)
         XR     R15,R15
         BR     R14                exit
NROWS    DC     F'4'               number of rows
NCOLS    DC     F'3'               number of columns
TCAR     DC     CL3'XYZ'
RND      DC     F'7055',F'5334',F'5795',F'2895',F'3019',F'7747'
         DC     F'140',F'7607',F'8144',F'7090',F'475',F'4140'
PGBODY   DC     CL64''
PGTAB    DC     CL64'
'
PGTRTH   DC     CL64'
	'
PGTH     DC     CL64'.	'
PGETR    DC     CL64'
'
PGTR     DC     CL64'
.	'
PGTD     DC     CL64'....	'
PGETAB   DC     CL64'
'
PGEBODY  DC     CL64''
XDEC     DS     CL12
         YREGS
         END    CREHTML


DEFINE ROW_COUNT="4"
DEFINE COL_COUNT="3"

PROC Main()
  CHAR ARRAY headers=[0 'X 'Y 'Z]
  BYTE row,col
  INT v

  PrintE("")
  PrintE("")
  PrintE("")
  PrintE("
")
  PrintE("
")

  Print("
	")
  FOR col=1 TO COL_COUNT
  DO
    PrintF("%C	",headers(col))
  OD
  PrintE("
")
  PrintE("
")
  PrintE("
")

  FOR row=1 TO ROW_COUNT
  DO
    PrintF("
%B	",row)
    FOR col=1 TO COL_COUNT
    DO
      v=800+Rand(0)*5
      PrintF("%I	",v)
    OD
    PrintE("
")
  OD
  PrintE("
")
  PrintE("
")
  PrintE("")
  PrintE("")
RETURN


with Ada.Strings.Unbounded;

generic
   type Item_Type is private;
   with function To_String(Item: Item_Type) return String is <>;
   with procedure Put(S: String) is <>;
   with procedure Put_Line(Line: String) is <>;
package HTML_Table is

   subtype U_String is Ada.Strings.Unbounded.Unbounded_String;
   function Convert(S: String) return U_String renames
     Ada.Strings.Unbounded.To_Unbounded_String;

   type Item_Array is array(Positive range <>, Positive range <>) of Item_Type;
   type Header_Array is array(Positive range <>) of U_String;

   procedure Print(Items: Item_Array; Column_Heads: Header_Array);

end HTML_Table;


notNumbered     := 0; # possible values for html table row numbering
numberedLeft    := 1; #    "        "    "    "    "    "     "
numberedRight   := 2; #    "        "    "    "    "    "     "

alignCentre     := 0; # possible values for html table column alignment
alignLeft       := 1; #    "        "    "    "    "     "        "
alignRight      := 2; #    "        "    "    "    "     "        "

# write an html table to a file
writeHtmlTable := proc( fh, t :: table ) is
    local align := "align='";
    case t.columnAlignment
      of alignLeft  then align := align & "left'"
      of alignRight then align := align & "right'"
    else                 align := align &  "center'"
    esac;
    local put       := proc( text    :: string ) is io.write( fh, text & "\n" ) end;
    local thElement := proc( content :: string ) is put( "" & content & "	" ) end;
    local tdElement := proc( content           ) is put( "" & content & "	" ) end;
    # table element
    put( "
"
       );
    # table headings
    put( "
" );
    if t.rowNumbering =  numberedLeft then thElement( "" ) fi;
    for col to size t.headings do thElement( t.headings[ col ] ) od;
    if t.rowNumbering = numberedRight then thElement( "" ) fi;
    put( "
" );
    # table rows
    for row to size t.data do
        put( "
" );
        if t.rowNumbering =  numberedLeft then thElement( row & "" ) fi;
        for col to size t.data[ row ] do tdElement( t.data[ row, col ] ) od;
        if t.rowNumbering = numberedRight then thElement( row & "" ) fi;
        put( "
" )
    od;
    # end of table
    put( "
" )
end ;

# create an html table and print it to standard output
scope
    local t := [];
    t.cellSpacing, t.colSpacing := 0, 0;
    t.border          := 1;
    t.columnAlignment := alignRight;
    t.rowNumbering    := numberedLeft;
    t.headings        := [ "A", "B", "C" ];
    t.data            := [ [ 1001, 1002, 1003 ], [ 21, 22, 23 ], [ 201, 202, 203 ] ];
    writeHtmlTable( io.stdout, t )
epocs


INT not numbered     = 0; # possible values for HTMLTABLE row numbering    #
INT numbered left    = 1; #    "        "    "      "      "      "        #
INT numbered right   = 2; #    "        "    "      "      "      "        #

INT align centre     = 0; # possible values for HTMLTABLE column alignment #
INT align left       = 1; #   "        "    "      "         "       "     #
INT align right      = 2; #   "        "    "      "         "       "     #

# allowable content for the HTML table - extend the UNION and TOSTRING     #
#                                        operator to add additional modes  #
MODE HTMLTABLEDATA   = UNION( INT, REAL, STRING );
OP TOSTRING          = ( HTMLTABLEDATA content )STRING:
    CASE content
      IN ( INT    i ): whole( i, 0 )
       , ( REAL   r ): fixed( r, 0, 0 )
       , ( STRING s ): s
     OUT "Unsupported HTMLTABLEDATA content"
    ESAC;
# MODE to hold an html table                                               #
MODE HTMLTABLE       = STRUCT( FLEX[    0 ]STRING        headings
                             , FLEX[ 0, 0 ]HTMLTABLEDATA data
                             , INT   row numbering
                             , INT   column alignment
                             , INT   cell spacing
                             , INT   col spacing
                             , INT   border
                             );
# write an html table to a file                                            #
PROC write html table = ( REF FILE f, HTMLTABLE t )VOID:
BEGIN
    STRING align = "align="""
                 + CASE column alignment OF t IN "left", "right" OUT "center" ESAC
                 + """";
    PROC th element = ( REF FILE f, HTMLTABLE t, STRING content )VOID:
        put( f, ( "" + content + "	", newline ) );
    PROC td element = ( REF FILE f, HTMLTABLE t, HTMLTABLEDATA content )VOID:
        put( f, ( "" + TOSTRING content + "	", newline ) );

    # table element #
    put( f, ( "
"
            , newline
            )
       );
    # table headings                                                       #
    put( f, ( "
", newline ) );
    IF row numbering OF t =  numbered left THEN th element( f, t, "" ) FI;
    FOR col FROM LWB headings OF t TO UPB headings OF t DO
        th element( f, t, ( headings OF t )[ col ] )
    OD;
    IF row numbering OF t = numbered right THEN th element( f, t, "" ) FI;
    put( f, ( "
", newline ) );
    # table rows                                                           #
    FOR row FROM 1 LWB data OF t TO 1 UPB data OF t DO
        put( f, ( "
", newline ) );
        IF row numbering OF t =  numbered left THEN th element( f, t, whole( row, 0 ) ) FI;
        FOR col FROM 2 LWB data OF t TO 2 UPB data OF t DO
            td element( f, t, ( data OF t )[ row, col ] )
        OD;
        IF row numbering OF t = numbered right THEN th element( f, t, whole( row, 0 ) ) FI;
        put( f, ( "
", newline ) )
    OD;
    # end of table                                                         #
    put( f, ( "
", newline ) )
END # write html table # ;

# create an HTMLTABLE and print it to standard output                      #
HTMLTABLE t;
cell spacing     OF t := col spacing OF t := 0;
border           OF t := 1;
column alignment OF t := align right;
row numbering    OF t := numbered left;
headings         OF t := ( "A", "B", "C" );
data             OF t := ( ( 1001, 1002, 1003 ), ( 21, 22, 23 ), ( 201, 202, 203 ) );
write html table( stand out, t )


table: function [content]
    -> join @["
" join @content "
"]

header: function [cells] -> join @["
" join @cells "
"]
th: function [lbl] -> join @["" lbl "	"]
row: function [no]
    -> join @[
        "
" no "	"
        "" random 1000 9999 "	"
        "" random 1000 9999 "	"
        "" random 1000 9999 "
"
    ]

print table [
    header [th"" th"X" th"Y" th"Z"]
    row 1
    row 2
    row 3
    row 4
    row 5
]


out =
	X	Y	Z

Loop 4
    out .= "`r`n
" A_Index "	" Rand() "	" Rand() "	" Rand() "
"
out .= "`r`n
"
MsgBox % clipboard := out

Rand(u=1000){
    Random, n, 1, % u
    return n
}


@echo off
setlocal enabledelayedexpansion

:: It's easier and neater to create the variables holding the random 4 digit numbers ahead of time
for /l %%i in (1,1,12) do set /a rand%%i=!random! %% 9999

:: The command output of everything within the brackets is sent to the file "table.html", overwriting anything already in there
(
  echo ^^^^
  echo ^

  echo ^
^^
  echo ^X^
  echo ^Y^
  echo ^Z^
  echo ^

  echo ^
^1^
  echo ^%rand1%^
  echo ^%rand2%^
  echo ^%rand3%^
  echo ^

  echo ^
^2^
  echo ^%rand4%^
  echo ^%rand5%^
  echo ^%rand6%^
  echo ^

  echo ^
^3^
  echo ^%rand7%^
  echo ^%rand8%^
  echo ^%rand9%^
  echo ^

  echo ^
^4^
  echo ^%rand10%^
  echo ^%rand11%^
  echo ^%rand12%^
  echo ^

  echo ^

  echo ^^
) > table.html
start table.html


ncols% = 3
      nrows% = 4

      *spool temp.htm

      PRINT ""
      PRINT "
"

      FOR row% = 0 TO nrows%
        IF row% = 0 THEN
          PRINT "
	" ;
        ELSE
          PRINT "
" ; row% "	" ;
        ENDIF
        FOR col% = 1 TO ncols%
          IF row% = 0 THEN
            PRINT "" CHR$(87 + col%) "	" ;
          ELSE
            PRINT "" ; RND(9999) "	" ;
          ENDIF
        NEXT col%
        PRINT "
"
      NEXT row%

      PRINT "
"
      PRINT ""

      *spool

      SYS "ShellExecute", @hwnd%, 0, "temp.htm", 0, 0, 1


Tag ← {∾"<"‿𝕨‿">"‿𝕩‿"</"‿𝕨‿">"}

•Show "table" Tag ∾∾⟜(@+10)¨("tr"Tag∾)¨⟨"th"⊸Tag¨ ""<⊸∾⥊¨"XYZ"⟩∾("td" Tag •Fmt)¨¨ 0‿0‿1‿2 + 1‿3‿3‿3 × 4/⟨↕4⟩


(  ( makeTable
  =     headTexts
        minRowNr
        maxRowNr
        headCells
        cells
        rows
        Generator
        Table
    .   get$"xmlio.bra"             { A library that converts from Bracmat format to XML or HTML }
      & !arg:(?headTexts.?minRowNr.?maxRowNr.?Generator)
      & ( headCells
        =   cellText
          .     !arg:%?cellText ?arg
              & (th.,!cellText) headCells$!arg
            |
        )
      & ( cells
        =   cellText cellTexts numberGenerator
          .       !arg
                : (%?cellText ?cellTexts.(=?numberGenerator))
              &   (td.,numberGenerator$)
                  cells$(!cellTexts.'$numberGenerator)
            |
        )
      & ( rows
        =   headTexts rowNr maxRowNr Generator
          .     !arg:(?headTexts.?rowNr.?maxRowNr.?Generator)
              & !rowNr:~>!maxRowNr
              &   ( tr
                  .
                    ,   (td.,!rowNr)
                        cells$(!headTexts.!Generator)
                  )
                  \n
                  rows$(!headTexts.!rowNr+1.!maxRowNr.!Generator)
            |
        )
      &   ( table
          .
            ,   ( thead
                .   (align.right)
                  , \n (tr.,(th.," ") headCells$!headTexts)
                )
                \n
                ( tbody
                .   (align.right)
                  ,   \n
                        rows
                      $ (!headTexts.!minRowNr.!maxRowNr.!Generator)
                )
          )
        : ?Table
      & str$((XMLIO.convert)$!Table)      { Call library function to create HTML }
  )
&   makeTable
  $ ( X Y Z                               { Column headers }
    . 1                                   { Lowest row number }
    . 4                                   { Highest row number }
    .                                     { Function that generates numbers 9, 10, ...}
      ' ( cnt
        .   (cnt=$(new$(==8)))            { This creates an object 'cnt' with scope as a local function variable that survives between calls. }
          & !(cnt.)+1:?(cnt.)
        )
    )
)


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

int main()
{
	int i;
	printf("
	"
		"X	Y	Z	");
	for (i = 0; i < 4; i++) {
		printf("
%d	%d	%d	%d
", i,
			rand() % 10000, rand() % 10000, rand() % 10000);
	}
	printf("
");

	return 0;
}


using System;
using System.Text;

namespace prog
{
	class MainClass
	{
		public static void Main (string[] args)
		{
			StringBuilder s = new StringBuilder();
			Random rnd = new Random();

			s.AppendLine("
");
			s.AppendLine("
");
			s.Append("
	");
			for(int i=0; i<3; i++)
				s.Append("" + "XYZ"[i] + "	");
			s.AppendLine("
");
			s.AppendLine("
");
			s.AppendLine("
");
			for( int i=0; i<3; i++ )
			{
				s.Append("
"+i+"	");
				for( int j=0; j<3; j++ )
					s.Append(""+rnd.Next(10000)+"	");
				s.AppendLine("
");
			}
			s.AppendLine("
");
			s.AppendLine("
");

			Console.WriteLine( s );
		}
	}
}


#include <fstream>
#include <boost/array.hpp>
#include <string>
#include <cstdlib>
#include <ctime>
#include <sstream>

void makeGap( int gap , std::string & text ) {
   for ( int i = 0 ; i < gap ; i++ )
      text.append( " " ) ;
}

int main( ) {
   boost::array<char , 3> chars = { 'X' , 'Y' , 'Z' } ;
   int headgap = 3 ;
   int bodygap = 3 ;
   int tablegap = 6 ;
   int rowgap = 9 ;
   std::string tabletext( "\n" ) ;
   makeGap( headgap , tabletext ) ;
   tabletext += "\n" ;
   makeGap( bodygap , tabletext ) ;
   tabletext += "\n" ;
   makeGap( tablegap , tabletext ) ;
   tabletext += "
\n" ;
   makeGap( tablegap + 1 , tabletext ) ;
   tabletext += "
\n" ;
   makeGap( tablegap, tabletext ) ;
   tabletext += "
	" ;
   for ( int i = 0 ; i < 3 ; i++ ) {
      tabletext += "" ;
      tabletext += *(chars.begin( ) + i ) ;
      tabletext += "	" ;
   }
   tabletext += "
\n" ;
   makeGap( tablegap + 1 , tabletext ) ;
   tabletext += "
" ;
   makeGap( tablegap + 1 , tabletext ) ;
   tabletext += "
\n" ;
   srand( time( 0 ) ) ;
   for ( int row = 0 ; row < 5 ; row++ ) {
      makeGap( rowgap , tabletext ) ;
      std::ostringstream oss ;
      tabletext += "
" ;
      oss << row ;
      tabletext += oss.str( ) ;
      for ( int col = 0 ; col < 3 ; col++ ) {
	 oss.str( "" ) ;
	 int randnumber = rand( ) % 10000 ;
	 oss << randnumber ;
	 tabletext += "" ;
	 tabletext.append( oss.str( ) ) ;
	 tabletext += "	" ;
      }
      tabletext += "
\n" ;
   }
   makeGap( tablegap + 1 , tabletext ) ;
   tabletext += "
\n" ;
   makeGap( tablegap , tabletext ) ;
   tabletext += "
\n" ;
   makeGap( bodygap , tabletext ) ;
   tabletext += "\n" ;
   tabletext += "\n" ;
   std::ofstream htmltable( "testtable.html" , std::ios::out | std::ios::trunc ) ;
   htmltable << tabletext ;
   htmltable.close( ) ;
   return 0 ;
}


(ns rosettacode.html-table
  (:use 'hiccup.core))

(defn <tr> [el sq]
  [:tr (map vector (cycle [el]) sq)])

(html
  [:table
    (<tr> :th ["" \X \Y \Z])
    (for [n (range 1 4)]
      (->> #(rand-int 10000) (repeatedly 3) (cons n) (<tr> :td)))])


# This is one of many ways to create a table.  CoffeeScript plays nice
# with any templating solution built for JavaScript, and of course you
# can build tables in the browser using DOM APIs.  This approach is just
# brute force string manipulation.

table = (header_row, rows) ->
  """

  #{header_row}
  #{rows.join '\n'}

  """

tr = (cells) -> "
#{cells.join ''}
"
th = (s) -> "#{s}	"
td = (s) -> "#{s}	"
rand_n = -> Math.floor Math.random() * 10000

header_cols = ['', 'X', 'Y', 'Z']
header_row = tr (th s for s in header_cols)

rows = []
for i in [1..5]
  rows.push tr [
    th(i)
    td rand_n()
    td rand_n()
    td rand_n()
  ]

html = table header_row, rows
console.log html


F changes(amount, coins)
   V ways = [Int64(0)] * (amount + 1)
   ways[0] = 1
   L(coin) coins
      L(j) coin .. amount
         ways[j] += ways[j - coin]
   R ways[amount]

print(changes(100, [1, 5, 10, 25]))
print(changes(100000, [1, 5, 10, 25, 50, 100]))


IDENTIFICATION DIVISION.
       PROGRAM-ID. Table.
       AUTHOR.  Bill Gunshannon.
       INSTALLATION.  Home.
       DATE-WRITTEN.  1 January 2022.
      ************************************************************
      ** Program Abstract:
      **   Data values are hardcoded in this example but they
      **     could come from anywhere.  Computed, read from a
      **     file, input from the keyboard.
      ************************************************************

       ENVIRONMENT DIVISION.

       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
            SELECT Table-File ASSIGN TO "index.html"
                 ORGANIZATION IS LINE SEQUENTIAL.

       DATA DIVISION.

       FILE SECTION.

       FD  Table-File
           DATA RECORD IS Table-Record.
       01  Table-Record.
           05 Field1                  PIC X(80).

       WORKING-STORAGE SECTION.

       01  Table-Data.
           05  Line3.
               10  Line3-Value1  PIC S9(4)  VALUE  1234.
               10  Line3-Value2  PIC S9(4)  VALUE  23.
               10  Line3-Value3  PIC S9(4)  VALUE  -123.
           05  Line4.
               10  Line4-Value1  PIC S9(4)  VALUE  123.
               10  Line4-Value2  PIC S9(4)  VALUE  12.
               10  Line4-Value3  PIC S9(4)  VALUE  -1234.
           05  Line5.
               10  Line5-Value1  PIC S9(4)  VALUE  567.
               10  Line5-Value2  PIC S9(4)  VALUE  6789.
               10  Line5-Value3  PIC S9(4)  VALUE  3.

       01  Table-HTML.
           05  Line1  PIC X(16)  VALUE
               "
".
           05  Line2  PIC X(40)  VALUE
               "	X	Y	Z	".
           05  Line3.
               10  Line3-Field1  PIC X(31)  VALUE
                   "
1	".
               10  Line3-Value1   PIC -ZZZ9.
               10  Line3-Field3  PIC X(9)  VALUE
                   "	".
               10  Line3-Value2   PIC -ZZZ9.
               10  Line3-Field5  PIC X(9)  VALUE
                   "	".
               10  Line3-Value3   PIC -ZZZ9.
               10  Line3-Field5  PIC X(10)  VALUE
                   "
".
           05  Line4.
               10  Line4-Field1  PIC X(31)  VALUE
                   "
2	".
               10  Line4-Value1   PIC -ZZZ9.
               10  Line4-Field3  PIC X(9)  VALUE
                   "	".
               10  Line4-Value2   PIC -ZZZ9.
               10  Line4-Field5  PIC X(9)  VALUE
                   "	".
               10  Line4-Value3   PIC -ZZZ9.
               10  Line4-Field5  PIC X(10)  VALUE
                   "
".
           05  Line5.
               10  Line5-Field1  PIC X(31)  VALUE
                   "
3	".
               10  Line5-Value1   PIC -ZZZ9.
               10  Line5-Field3  PIC X(9)  VALUE
                   "	".
               10  Line5-Value2   PIC -ZZZ9.
               10  Line5-Field5  PIC X(9)  VALUE
                   "	".
               10  Line5-Value3   PIC -ZZZ9.
               10  Line5-Field5  PIC X(10)  VALUE
                   "
".
           05  Line6  PIC X(8)  VALUE
               "
".

       PROCEDURE DIVISION.

       Main-Program.
           OPEN OUTPUT Table-File.
           MOVE CORRESPONDING Table-Data TO Table-HTML.
           PERFORM Write-Table.
           CLOSE Table-File.
           STOP RUN.

       Write-Table.
           WRITE Table-Record FROM Line1 OF Table-HTML
                              AFTER  ADVANCING 1 LINE.
           WRITE Table-Record FROM Line2 OF Table-HTML
                              AFTER  ADVANCING 1 LINE.
           WRITE Table-Record FROM Line3 OF Table-HTML
                              AFTER  ADVANCING 1 LINE.
           WRITE Table-Record FROM Line4 OF Table-HTML
                              AFTER  ADVANCING 1 LINE.
           WRITE Table-Record FROM Line5 OF Table-HTML
                              AFTER  ADVANCING 1 LINE.
           WRITE Table-Record FROM Line6 OF Table-HTML
                              AFTER  ADVANCING 1 LINE.

       END-PROGRAM.


*        count the coins           04/09/2015
COINS    CSECT
         USING  COINS,R12
         LR     R12,R15
         L      R8,AMOUNT          npenny=amount
         L      R4,AMOUNT
         SRDA   R4,32
         D      R4,=F'5'
         LR     R9,R5              nnickle=amount/5
         L      R4,AMOUNT
         SRDA   R4,32
         D      R4,=F'10'
         LR     R10,R5             ndime=amount/10
         L      R4,AMOUNT
         SRDA   R4,32
         D      R4,=F'25'
         LR     R11,R5             nquarter=amount/25
         SR     R1,R1              count=0
         SR     R4,R4              p=0
LOOPP    CR     R4,R8              do p=0 to npenny
         BH     ELOOPP
         SR     R5,R5              n=0
LOOPN    CR     R5,R9              do n=0 to nnickle
         BH     ELOOPN
         SR     R6,R6
LOOPD    CR     R6,R10             do d=0 to ndime
         BH     ELOOPD
         SR     R7,R7              q=0
LOOPQ    CR     R7,R11             do q=0 to nquarter
         BH     ELOOPQ
         LR     R3,R5              n
         MH     R3,=H'5'
         LR     R2,R4              p
         AR     R2,R3
         LR     R3,R6              d
         MH     R3,=H'10'
         AR     R2,R3
         LR     R3,R7              q
         MH     R3,=H'25'
         AR     R2,R3              s=p+n*5+d*10+q*25
         C      R2,=F'100'         if s=100
         BNE    NOTOK
         LA     R1,1(R1)           count=count+1
NOTOK    LA     R7,1(R7)           q=q+1
         B      LOOPQ
ELOOPQ   LA     R6,1(R6)           d=d+1
         B      LOOPD
ELOOPD   LA     R5,1(R5)           n=n+1
         B      LOOPN
ELOOPN   LA     R4,1(R4)           p=p+1
         B      LOOPP
ELOOPP   XDECO  R1,PG+0            edit count
         XPRNT  PG,12              print count
         XR     R15,R15
         BR     R14
AMOUNT   DC     F'100'             start value in cents
PG       DS     CL12
         YREGS
         END    COINS


with Ada.Text_IO;

procedure Count_The_Coins is

   type Counter_Type is range 0 .. 2**63-1; -- works with gnat
   type Coin_List is array(Positive range <>) of Positive;

   function Count(Goal: Natural; Coins: Coin_List) return Counter_Type is
      Cnt: array(0 .. Goal) of Counter_Type := (0 => 1, others => 0);
      -- 0 => we already know one way to choose (no) coins that sum up to zero
      -- 1 .. Goal => we do not (yet) other ways to choose coins
   begin
      for C in Coins'Range loop
         for Amount in 1 .. Cnt'Last loop
            if Coins(C) <= Amount then
               Cnt(Amount) := Cnt(Amount) + Cnt(Amount-Coins(C));
               -- Amount-Coins(C) plus Coins(C) sums up to Amount;
            end if;
         end loop;
      end loop;
      return Cnt(Goal);
   end Count;

   procedure Print(C: Counter_Type) is
   begin
      Ada.Text_IO.Put_Line(Counter_Type'Image(C));
   end Print;

begin
   Print(Count(   1_00,          (25, 10, 5, 1)));
   Print(Count(1000_00, (100, 50, 25, 10, 5, 1)));
end Count_The_Coins;


(ql:quickload :closure-html)
(use-package :closure-html)
(serialize-lhtml
 `(table nil
	 (tr nil ,@(mapcar (lambda (x)
			     (list 'th nil x))
			   '("" "X" "Y" "Z")))
	 ,@(loop for i from 1 to 4
	      collect `(tr nil
			   (th nil ,(format nil "~a" i))
			   ,@(loop repeat 3 collect `(td nil ,(format nil "~a" (random 10000)))))))
 (make-string-sink))


void main() {
  import std.stdio, std.random;

  writeln(`<table style="text-align:center; border: 1px solid">`);
  writeln("	X	Y	Z	");
  foreach (immutable i; 0 .. 4)
    writefln("
%d	%d	%d	%d
",
             i, uniform(0,1000), uniform(0,1000), uniform(0,1000));
  writeln("
");
}


print(‘the three truths’.count(‘th’))
print(‘ababababab’.count(‘abab’))


#
  Rosetta Code "Count the coins"
  This is a direct translation of the "naive" Haskell version, using an array
  rather than a list. LWB, UPB, and array slicing makes the mapping very simple:

  LWB > UPB     <=> []
  LWB = UPB     <=> [x]
  a[LWB a]      <=> head xs
  a[LWB a + 1:] <=> tail xs
#

BEGIN
  PROC ways to make change = ([] INT denoms, INT amount) INT :
  BEGIN
    IF amount = 0 THEN
      1
    ELIF LWB denoms > UPB denoms THEN
      0
    ELIF LWB denoms = UPB denoms THEN
      (amount MOD denoms[LWB denoms] = 0 | 1 | 0)
    ELSE
      INT sum := 0;
      FOR i FROM 0 BY denoms[LWB denoms] TO amount DO
        sum +:= ways to make change(denoms[LWB denoms + 1:], amount - i)
      OD;
      sum
    FI
  END;
  [] INT denoms = (25, 10, 5, 1);
  print((ways to make change(denoms, 100), newline))
END


-- All input values must be integers and multiples of the same monetary unit.
on countCoins(amount, denominations)
    -- Potentially long list of counters, initialised with 1 (result for amount 0) and 'amount' zeros.
    script o
        property counters : {1}
    end script
    repeat amount times
        set end of o's counters to 0
    end repeat

    -- Less labour-intensive alternative to the following repeat's c = 1 iteration.
    set coinValue to beginning of denominations
    repeat with n from (coinValue + 1) to (amount + 1) by coinValue
        set item n of o's counters to 1
    end repeat

    repeat with c from 2 to (count denominations)
        set coinValue to item c of denominations
        repeat with n from (coinValue + 1) to (amount + 1)
            set item n of o's counters to (item n of o's counters) + (item (n - coinValue) of o's counters)
        end repeat
    end repeat

    return end of o's counters
end countCoins

-- Task calls:
set c1 to countCoins(100, {25, 10, 5, 1})
set c2 to countCoins(1000 * 100, {100, 50, 25, 10, 5, 1})
return {c1, c2}


program CreateHTMLTable;

{$APPTYPE CONSOLE}

uses SysUtils;

function AddTableRow(aRowNo: Integer): string;
begin
  Result := Format('
%d	%d	%d	%d
',
    [aRowNo, Random(10000), Random(10000), Random(10000)]);
end;

var
  i: Integer;
begin
  Randomize;
  Writeln('
');
  Writeln('
	X	Y	Z
');
  for i := 1 to 4 do
    Writeln(AddTableRow(i));
  Writeln('
');
  Readln;
end.


;; styles -
(style 'td "text-align:right")
(style 'table "border-spacing: 10px;border:1px solid red")
(style 'th "color:blue;")

;; generic html5 builder
;; pushes <tag style=..> (proc content) </tag>
(define  (emit-tag tag html-proc content )
		 (if (style tag)
		 	(push html (format "<%s style='%a'>" tag (style tag)))
		 	(push html (format "<%s>" tag )))
		 (html-proc content)
		 (push html (format "</%s> " tag )))

;; html procs : 1 tag, 1 proc
(define (h-raw content)
		(push html (format "%s" content)))
(define (h-header headers)
		(for ((h headers)) (emit-tag 'th h-raw h)))
(define (h-row row)
		(for ((item row)) (emit-tag 'td h-raw item)))
(define (h-table table )
	(emit-tag 'tr h-header (first table))
	;; add row-num  i at head of row
	(for ((i 1000)(row (rest table))) (emit-tag 'tr h-row (cons i row))))