$ include "seed7_05.s7i";
  include "float.s7i";

const type: matrix is array array float;

const func string: str (in matrix: mat) is func
  result
    var string: stri is "";
  local
    var integer: row is 0;
    var integer: column is 0;
  begin
    for row range 1 to length(mat) do
      for column range 1 to length(mat[row]) do
        stri &:= str(mat[row][column]);
        if column < length(mat[row]) then
          stri &:= ", ";
        end if;
      end for;
      if row < length(mat) then
        stri &:= "\n";
      end if;
    end for;
  end func;

enable_output(matrix);

const func matrix: (in matrix: mat1) * (in matrix: mat2) is func
  result
    var matrix: product is matrix.value;
  local
    var integer: row is 0;
    var integer: column is 0;
    var integer: k is 0;
  begin
    product := length(mat1) times length(mat1) times 0.0;
    for row range 1 to length(mat1) do
      for column range 1 to length(mat1) do
        product[row][column] := 0.0;
        for k range 1 to length(mat1) do
          product[row][column] +:= mat1[row][k] * mat2[k][column];
        end for;
      end for;
    end for;
  end func;

const func matrix: (in var matrix: base) ** (in var integer: exponent) is func
  result
    var matrix: power is matrix.value;
  local
    var integer: row is 0;
    var integer: column is 0;
  begin
    if exponent < 0 then
      raise NUMERIC_ERROR;
    else
      if odd(exponent) then
        power := base;
      else
        # Create identity matrix
        power := length(base) times length(base) times 0.0;
        for row range 1 to length(base) do
          for column range 1 to length(base) do
            if row = column then
              power[row][column] := 1.0;
            end if;
          end for;
        end for;
      end if;
      exponent := exponent div 2;
      while exponent > 0 do
        base := base * base;
        if odd(exponent) then
          power := power * base;
        end if;
        exponent := exponent div 2;
      end while;
    end if;
  end func;

const proc: main is func
  local
    var matrix: m is [] (
      [] (4.0, 3.0),
      [] (2.0, 1.0));
    var integer: exponent is 0;
  begin
    for exponent range [] (0, 1, 2, 3, 5, 7, 11, 13, 17, 19, 23) do
      writeln("m ** " <& exponent <& " =");
      writeln(m ** exponent);
    end for;
  end func;


class Array {
    method ** (Number n { .>= 0 }) {
        var tmp = self
        var out = self.len.of {|i| self.len.of {|j| i == j ? 1 : 0 }}
        loop {
            out = (out `mmul` tmp) if n.is_odd
            n >>= 1 || break
            tmp = (tmp `mmul` tmp)
        }
        return out
    }
}

var m = [[1, 2, 0],
         [0, 3, 1],
         [1, 0, 0]]

for order in (0..5) {
    say "### Order #{order}"
    var t = (m ** order)
    say ('  ', t.join("\n  "))
}


(1) -> A:=matrix [[0,-%i],[%i,0]]

        +0   - %i+
   (1)  |        |
        +%i   0  +
                                               Type: Matrix(Complex(Integer))
(2) -> A^4

        +1  0+
   (2)  |    |
        +0  1+
                                               Type: Matrix(Complex(Integer))
(3) -> A^(-1)

        +0   - %i+
   (3)  |        |
        +%i   0  +
                                     Type: Matrix(Fraction(Complex(Integer)))
(4) -> inverse A

        +0   - %i+
   (4)  |        |
        +%i   0  +
                          Type: Union(Matrix(Fraction(Complex(Integer))),...)


real matrix matpow(real matrix a, real scalar n) {
	real matrix p, x
	real scalar i, s
	s = n<0
	n = abs(n)
	x = a
	p = I(rows(a))
	for (i=n; i>0; i=floor(i/2)) {
		if (mod(i,2)==1) p = p*x
		x = x*x
	}
	return(s?luinv(p):p)
}


package require Tcl 8.5
namespace path {::tcl::mathop ::tcl::mathfunc}

proc matrix_exp {m pow} {
    if { ! [string is int -strict $pow]} {
        error "non-integer exponents not implemented"
    }
    if {$pow < 0} {
        error "negative exponents not implemented"
    }
    lassign [size $m] rows cols
    # assume square matrix
    set temp [identity $rows]
    for {set n 1} {$n <= $pow} {incr n} {
        set temp [matrix_multiply $temp $m]
    }
    return $temp
}

proc identity {size} {
    set i [lrepeat $size [lrepeat $size 0]]
    for {set n 0} {$n < $size} {incr n} {lset i $n $n 1}
    return $i
}


#import nat
#import lin

id  = @h ^|CzyCK33/1.! 0.!*
mex = ||[email protected] mmult:-0^|DlS/~& iota


Option Base 1
Private Function Identity(n As Integer) As Variant
    Dim I() As Variant
    ReDim I(n, n)
    For j = 1 To n
        For k = 1 To n
            I(j, k) = 0
        Next k
    Next j
    For j = 1 To n
        I(j, j) = 1
    Next j
    Identity = I
End Function
 Function MatrixExponentiation(ByVal x As Variant, ByVal n As Integer) As Variant
    If n < 0 Then
        x = WorksheetFunction.MInverse(x)
        n = -n
    End If
    If n = 0 Then
        MatrixExponentiation = Identity(UBound(x))
        Exit Function
    End If
    Dim y() As Variant
    y = Identity(UBound(x))
    Do While n > 1
        If n Mod 2 = 0 Then
            x = WorksheetFunction.MMult(x, x)
            n = n / 2
        Else
            y = WorksheetFunction.MMult(x, y)
            x = WorksheetFunction.MMult(x, x)
            n = (n - 1) / 2
        End If
    Loop
    MatrixExponentiation = WorksheetFunction.MMult(x, y)
End Function
Public Sub pp(x As Variant)
    For i_ = 1 To UBound(x)
        For j_ = 1 To UBound(x)
            Debug.Print x(i_, j_),
        Next j_
        Debug.Print
    Next i_
End Sub
Public Sub main()
    M2 = [{3,2;2,1}]
    M3 = [{1,2,0;0,3,1;1,0,0}]
    pp MatrixExponentiation(M2, -1)
    Debug.Print
    pp MatrixExponentiation(M2, 0)
    Debug.Print
    pp MatrixExponentiation(M2, 10)
    Debug.Print
    pp MatrixExponentiation(M3, 10)
End Sub


import "/matrix" for Matrix
import "/fmt" for Fmt

var m = Matrix.new([[0, 1], [1, 1]])
System.print("Original:\n")
Fmt.mprint(m, 2, 0)
System.print("\nRaised to power of 10:\n")
Fmt.mprint(m ^ 10, 3, 0)


F transpose(&matrix)
    V toRet = [[0] * matrix.len] * matrix[0].len
    L(row) (0 .< matrix.len)
        L(col) (0 .< matrix[row].len)
            toRet[col][row] = matrix[row][col]
    R toRet

V m = [[1, 2, 3, 4], [5, 6, 7, 8], [9, 10, 11, 12]]
print("Original")
print(m)
print("After Transposition")
print(transpose(&m))


...
KN       EQU    3
KM       EQU    5
N        DC     AL2(KN)
M        DC     AL2(KM)
A        DS     (KN*KM)F           matrix a(n,m)
B        DS     (KM*KN)F           matrix b(m,n)
...
*        b(j,i)=a(i,j)
*        transposition using Horner's formula
         LA     R4,0               i,from 1
         LA     R7,KN              to n
         LA     R6,1               step 1
LOOPI    BXH    R4,R6,ELOOPI       do i=1 to n
         LA     R5,0               j,from 1
         LA     R9,KM              to m
         LA     R8,1               step 1
LOOPJ    BXH    R5,R8,ELOOPJ       do j=1 to m
         LR     R1,R4              i
         BCTR   R1,0               i-1
         MH     R1,M               (i-1)*m
         LR     R2,R5              j
         BCTR   R2,0               j-1
         AR     R1,R2              r1=(i-1)*m+(j-1)
         SLA    R1,2               r1=((i-1)*m+(j-1))*itemlen
         L      R0,A(R1)           r0=a(i,j)
         LR     R1,R5              j
         BCTR   R1,0               j-1
         MH     R1,N               (j-1)*n
         LR     R2,R4              i
         BCTR   R2,0               i-1
         AR     R1,R2              r1=(j-1)*n+(i-1)
         SLA    R1,2               r1=((j-1)*n+(i-1))*itemlen
         ST     R0,B(R1)           b(j,i)=r0
         B      LOOPJ              next j
ELOOPJ   EQU    *                  out of loop j
         B      LOOPI              next i
ELOOPI   EQU    *                  out of loop i
...


Transpose2DArray_B:
	;INPUT:
	;A0 = POINTER TO SOURCE ARRAY
	;A1 = POINTER TO BACKUP AREA
	;	(YOU NEED THE SAME AMOUNT OF FREE SPACE AS THE SOURCE ARRAY.)
	;	(IT'S YOUR RESPONSIBILITY TO KNOW WHERE THAT IS.)
	;D0.W = ARRAY ROW LENGTH-1
        ;D1.W = ARRAY COLUMN HEIGHT-1

	MOVEM.L D2-D7,-(SP)
		MOVE.W D0,D4	;width - this copy is our loop counter

.outerloop:
		MOVE.W D1,D7	;height
		MOVEQ.L #0,D3
		MOVE.W D0,D6	;width - this copy is used to offset the array
		ADDQ.L #1,D6

.innerloop:
		MOVE.B (A0,D3),(A1)+
		ADD.W D6,D3
		DBRA D7,.innerloop

		ADDA.L #1,A0
		DBRA D4,.outerloop

	MOVEM.L (SP)+,D2-D7
	RTS


(defun cons-each (xs xss)
   (if (or (endp xs) (endp xss))
       nil
       (cons (cons (first xs) (first xss))
             (cons-each (rest xs) (rest xss)))))

(defun list-each (xs)
   (if (endp xs)
       nil
       (cons (list (first xs))
             (list-each (rest xs)))))

(defun transpose-list (xss)
   (if (endp (rest xss))
       (list-each (first xss))
       (cons-each (first xss)
                  (transpose-list (rest xss)))))


DEFINE PTR="CARD"

TYPE Matrix=[
  BYTE width,height
  PTR data] ;BYTE ARRAY

PROC PrintB2(BYTE b)
  IF b<10 THEN Put(32) FI
  PrintB(b)
RETURN

PROC PrintMatrix(Matrix POINTER m)
  BYTE i,j
  BYTE ARRAY d

  d=m.data
  FOR j=0 TO m.height-1
  DO
    FOR i=0 TO m.width-1
    DO
      PrintB2(d(j*m.width+i)) Put(32)
    OD
    PutE()
  OD
RETURN

PROC Create(MATRIX POINTER m BYTE w,h BYTE ARRAY a)
  m.width=w
  m.height=h
  m.data=a
RETURN

PROC Transpose(Matrix POINTER in,out)
  BYTE i,j
  BYTE ARRAY din,dout

  din=in.data
  dout=out.data
  out.width=in.height
  out.height=in.width
  FOR j=0 TO in.height-1
  DO
    FOR i=0 TO in.width-1
    DO
      dout(i*out.width+j)=din(j*in.width+i)
    OD
  OD
RETURN

PROC Main()
  MATRIX in,out
  BYTE ARRAY din(35),dout(35)
  BYTE i

  FOR i=0 TO 34
  DO
    din(i)=i
  OD
  Create(in,7,5,din)
  Create(out,0,0,dout)
  Transpose(in,out)

  PrintE("Input:")
  PrintMatrix(in)
  PutE() PrintE("Transpose:")
  PrintMatrix(out)
RETURN


function transpose( m:Array):Array
{
	//Assume each element in m is an array. (If this were production code, use typeof to be sure)

	//Each element in m is a row, so this gets the length of a row in m,
	//which is the same as the number of rows in m transpose.
	var mTranspose = new Array(m[0].length);
	for(var i:uint = 0; i < mTranspose.length; i++)
	{
                //create a row
		mTranspose[i] = new Array(m.length);
                //set the row to the appropriate values
		for(var j:uint = 0; j < mTranspose[i].length; j++)
			mTranspose[i][j] = m[j][i];
	}
	return mTranspose;
}
var m:Array = [[1, 2, 3, 10],
	       [4, 5, 6, 11],
	       [7, 8, 9, 12]];
var M:Array = transpose(m);
for(var i:uint = 0; i < M.length; i++)
	trace(M[i]);


with Ada.Numerics.Real_Arrays;  use Ada.Numerics.Real_Arrays;
with Ada.Text_IO;               use Ada.Text_IO;

procedure Matrix_Transpose is
   procedure Put (X : Real_Matrix) is
      type Fixed is delta 0.01 range -500.0..500.0;
   begin
      for I in X'Range (1) loop
         for J in X'Range (2) loop
            Put (Fixed'Image (Fixed (X (I, J))));
         end loop;
         New_Line;
      end loop;
   end Put;

   Matrix : constant Real_Matrix :=
            (  (0.0, 0.1, 0.2, 0.3),
               (0.4, 0.5, 0.6, 0.7),
               (0.8, 0.9, 1.0, 1.1)
            );
begin
   Put_Line ("Before Transposition:");
   Put (Matrix);
   New_Line;
   Put_Line ("After Transposition:");
   Put (Transpose (Matrix));
end Matrix_Transpose;


module Matrix where

open import Data.Nat
open import Data.Vec

Matrix : (A : Set) → ℕ → ℕ → Set
Matrix A m n = Vec (Vec A m) n

transpose : ∀ {A m n} → Matrix A m n → Matrix A n m
transpose [] = replicate []
transpose (xs ∷ xss) = zipWith _∷_ xs (transpose xss)

a = (1 ∷ 2 ∷ 3 ∷ []) ∷ (4 ∷ 5 ∷ 6 ∷ []) ∷ []
b = transpose a


main:(

  [,]REAL m=((1,  1,  1,   1),
             (2,  4,  8,  16),
             (3,  9, 27,  81),
             (4, 16, 64, 256),
             (5, 25,125, 625));

  OP ZIP = ([,]REAL in)[,]REAL:(
    [2 LWB in:2 UPB in,1 LWB in:1UPB in]REAL out;
    FOR i FROM LWB in TO UPB in DO
       out[,i]:=in[i,]
    OD;
    out
  );

  PROC pprint = ([,]REAL m)VOID:(
    FORMAT real fmt = $g(-6,2)$; # width of 6, with no '+' sign, 2 decimals #
     FORMAT vec fmt = $"("n(2 UPB m-1)(f(real fmt)",")f(real fmt)")"$;
    FORMAT matrix fmt = $x"("n(UPB m-1)(f(vec fmt)","lxx)f(vec fmt)");"$;
    # finally print the result #
    printf((matrix fmt,m))
  );

  printf(($x"Transpose:"l$));
  pprint((ZIP m))
)


#include<hopper.h>
#proto showarraydata(_X_)
main:
  .stack 12
  nCols=0, nRows=0,nDims=0
  A=-1,{5,11} rand array(A),mulby(10),ceil,mov(A)
  {"ORIGINAL ARRAY :\n",A}

  _show array data(A)

  /* transpose */
  TA=0,{nCols,nRows} nan array(TA)
  Limit = nRows
  {nRows}gthan(nCols) do{ Limit = nCols }

  for (i=1, {i} lethan (Limit), ++i)
     [i,i:end]get(A), [i:end,i]put(TA)
     [i:end,i]get(A), [i,i:end]put(TA)
  next
  clear mark
  {"ARRAY TRANSPOSE:\n",TA}println
  _show array data(TA)
exit(0)

.locals
show array data(A)
  {"\nSIZE ARRAY : "},size=0,size(A),cpy(size),
  dims(size,nDims)
  rows(size,nRows)
  cols(size,nCols)
  {"\nDIMENSION = ",nDims,"; ROWS = ",nRows,"; COLS = ",nCols,"\n"}, println
back


on run
    transpose([[1, 2, 3], [4, 5, 6], [7, 8, 9], [10, 11, 12]])

    --> {{1, 4, 7, 10}, {2, 5, 8, 11}, {3, 6, 9, 12}}
end run

on transpose(xss)
    set lstTrans to {}

    repeat with iCol from 1 to length of item 1 of xss
        set lstCol to {}

        repeat with iRow from 1 to length of xss
            set end of lstCol to item iCol of item iRow of xss
        end repeat

        set end of lstTrans to lstCol
    end repeat

    return lstTrans
end transpose


transpose: function [a][
    X: size a
    Y: size first a
    result: array.of: @[Y X] 0

    loop 0..X-1 'i [
        loop 0..Y-1 'j [
            result\[j]\[i]: a\[i]\[j]
        ]
    ]
    return result
]

arr: [
    [ 0 1 2 3 4  ]
    [ 5 6 7 8 9  ]
    [ 1 0 0 0 42 ]
]

loop arr 'row -> print row
print "-------------"
loop transpose arr 'row -> print row


a = a
m = 10
n = 10
Loop, 10
{
  i := A_Index - 1
  Loop, 10
  {
    j := A_Index - 1
    %a%%i%%j% := i - j
  }
}
before := matrix_print("a", m, n)
transpose("a", m, n)
after := matrix_print("a", m, n)
MsgBox % before . "`ntransposed:`n" . after
Return

transpose(a, m, n)
{
  Local i, j, row, matrix
  Loop, % m
  {
    i := A_Index - 1
    Loop, % n
    {
      j := A_Index - 1
      temp%i%%j% := %a%%j%%i%
    }
  }
  Loop, % m
  {
    i := A_Index - 1
    Loop, % n
    {
      j := A_Index - 1
      %a%%i%%j% := temp%i%%j%
    }
  }
}

matrix_print(a, m, n)
{
  Local i, j, row, matrix
  Loop, % m
  {
    i := A_Index - 1
    row := ""
    Loop, % n
    {
      j := A_Index - 1
      row .= %a%%i%%j% . ","
    }
    StringTrimRight, row, row, 1
    matrix .= row . "`n"
  }
  Return matrix
}


# syntax: GAWK -f MATRIX_TRANSPOSITION.AWK filename
{   if (NF > nf) {
        nf = NF
    }
    for (i=1; i<=nf; i++) {
        row[i] = row[i] $i " "
    }
}
END {
    for (i=1; i<=nf; i++) {
        printf("%s\n",row[i])
    }
    exit(0)
}


CLS
DIM m(1 TO 5, 1 TO 4) 'any dimensions you want

'set up the values in the array
FOR rows = LBOUND(m, 1) TO UBOUND(m, 1) 'LBOUND and UBOUND can take a dimension as their second argument
       FOR cols = LBOUND(m, 2) TO UBOUND(m, 2)
       m(rows, cols) = rows ^ cols 'any formula you want
       NEXT cols
NEXT rows

'declare the new matrix
DIM trans(LBOUND(m, 2) TO UBOUND(m, 2), LBOUND(m, 1) TO UBOUND(m, 1))

'copy the values
FOR rows = LBOUND(m, 1) TO UBOUND(m, 1)
       FOR cols = LBOUND(m, 2) TO UBOUND(m, 2)
       trans(cols, rows) = m(rows, cols)
       NEXT cols
NEXT rows

'print the new matrix
FOR rows = LBOUND(trans, 1) TO UBOUND(trans, 1)
       FOR cols = LBOUND(trans, 2) TO UBOUND(trans, 2)
       PRINT trans(rows, cols);
       NEXT cols
PRINT
NEXT rows


arraybase 1
dim matriz= {{78,19,30,12,36}, {49,10,65,42,50}, {30,93,24,78,10}, {39,68,27,64,29}}
dim mtranspuesta(matriz[,?], matriz[?,])

for fila = 1 to matriz[?,]
    for columna = 1 to matriz[,?]
		print matriz[fila, columna]; " ";
		mtranspuesta[columna, fila] = matriz[fila, columna]
	next columna
	print
next fila
print

for fila = 1 to mtranspuesta[?,]
    for columna = 1 to mtranspuesta[,?]
		print mtranspuesta[fila, columna]; " ";
    next columna
	print
next fila
end


      INSTALL @lib$+"ARRAYLIB"

      DIM matrix(3,4), transpose(4,3)
      matrix() = 78,19,30,12,36,49,10,65,42,50,30,93,24,78,10,39,68,27,64,29

      PROC_transpose(matrix(), transpose())

      FOR row% = 0 TO DIM(matrix(),1)
        FOR col% = 0 TO DIM(matrix(),2)
          PRINT ;matrix(row%,col%) " ";
        NEXT
        PRINT
      NEXT row%

      PRINT

      FOR row% = 0 TO DIM(transpose(),1)
        FOR col% = 0 TO DIM(transpose(),2)
          PRINT ;transpose(row%,col%) " ";
        NEXT
        PRINT
      NEXT row%


#include <stdio.h>

void transpose(void *dest, void *src, int src_h, int src_w)
{
	int i, j;
	double (*d)[src_h] = dest, (*s)[src_w] = src;
	for (i = 0; i < src_h; i++)
		for (j = 0; j < src_w; j++)
			d[j][i] = s[i][j];
}

int main()
{
	int i, j;
	double a[3][5] = {{ 0, 1, 2, 3, 4 },
			  { 5, 6, 7, 8, 9 },
			  { 1, 0, 0, 0, 42}};
	double b[5][3];
	transpose(b, a, 3, 5);

	for (i = 0; i < 5; i++)
		for (j = 0; j < 3; j++)
			printf("%g%c", b[i][j], j == 2 ? '\n' : ' ');
	return 0;
}


using System;
using System.Text;

namespace prog
{
	class MainClass
	{
		public static void Main (string[] args)
		{
			double[,] m = { {1,2,3},{4,5,6},{7,8,9} };

			double[,] t = Transpose( m );

			for( int i=0; i<t.GetLength(0); i++ )
			{
				for( int j=0; j<t.GetLength(1); j++ )
					Console.Write( t[i,j] + "  " );
				Console.WriteLine("");
			}
		}

		public static double[,] Transpose( double[,] m )
		{
			double[,] t = new double[m.GetLength(1),m.GetLength(0)];
			for( int i=0; i<m.GetLength(0); i++ )
				for( int j=0; j<m.GetLength(1); j++ )
					t[j,i] = m[i,j];

			return t;
		}
	}
}


#include <boost/numeric/ublas/matrix.hpp>
#include <boost/numeric/ublas/io.hpp>

int main()
{
  using namespace boost::numeric::ublas;

  matrix<double> m(3,3);

  for(int i=0; i!=m.size1(); ++i)
    for(int j=0; j!=m.size2(); ++j)
      m(i,j)=3*i+j;

  std::cout << trans(m) << std::endl;
}


(defmulti matrix-transpose
  "Switch rows with columns."
  class)

(defmethod matrix-transpose clojure.lang.PersistentList
  [mtx]
  (apply map list mtx))

(defmethod matrix-transpose clojure.lang.PersistentVector
  [mtx]
  (apply mapv vector mtx))


transpose = (matrix) ->
    (t[i] for t in matrix) for i in [0...matrix[0].length]


(defun transpose (m)
  (apply #'mapcar #'list m))


(lib 'matrix)

(define M (list->array (iota 6) 3 2))
(array-print M)
  0   1
  2   3
  4   5
(array-print (matrix-transpose M))
  0   2   4
  1   3   5


  [Demo of matrix transposition. Not in place, creates a new matrix.
   EDSAC, Initial Orders 2.]
             ..PZ      [blank tape and terminator]
             T   50 K  [to call matrix transpose subroutine with 'G X']
             P  200 F  [address of matrix transpose subroutine]
             T   47 K  [to call matrix print subroutine with 'G M']
             P  100 F  [address of matrix print subroutine]
             T   46 K  [to call print subroutine with 'G N']
             P   56 F  [address of print subroutine (EDSAC library P1)]

  [Subroutine to transpose a matrix of 17-bit real numbers, not in place.
   Caller must ensure original and transpose don't overlap.
   Parameters, all in the address field (i.e. denote n by P n F)
   10F = width (number of columns)
   11F = height (number of rows)
   12F = start address of input matrix
   13F = start address of output matrix]
             E25K  TX  GK

    [The subroutine loads elements by working down each column in turn.
     Elements are stored at consecutive locations in the transposed matrix.]
             A3F  [email protected]         [set up return to caller]
             A13F  [email protected]  [email protected]  [initialize T order for storing transpose]
             A12F  [email protected]  [email protected]  [initialize A order for loading original]
             [email protected]              [also save as A order for top of current column]
             S10 F             [negative of width]
        [10] [email protected]              [initialize negative counter]
             S11 F             [negative of height]
        [12] [email protected]              [initialize negative counter]
        [13] AF                [maunfactured order; load matrix element]
        [14] TF                [maunfactured order; store matrix element]
             [email protected]  A2F  [email protected]   [update address in T order]
             [email protected]  A10F  [email protected]  [update address in A order]
             [email protected]  A2F  [email protected]   [inner loop till finished this column]
             [email protected]  A2F  U36@  [email protected]  [update address for start of column]
             [email protected]  A2F  [email protected]   [outer loop till finished all columns]
        [31] ZF  [exit]
        [32] AF  [added to an address to make A order for that address]
        [33] TF  [added to an address to make T order for that address]
        [34] PF  [negative counter for rows]
        [35] PF  [negative counter for columns]
        [36] AF  [load order for first element in current column]

  [Subroutine to print a matrix of 17-bit real numbers.
   Straightforward, so given in condensed form.
   Parameters (in the address field, i.e. pass n as PnF):
   10F = width (number of columns)
   11F = height (number of rows)
   12F = start address of matrix
   13F = number of decimals]
               E25K  TM
    [email protected]@[email protected]@[email protected]@[email protected]@[email protected]
    GN  [call library subroutine P1]
    [email protected]@[email protected]@[email protected]@[email protected]@[email protected]&F!FMFPFPF

  [Library subroutine P1.
   Prints number in 0D to n places of decimals, where
   n is specified by 'P n F' pseudo-order after subroutine call.]
             E25K  TN
   [email protected]@[email protected]@[email protected]@[email protected]@EFU3FJFM1F

   [Main routine]
             PK T300K GK
      [Constants]
         [0] #F     [figures shift on teleprinter]
         [1] @F     [carriage return]
         [2] &F     [line feed]
         [3] P3F    [number of columns (in address field)]
         [4] P5F    [number of rows (in address field)]
         [5] P400F  [address of matrix]
         [6] P500F  [address of transposed matrix]
         [7] P2F    [number of decimals when printing matrix]
         [8] TF     [add to address to make T order]
         [9] P328F  [0.0100097...., matrix elements are multiples of this]
      [Variables]
        [10] PF     [matrix element, initialized to 0.00]
        [11] PF     [negative counter]

           [Enter with acc = 0]
        [12] [email protected]     [set figures mode on teleprinter]
             [email protected]    [address of matrix]
             [email protected]    [make T order to store first elememt]
             [email protected]   [plant in code]
             [email protected]  [email protected]  L64F  L32F  [acc := negative number of entries]
        [20] [email protected]   [initialize negative counter]
             [email protected]  [email protected]  [email protected]  [increment matrix element]
        [24] TF               [store in matrix]
             [email protected]  A2F  [email protected]  [inc store address]
             [email protected]  A2F  [email protected]  [inc negative counter, loop till zero]

           [Matrix is set up, now print it]
             [email protected]  T10F  [10F := width]
             [email protected]  T11F  [11F := height]
             [email protected]  T12F  [12F := address of matrix]
             [email protected]  T13F  [13F := number of decimals]
        [39] [email protected]  GM   [call print subroutine]
             [email protected]  [email protected]   [add CR LF]

           [Transpose matrix: 10F, 11F, 12F stay the same]
             [email protected]  T13F  [13F := address of transpose]
        [45] [email protected]  GX   [call transpose routine]

           [Print transpose]
             A10F  TF  A11F  T10F  AF  T11F  [swap width and height]
             A13F  T12F [12F := address of transpose]
             [email protected]  T13F  [13F := number of decimals]
        [57] [email protected]  GM   [call print subroutine]

             [email protected]    [figures mode, dummy to flush teleprinter buffer]
             ZF    [stop]
             E12Z  [enter at 12 (relative)]
             PF    [accumulator = 0 on entry]


MAC TRANSPOSE = ([INT n][INT m]TYPE t: matrix) -> [m][n]t:
  [INT i = 1..m] [INT j = 1..n] matrix[j][i].


(require 'cl-lib)

(defun transpose (m)
  (apply #'cl-mapcar #'list m))

;;test for transposition function
(transpose '((2 3 4 5) (3 5 6 9) (9 9 9 9)))


-module(transmatrix).
-export([trans/1,transL/1]).

% using built-ins hd = head, tl = tail

trans([[]|_]) -> [];
trans(M) ->
  [ lists:map(fun hd/1, M) | transpose( lists:map(fun tl/1, M) ) ].

% Purist version

transL( [ [Elem | Rest] | List] ) ->
    [ [Elem | [H || [H | _] <- List] ] |
      transL( [Rest |
                      [ T || [_ | T] <- List ] ]
       ) ];
transL([ [] | List] ) -> transL(List);
transL([]) -> [].


function transpose(sequence in)
    sequence out
    out = repeat(repeat(0,length(in)),length(in[1]))
    for n = 1 to length(in) do
        for m = 1 to length(in[1]) do
            out[m][n] = in[n][m]
        end for
    end for
    return out
end function

sequence m
m = {
  {1,2,3,4},
  {5,6,7,8},
  {9,10,11,12}
}

? transpose(m)


let transpose (mtx : _ [,]) = Array2D.init (mtx.GetLength 1) (mtx.GetLength 0) (fun x y -> mtx.[y,x])


S" fsl-util.fs" REQUIRED
S" fsl/dynmem.seq" REQUIRED
: F+! ( addr -- ) ( F: r -- )  DUP [email protected] F+ F! ;
: FSQR ( F: r1 -- r2 ) FDUP F* ;
S" fsl/gaussj.seq" REQUIRED

5 3 float matrix a{{
1e 2e 3e  4e 5e 6e  7e 8e 9e  10e 11e 12e  13e 14e 15e  5 3 a{{ }}fput
float dmatrix b{{

a{{ 5 3 & b{{ transpose
3 5 b{{ }}fprint


integer, parameter   :: n = 3, m = 5
real, dimension(n,m) :: a = reshape( (/ (i,i=1,n*m) /), (/ n, m /) )
real, dimension(m,n) :: b

b = transpose(a)

do i = 1, n
    print *, a(i,:)
end do

do j = 1, m
    print *, b(j,:)
end do


Dim matriz(0 To 3, 0 To 4) As Integer = {{78,19,30,12,36},_
{49,10,65,42,50},_
{30,93,24,78,10},_
{39,68,27,64,29}}
Dim As Integer mtranspuesta(Lbound(matriz, 2) To Ubound(matriz, 2), Lbound(matriz, 1) To Ubound(matriz, 1))
Dim As Integer fila, columna

For fila = Lbound(matriz,1) To Ubound(matriz,1)
    For columna = Lbound(matriz,2) To Ubound(matriz,2)
        mtranspuesta(columna, fila) = matriz(fila, columna)
        Print ; matriz(fila,columna); " ";
    Next columna
    Print
Next fila
Print

For fila = Lbound(mtranspuesta,1) To Ubound(mtranspuesta,1)
    For columna = Lbound(mtranspuesta,2) To Ubound(mtranspuesta,2)
        Print ; mtranspuesta(fila,columna); " ";
    Next columna
    Print
Next fila
Sleep


package main

import (
    "fmt"

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

func main() {
    m := mat.NewDense(2, 3, []float64{
        1, 2, 3,
        4, 5, 6,
    })
    fmt.Println(mat.Formatted(m))
    fmt.Println()
    fmt.Println(mat.Formatted(m.T()))
}


def matrix = [ [ 1, 2, 3, 4 ],
               [ 5, 6, 7, 8 ] ]

matrix.each { println it }
println()
def transpose = matrix.transpose()

transpose.each { println it }


REAL :: mtx(2, 4)

mtx = 1.1 * $
WRITE() mtx

SOLVE(Matrix=mtx, Transpose=mtx)
WRITE() mtx


uses lists;
dec transpose : list (list alpha) -> list (list alpha);
--- transpose ([]::_) <= [];
--- transpose n <= map head n :: transpose (map tail n);


procedure transpose_matrix (matrix)
  result := []
  # for each column
  every (i := 1 to *matrix[1]) do {
    col := []
    # extract the number in each row for that column
    every (row := !matrix) do put (col, row[i])
    # and push that column as a row in the result matrix
    put (result, col)
  }
  return result
end

procedure print_matrix (matrix)
  every (row := !matrix) do {
    every writes (!row || " ")
    write ()
  }
end

procedure main ()
  matrix := [[1,2,3],[4,5,6]]
  write ("Start:")
  print_matrix (matrix)
  transposed := transpose_matrix (matrix)
  write ("Transposed:")
  print_matrix (transposed)
end


import java.util.Arrays;
public class Transpose{
       public static void main(String[] args){
               double[][] m = {{1, 1, 1, 1},
                               {2, 4, 8, 16},
                               {3, 9, 27, 81},
                               {4, 16, 64, 256},
                               {5, 25, 125, 625}};
               double[][] ans = new double[m[0].length][m.length];
               for(int rows = 0; rows < m.length; rows++){
                       for(int cols = 0; cols < m[0].length; cols++){
                               ans[cols][rows] = m[rows][cols];
                       }
               }
               for(double[] i:ans){//2D arrays are arrays of arrays
                       System.out.println(Arrays.toString(i));
               }
       }
}


function Matrix(ary) {
    this.mtx = ary
    this.height = ary.length;
    this.width = ary[0].length;
}

Matrix.prototype.toString = function() {
    var s = []
    for (var i = 0; i < this.mtx.length; i++)
        s.push( this.mtx[i].join(",") );
    return s.join("\n");
}

// returns a new matrix
Matrix.prototype.transpose = function() {
    var transposed = [];
    for (var i = 0; i < this.width; i++) {
        transposed[i] = [];
        for (var j = 0; j < this.height; j++) {
            transposed[i][j] = this.mtx[j][i];
        }
    }
    return new Matrix(transposed);
}

var m = new Matrix([[1,1,1,1],[2,4,8,16],[3,9,27,81],[4,16,64,256],[5,25,125,625]]);
print(m);
print();
print(m.transpose());


DEFINE transpose == [ [null] [true] [[null] some] ifte ]
                    [ pop [] ]
                    [ [[first] map] [[rest] map] cleave ]
                    [ cons ]
                    linrec .


def transpose:
  if (.[0] | length) == 0 then []
  else [map(.[0])] + (map(.[1:]) | transpose)
  end ;


/* Matrix transposition, multiplication, identity, and exponentiation, in Jsish */
function Matrix(ary) {
    this.mtx = ary;
    this.height = ary.length;
    this.width = ary[0].length;
}

Matrix.prototype.toString = function() {
    var s = [];
    for (var i = 0; i < this.mtx.length; i++) s.push(this.mtx[i].join(","));
    return s.join("\n");
};

// returns a transposed matrix
Matrix.prototype.transpose = function() {
    var transposed = [];
    for (var i = 0; i < this.width; i++) {
        transposed[i] = [];
        for (var j = 0; j < this.height; j++) transposed[i][j] = this.mtx[j][i];
    }
    return new Matrix(transposed);
};

// returns a matrix as the product of two others
Matrix.prototype.mult = function(other) {
    if (this.width != other.height) throw "error: incompatible sizes";

    var result = [];
    for (var i = 0; i < this.height; i++) {
        result[i] = [];
        for (var j = 0; j < other.width; j++) {
            var sum = 0;
            for (var k = 0; k < this.width; k++) sum += this.mtx[i][k] * other.mtx[k][j];
            result[i][j] = sum;
        }
    }
    return new Matrix(result);
};

// IdentityMatrix is a "subclass" of Matrix
function IdentityMatrix(n) {
    this.height = n;
    this.width = n;
    this.mtx = [];
    for (var i = 0; i < n; i++) {
        this.mtx[i] = [];
        for (var j = 0; j < n; j++) this.mtx[i][j] = (i == j ? 1 : 0);
    }
}
IdentityMatrix.prototype = Matrix.prototype;

// the Matrix exponentiation function
Matrix.prototype.exp = function(n) {
    var result = new IdentityMatrix(this.height);
    for (var i = 1; i <= n; i++) result = result.mult(this);
    return result;
};

provide('Matrix', '0.60');


julia> [1 2 3 ; 4 5 6]  # a 2x3 matrix
2x3 Array{Int64,2}:
 1  2  3
 4  5  6

julia> [1 2 3 ; 4 5 6]'  # note the quote
3x2 LinearAlgebra.Adjoint{Int64,Array{Int64,2}}:
 1  4
 2  5
 3  6


// version 1.1.3

typealias Vector = DoubleArray
typealias Matrix = Array<Vector>

fun Matrix.transpose(): Matrix {
    val rows = this.size
    val cols = this[0].size
    val trans = Matrix(cols) { Vector(rows) }
    for (i in 0 until cols) {
        for (j in 0 until rows) trans[i][j] = this[j][i]
    }
    return trans
}

// Alternate version
typealias Matrix<T> = List<List<T>>
fun <T> Matrix<T>.transpose(): Matrix<T> {
    return (0 until this[0].size).map { x ->
        (this.indices).map { y ->
            this[y][x]
        }
    }
}


12 iota [3 4] reshape 1 + dup .
1 transpose .


(defun transpose (matrix)
  (transpose matrix '()))

(defun transpose (matrix acc)
  (cond
    ((lists:any
        (lambda (x) (== x '()))
        matrix)
     acc)
    ('true
      (let ((heads (lists:map #'car/1 matrix))
            (tails (lists:map #'cdr/1 matrix)))
        (transpose tails (++ acc `(,heads)))))))


MatrixC$ ="4, 3,          0, 0.10, 0.20, 0.30,       0.40, 0.50, 0.60, 0.70,      0.80, 0.90, 1.00, 1.10"

print "Transpose of matrix"
call DisplayMatrix MatrixC$
print "         ="
MatrixT$ =MatrixTranspose$( MatrixC$)
call DisplayMatrix MatrixT$


function Transpose( m )
    local res = {}

    for i = 1, #m[1] do
        res[i] = {}
        for j = 1, #m do
            res[i][j] = m[j][i]
        end
    end

    return res
end

-- a test for Transpose(m)
mat = { { 1, 2, 3 }, { 4, 5, 6 } }
erg = Transpose( mat )
for i = 1, #erg do
    for j = 1, #erg[1] do
        io.write( erg[i][j] )
        io.write( "  " )
    end
    io.write( "\n" )
end


M := <<2,3>|<3,4>|<5,6>>;

M^%T;

with(LinearAlgebra):
Transpose(M);


m = bigMatrix 5 4
for i in 1 to 5 do for j in 1 to 4 do m[i][j] = pow i j
m = transpose m


proc transpose[X, Y; T](s: array[Y, array[X, T]]): array[X, array[Y, T]] =
  for i in low(X)..high(X):
    for j in low(Y)..high(Y):
      result[i][j] = s[j][i]

let b = [[ 0, 1, 2, 3, 4],
         [ 5, 6, 7, 8, 9],
         [ 1, 0, 0, 0,42]]
let c = transpose(b)
for r in c:
  for i in r:
    stdout.write i, " "
  echo ""


bundle Default {
  class Transpose {
    function : Main(args : String[]) ~ Nil {
      input := [[1, 1, 1, 1]
        [2, 4, 8, 16]
        [3, 9, 27, 81]
        [4, 16, 64, 256]
        [5, 25, 125, 625]];
      dim := input->Size();

      output := Int->New[dim[0],dim[1]];
      for(i := 0; i < dim[0]; i+=1;) {
        for(j := 0; j < dim[1]; j+=1;) {
          output[i,j] := input[i,j];
        };
      };

      Print(output);
    }

    function : Print(matrix : Int[,]) ~ Nil {
      dim := matrix->Size();
      for(i := 0; i < dim[0]; i+=1;) {
        for(j := 0; j < dim[1]; j+=1;) {
          IO.Console->Print(matrix[i,j])->Print('\t');
        };
        '\n'->Print();
      };
    }
  }
}


open Bigarray

let transpose b =
  let dim1 = Array2.dim1 b
  and dim2 = Array2.dim2 b in
  let kind = Array2.kind b
  and layout = Array2.layout b in
  let b' = Array2.create kind layout dim2 dim1 in
  for i=0 to pred dim1 do
    for j=0 to pred dim2 do
      b'.{j,i} <- b.{i,j}
    done;
  done;
  (b')
;;

let array2_display print newline b =
  for i=0 to Array2.dim1 b - 1 do
    for j=0 to Array2.dim2 b - 1 do
      print b.{i,j}
    done;
    newline();
  done;
;;

let a = Array2.of_array int c_layout [|
  [| 1; 2; 3; 4 |];
  [| 5; 6; 7; 8 |];
|]

array2_display (Printf.printf " %d") print_newline (transpose a) ;;


function Transpose(double *A,*B, sys nx,ny)
'==========================================
  sys x,y
  indexbase 0
  for x=0 to <nx
    for y=0 to <ny
      B[y*nx+x]=A[x*ny+y]
    next
  next
end function

function MatrixShow(double*A, sys nx,ny) as string
'=================================================
  sys x,y
  indexbase 0
  string pr="",tab=chr(9),cr=chr(13)+chr(10)
  for y=0 to <ny
    for x=0 to <nx
      pr+=tab A[x*ny+y]
    next
    pr+=cr
  next
  return pr
end function

'====
'DEMO
'====

double A[5*4],B[4*5]
'columns x
'rows    y

A <= 'y minor, x major
11,12,13,14,15,
21,22,23,24,25,
31,32,33,34,35,
41,42,43,44,45

print MatrixShow A,5,4
Transpose        A,B,5,4
print MatrixShow B,4,5


Program Transpose;

const
  A: array[1..3,1..5] of integer = (( 1,  2,  3,  4,  5),
                                    ( 6,  7,  8,  9, 10),
				    (11, 12, 13, 14, 15)
				   );
var
  B: array[1..5,1..3] of integer;
  i, j: integer;

begin
  for i := low(A) to high(A) do
    for j := low(A[1]) to high(A[1]) do
      B[j,i] := A[i,j];

  writeln ('A:');
  for i := low(A) to high(A) do
  begin
    for j := low(A[1]) to high(A[1]) do
      write (A[i,j]:3);
    writeln;
  end;

  writeln ('B:');
  for i := low(B) to high(B) do
  begin
    for j := low(B[1]) to high(B[1]) do
      write (B[i,j]:3);
    writeln;
  end;
end.


with javascript_semantics
function matrix_transpose(sequence mat)
    integer rows = length(mat),
            cols = length(mat[1])
    sequence res = repeat(repeat(0,rows),cols)
    for r=1 to rows do
        for c=1 to cols do
            res[c][r] = mat[r][c]
        end for
    end for
    return res
end function


function transpose($m) {
  if (count($m) == 0) // special case: empty matrix
    return array();
  else if (count($m) == 1) // special case: row matrix
    return array_chunk($m[0], 1);

  // array_map(NULL, m[0], m[1], ..)
  array_unshift($m, NULL); // the original matrix is not modified because it was passed by value
  return call_user_func_array('array_map', $m);
}


import util.

go =>
  M = [[0.0, 0.1, 0.2, 0.3],
       [0.4, 0.5, 0.6, 0.7],
       [0.8, 0.9, 1.0, 1.1]],
  print_matrix(M),

  M2 = [[a,b,c,d,e],
        [f,g,h,i,j],
        [k,l,m,n,o],
        [p,q,r,s,t],
        [u,v,w,z,y]],
  print_matrix(M2),

  M3 = make_matrix(1..24,8),
  print_matrix(M3),
  nl.

%
% Print original matrix and its transpose
%
print_matrix(M) =>
  println("Matrix:"),
  foreach(Row in M) println(Row) end,
  println("\nTransposed:"),
  foreach(Row in M.transpose()) println(Row) end,
  nl.

%
% Make a matrix of list L with Rows rows
% (and L.length div Rows columns)
%
make_matrix(L,Rows) = M =>
  M = [],
  Cols = L.length div Rows,
  foreach(I in 1..Rows)
     NewRow = new_list(Cols),
     foreach(J in 1..Cols)
       NewRow[J] := L[ (I-1)*Cols + J]
     end,
     M := M ++ [NewRow]
  end.


(de matTrans (Mat)
   (apply mapcar Mat list) )

(matTrans '((1 2 3) (4 5 6)))


/* The short method: */
declare A(m, n) float, B (n,m) float defined (A(2sub, 1sub));
/* Any reference to B gives the transpose of matrix A. */


define transpose(m) -> res;
    lvars bl = boundslist(m);
    if length(bl) /= 4 then
        throw([need_2d_array ^a])
    endif;
    lvars i, i0 = bl(1), i1 = bl(2);
    lvars j, j0 = bl(3), j1 = bl(4);
    newarray([^j0 ^j1 ^i0 ^i1], 0) -> res;
    for i from i0 to i1 do
        for j from j0 to j1 do
            m(i, j) -> res(j, i);
        endfor;
    endfor;
enddefine;


/transpose {
    [ exch {
        { {empty? exch pop} map all?} {pop exit} ift
        [ exch {} {uncons {exch cons} dip exch} fold counttomark 1 roll] uncons
    } loop ] {reverse} map
}.


#COMPILE EXE
#DIM ALL
#COMPILER PBCC 6
'----------------------------------------------------------------------
SUB TransposeMatrix(InitMatrix() AS DWORD, TransposedMatrix() AS DWORD)
LOCAL l1, l2, u1, u2 AS LONG
  l1 = LBOUND(InitMatrix, 1)
  l2 = LBOUND(InitMatrix, 2)
  u1 = UBOUND(InitMatrix, 1)
  u2 = UBOUND(InitMatrix, 2)
  REDIM TransposedMatrix(l2 TO u2, l1 TO u1)
  MAT TransposedMatrix() = TRN(InitMatrix())
END SUB
'----------------------------------------------------------------------
SUB PrintMatrix(a() AS DWORD)
LOCAL l1, l2, u1, u2, r, c AS LONG
LOCAL s AS STRING * 8
  l1 = LBOUND(a(), 1)
  l2 = LBOUND(a(), 2)
  u1 = UBOUND(a(), 1)
  u2 = UBOUND(a(), 2)
  FOR r = l1 TO u1
    FOR c = l2 TO u2
      RSET s = STR$(a(r, c))
      CON.PRINT s;
    NEXT c
  CON.PRINT
  NEXT r
END SUB
'----------------------------------------------------------------------
SUB TranspositionDemo(BYVAL DimSize1 AS DWORD, BYVAL DimSize2 AS DWORD)
LOCAL r, c, cc AS DWORD
LOCAL a() AS DWORD
LOCAL b() AS DWORD
  cc = DimSize2
  DECR DimSize1
  DECR DimSize2
  REDIM a(0 TO DimSize1, 0 TO DimSize2)
  FOR r = 0 TO DimSize1
    FOR c = 0 TO DimSize2
      a(r, c)= (cc * r) + c + 1
    NEXT c
  NEXT r
  CON.PRINT "initial matrix:"
  PrintMatrix a()
  TransposeMatrix a(), b()
  CON.PRINT "transposed matrix:"
  PrintMatrix b()
END SUB
'----------------------------------------------------------------------
FUNCTION PBMAIN () AS LONG
  TranspositionDemo 3, 3
  TranspositionDemo 3, 7
END FUNCTION


% transposition of a rectangular matrix
% e.g.   [[1,2,3,4], [5,6,7,8]]
% give [[1,5],[2,6],[3,7],[4,8]]

transpose(In, Out) :-
    In = [H | T],
    maplist(initdl, H, L),
    work(T, In, Out).

% we use the difference list to make "quick" appends (one inference)
initdl(V, [V | X] - X).

work(Lst, [H], Out) :-
	maplist(my_append_last, Lst, H, Out).

work(Lst, [H | T], Out) :-
    maplist(my_append, Lst, H, Lst1),
    work(Lst1, T, Out).

my_append(X-Y, C, X1-Y1) :-
    append_dl(X-Y, [C | U]- U, X1-Y1).

my_append_last(X-Y, C, X1) :-
	append_dl(X-Y, [C | U]- U, X1-[]).

% "quick" append
append_dl(X-Y, Y-Z, X-Z).


Procedure transposeMatrix(Array a(2), Array trans(2))
  Protected rows, cols

  Protected ar = ArraySize(a(), 1) ;rows in original matrix
  Protected ac = ArraySize(a(), 2) ;cols in original matrix

  ;size the matrix receiving the transposition
  Dim trans(ac, ar)

  ;copy the values
  For rows = 0 To ar
    For cols = 0 To ac
      trans(cols, rows) = a(rows, cols)
    Next
  Next
EndProcedure

Procedure displayMatrix(Array a(2), text.s = "")
  Protected i, j
  Protected cols = ArraySize(a(), 2), rows = ArraySize(a(), 1)

  PrintN(text + ": (" + Str(rows + 1) + ", " + Str(cols + 1) + ")")
  For i = 0 To rows
    For j = 0 To cols
      Print(LSet(Str(a(i, j)), 4, " "))
    Next
    PrintN("")
  Next
  PrintN("")
EndProcedure

;setup a matrix of arbitrary size
Dim m(random(5), random(5))

Define rows, cols
;fill matrix with 'random' data
For rows = 0 To ArraySize(m(),1)      ;ArraySize() can take a dimension as its second argument
  For cols = 0 To ArraySize(m(), 2)
    m(rows, cols) = random(10) - 10
  Next
Next

Dim t(0,0) ;this will be resized during transposition
If OpenConsole()
  displayMatrix(m(), "matrix before transposition")
  transposeMatrix(m(), t())
  displayMatrix(t(), "matrix after transposition")

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


  [ ' [ [ ] ]
    over 0 peek size of
    [] rot
    witheach join
    witheach
      [ dip behead
        nested join
        nested join ] ] is transpose ( [ --> [ )

  ' [ [ 1 2 ] [ 3 4 ] [ 5 6 ] ]
  dup echo cr cr
  transpose dup echo cr cr
  transpose echo cr


#lang racket
(require math)
(matrix-transpose (matrix [[1 2] [3 4]]))


# Transposition can be done with the reduced zip meta-operator
# on list-of-lists data structures

say [Z] (<A B C D>, <E F G H>, <I J K L>);

# For native shaped arrays, a more traditional procedure of copying item-by-item
# Here the resulting matrix is also a native shaped array

my @a[3;4] =
  [
    [<A B C D>],
    [<E F G H>],
    [<I J K L>],
  ];

(my $n, my $m) = @a.shape;
my @b[$m;$n];
for ^$m X ^$n -> (\i, \j) {
   @b[i;j] = @a[j;i];
}

say @b;


/*REXX program transposes any sized rectangular matrix, displays before & after matrices*/
@.=;     @.1 =   1.02     2.03      3.04       4.05        5.06         6.07          7.08
         @.2 = 111     2222     33333     444444     5555555     66666666     777777777
w=0
                             do    row=1  while @.row\==''
                                do col=1  until @.row==''; parse var @.row A.row.col @.row
                                w=max(w, length(A.row.col) )    /*max width for elements*/
                                end   /*col*/                   /*(used to align ouput).*/
                             end      /*row*/    /* [↑]  build matrix A from the @ lists*/
row= row-1                                       /*adjust for  DO  loop index increment.*/
                             do    j=1  for row  /*process each    row    of the matrix.*/
                                do k=1  for col  /*   "      "    column   "  "     "   */
                                B.k.j= A.j.k     /*transpose the  A  matrix  (into  B). */
                                end   /*k*/
                             end      /*j*/
call showMat  'A', row, col                      /*display the   A   matrix to terminal.*/
call showMat  'B', col, row                      /*   "     "    B      "    "     "    */
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
showMat: arg mat,rows,cols;     say;       say center( mat  'matrix',  (w+1)*cols +4, "─")
                 do      r=1  for rows;    _=                                  /*newLine*/
                      do c=1  for cols;    _=_ right( value( mat'.'r"."c), w)  /*append.*/
                      end   /*c*/
                 say _                                                         /*1 line.*/
                 end        /*r*/;         return


mtrx$ ="4, 3,   0, 0.10, 0.20, 0.30,   0.40, 0.50, 0.60, 0.70,  0.80, 0.90, 1.00, 1.10"

print "Transpose of matrix"
call DisplayMatrix mtrx$
print "         ="
MatrixT$ =MatrixTranspose$(mtrx$)
call DisplayMatrix MatrixT$

end

function MatrixTranspose$(in$)
  w	= val(word$(in$, 1, ","))    '   swap w and h parameters
  h	= val(word$(in$, 2, ","))
  t$	= str$(h); ","; str$(w); ","
  for i =1 to w
    for j =1 to h
      t$ = t$ +word$(in$, 2 +i +(j -1) *w, ",") +","
    next j
  next i
MatrixTranspose$ =left$(t$, len(t$) -1)
end function

sub DisplayMatrix in$   '   Display looking like a matrix!
html "
"
  w	= val(word$(in$, 1, ","))
  h	= val(word$(in$, 2, ","))
  for i =0 to h -1
   html "
"
   for j =1 to w
      term$	= word$(in$, j +2 +i *w, ",")
      html "";val(term$);"	"
    next j
html "
"
next i
html "
"
end sub


struct Matrix {
    dat: [[i32; 3]; 3]
}

impl Matrix {
    pub fn transpose_m(a: Matrix) -> Matrix
    {
        let mut out = Matrix {
            dat: [[0, 0, 0],
                  [0, 0, 0],
                  [0, 0, 0]
                  ]
        };

        for i in 0..3{
            for j in 0..3{

                    out.dat[i][j] = a.dat[j][i];
            }
        }

        out
    }

    pub fn print(self)
    {
        for i in 0..3 {
            for j in 0..3 {
                print!("{} ", self.dat[i][j]);
            }
            print!("\n");
        }
    }
}

fn main()
{
    let  a = Matrix {
        dat: [[1, 2, 3],
              [4, 5, 6],
              [7, 8, 9] ]
    };

let c = Matrix::transpose_m(a);
    c.print();
}


scala> Array.tabulate(4)(i => Array.tabulate(4)(j => i*4 + j))
res12: Array[Array[Int]] = Array(Array(0, 1, 2, 3), Array(4, 5, 6, 7), Array(8, 9, 10, 11), Array(12, 13, 14, 15))

scala> res12.transpose
res13: Array[Array[Int]] = Array(Array(0, 4, 8, 12), Array(1, 5, 9, 13), Array(2, 6, 10, 14), Array(3, 7, 11, 15))

scala> res12 map (_ map ("%2d" format _) mkString " ") mkString "\n"
res16: String =
 0  1  2  3
 4  5  6  7
 8  9 10 11
12 13 14 15

scala> res13 map (_ map ("%2d" format _) mkString " ") mkString "\n"
res17: String =
 0  4  8 12
 1  5  9 13
 2  6 10 14
 3  7 11 15


(define (transpose m)
  (apply map list m))


$ include "seed7_05.s7i";
  include "float.s7i";

const type: matrix is array array float;

const func matrix: transpose (in matrix: aMatrix) is func
  result
    var matrix: transposedMatrix is matrix.value;
  local
    var integer: i is 0;
    var integer: j is 0;
  begin
    transposedMatrix := length(aMatrix[1]) times length(aMatrix) times 0.0;
    for i range 1 to length(aMatrix) do
      for j range 1 to length(aMatrix[1]) do
        transposedMatrix[j][i] := aMatrix[i][j];
      end for;
    end for;
  end func;

const proc: write (in matrix: aMatrix) is func
  local
    var integer: line is 0;
    var integer: column is 0;
  begin
    for line range 1 to length(aMatrix) do
      for column range 1 to length(aMatrix[line]) do
        write(" " <& aMatrix[line][column] digits 2);
      end for;
      writeln;
    end for;
  end func;

const matrix: testMatrix is [] (
    [] (0.0, 0.1, 0.2, 0.3),
    [] (0.4, 0.5, 0.6, 0.7),
    [] (0.8, 0.9, 1.0, 1.1));

const proc: main is func
  begin
    writeln("Before Transposition:");
    write(testMatrix);
    writeln;
    writeln("After Transposition:");
    write(transpose(testMatrix));
  end func;


function transpose(A) {
    return map(range(sizeof A), function(k, idx) {
        return map(A, function(k, row) {
            return row[idx];
        });
    });
}


@inlinable
public func matrixTranspose<T>(_ matrix: [[T]]) -> [[T]] {
  guard !matrix.isEmpty else {
    return []
  }

  var ret = Array(repeating: [T](), count: matrix[0].count)

  for row in matrix {
    for j in 0..<row.count {
      ret[j].append(row[j])
    }
  }

  return ret
}

@inlinable
public func printMatrix<T>(_ matrix: [[T]]) {
  guard !matrix.isEmpty else {
    print()

    return
  }

  let rows = matrix.count
  let cols = matrix[0].count

  for i in 0..<rows {
    for j in 0..<cols {
      print(matrix[i][j], terminator: " ")
    }

    print()
  }
}

let m1 = [
  [1, 2, 3],
  [4, 5, 6]
]

print("Input:")
printMatrix(m1)

let m2 = matrixTranspose(m1)

print("Output:")
printMatrix(m2)


templates transpose
  def a: $;
  [1..$a(1)::length -> $a(1..last;$)] !
end transpose

templates printMatrix&{w:}
  templates formatN
    @: [];
    $ -> #
    '[email protected] -> $::length~..$w -> ' ';[email protected](last..1:-1)...;' !
    when <1..> do ..|@: $ mod 10; $ ~/ 10 -> #
  end formatN
  $... -> '|$(1) -> formatN;$(2..last)... -> ', $ -> formatN;';|
' !
end printMatrix

def m: [[1, 2, 3, 4], [5, 6, 7, 8], [9, 10, 11, 12]];
'before:
' -> !OUT::write
$m -> printMatrix&{w:2} -> !OUT::write

def mT: $m -> transpose;
'
transposed:
' -> !OUT::write
$mT -> printMatrix&{w:2} -> !OUT::write


package require Tcl 8.5
namespace path ::tcl::mathfunc

proc size {m} {
    set rows [llength $m]
    set cols [llength [lindex $m 0]]
    return [list $rows $cols]
}
proc transpose {m} {
    lassign [size $m] rows cols
    set new [lrepeat $cols [lrepeat $rows ""]]
    for {set i 0} {$i < $rows} {incr i} {
        for {set j 0} {$j < $cols} {incr j} {
            lset new $j $i [lindex $m $i $j]
        }
    }
    return $new
}
proc print_matrix {m {fmt "%.17g"}} {
    set max [widest $m $fmt]
    lassign [size $m] rows cols
    for {set i 0} {$i < $rows} {incr i} {
        for {set j 0} {$j < $cols} {incr j} {
	    set s [format $fmt [lindex $m $i $j]]
            puts -nonewline [format "%*s " [lindex $max $j] $s]
        }
        puts ""
    }
}
proc widest {m {fmt "%.17g"}} {
    lassign [size $m] rows cols
    set max [lrepeat $cols 0]
    for {set i 0} {$i < $rows} {incr i} {
        for {set j 0} {$j < $cols} {incr j} {
	    set s [format $fmt [lindex $m $i $j]]
            lset max $j [max [lindex $max $j] [string length $s]]
        }
    }
    return $max
}

set m {{1 1 1 1} {2 4 8 16} {3 9 27 81} {4 16 64 256} {5 25 125 625}}
print_matrix $m "%d"
print_matrix [transpose $m] "%d"


OPTION BASE 0
DIM matriz(3, 4)
DATA 78, 19, 30, 12, 36
DATA 49, 10, 65, 42, 50
DATA 30, 93, 24, 78, 10
DATA 39, 68, 27, 64, 29

FOR f = 0 TO 3
    FOR c = 0 TO 4
        READ matriz(f, c)
    NEXT c
NEXT f

DIM mtranspuesta(0 TO 4, 0 TO 3)

FOR fila = LBOUND(matriz,1) TO UBOUND(matriz,1)
    FOR columna = LBOUND(matriz,2) TO UBOUND(matriz,2)
        LET mtranspuesta(columna, fila) = matriz(fila, columna)
        PRINT matriz(fila, columna);
    NEXT columna
    PRINT
NEXT fila
PRINT

FOR fila = LBOUND(mtranspuesta,1) TO UBOUND(mtranspuesta,1)
    FOR columna = LBOUND(mtranspuesta,2) TO UBOUND(mtranspuesta,2)
        PRINT mtranspuesta(fila, columna);
    NEXT columna
    PRINT
NEXT fila
END


Function transpose(m As Variant) As Variant
    transpose = WorksheetFunction.transpose(m)
End Function


'create and display the initial matrix
WScript.StdOut.WriteLine "Initial Matrix:"
x = 4 : y = 6 : n = 1
Dim matrix()
ReDim matrix(x,y)
For i = 0 To y
	For j = 0 To x
		matrix(j,i) = n
		If j < x Then
			WScript.StdOut.Write n & vbTab
		Else
			WScript.StdOut.Write n
		End If
		n = n + 1
	Next
	WScript.StdOut.WriteLine
Next

'display the trasposed matrix
WScript.StdOut.WriteBlankLines(1)
WScript.StdOut.WriteLine "Transposed Matrix:"
For i = 0 To x
	For j = 0 To y
		If j < y Then
			WScript.StdOut.Write matrix(i,j) & vbTab
		Else
			WScript.StdOut.Write matrix(i,j)
		End If
	Next
	WScript.StdOut.WriteLine
Next


Option Explicit
'----------------------------------------------------------------------
Function TransposeMatrix(InitMatrix() As Long, TransposedMatrix() As Long)
Dim l1 As Long, l2 As Long, u1 As Long, u2 As Long, r As Long, c As Long
  l1 = LBound(InitMatrix, 1)
  l2 = LBound(InitMatrix, 2)
  u1 = UBound(InitMatrix, 1)
  u2 = UBound(InitMatrix, 2)
  ReDim TransposedMatrix(l2 To u2, l1 To u1)
  For r = l1 To u1
    For c = l2 To u2
      TransposedMatrix(c, r) = InitMatrix(r, c)
    Next c
  Next r
End Function
'----------------------------------------------------------------------
Sub PrintMatrix(a() As Long)
Dim l1 As Long, l2 As Long, u1 As Long, u2 As Long, r As Long, c As Long
Dim s As String * 8
  l1 = LBound(a(), 1)
  l2 = LBound(a(), 2)
  u1 = UBound(a(), 1)
  u2 = UBound(a(), 2)
  For r = l1 To u1
    For c = l2 To u2
      RSet s = Str$(a(r, c))
      Debug.Print s;
    Next c
  Debug.Print
  Next r
End Sub
'----------------------------------------------------------------------
Sub TranspositionDemo(ByVal DimSize1 As Long, ByVal DimSize2 As Long)
Dim r, c, cc As Long
Dim a() As Long
Dim b() As Long
  cc = DimSize2
  DimSize1 = DimSize1 - 1
  DimSize2 = DimSize2 - 1
  ReDim a(0 To DimSize1, 0 To DimSize2)
  For r = 0 To DimSize1
    For c = 0 To DimSize2
      a(r, c) = (cc * r) + c + 1
    Next c
  Next r
  Debug.Print "initial matrix:"
  PrintMatrix a()
  TransposeMatrix a(), b()
  Debug.Print "transposed matrix:"
  PrintMatrix b()
End Sub
'----------------------------------------------------------------------
Sub Main()
  TranspositionDemo 3, 3
  TranspositionDemo 3, 7
End Sub


import "/matrix" for Matrix
import "/fmt" for Fmt

var m = Matrix.new([
    [ 1,  2,  3],
    [ 4,  5,  6],
    [ 7,  8,  9],
    [10, 11, 12]
])

System.print("Original:\n")
Fmt.mprint(m, 2, 0)
System.print("\nTransposed:\n")
Fmt.mprint(m.transpose, 2, 0)


proc Transpose(M, R, C, N);     \Transpose matrix M to N
int  M, R, C, N;                \rows and columns
int  I, J;
[for I:= 0 to R-1 do
    for J:= 0 to C-1 do
        N(J,I):= M(I,J);
];

proc ShowMat(M, R, C);          \Display matrix M
int  M, R, C;                   \rows and columns
int  I, J;
[for I:= 0 to R-1 do
    [for J:= 0 to C-1 do
        RlOut(0, float(M(I,J)));
    CrLf(0);
    ];
];

int M, N(4,3);
[M:= [[1, 2, 3, 4],             \3 rows by 4 columns
      [5, 6, 7, 8],
      [9,10,11,12]];
Format(4, 0);
ShowMat(M, 3, 4);
CrLf(0);
Transpose(M, 3, 4, N);
ShowMat(N, 4, 3);
]


dim matriz(4,5)
dim mtranspuesta(5,4)

for fila = 1 to arraysize(matriz(), 1)
    for columna = 1 to arraysize(matriz(), 2)
	    read matriz(fila, columna)
		print matriz(fila, columna);
		mtranspuesta(columna, fila) = matriz(fila, columna)
	next columna
	print
next fila
print

for fila = 1 to arraysize(mtranspuesta(), 1)
    for columna = 1 to arraysize(mtranspuesta(), 2)
		print mtranspuesta(fila, columna);
    next columna
	print
next fila
end

data 78,19,30,12,36
data 49,10,65,42,50
data 30,93,24,78,10
data 39,68,27,64,29


var [const] GSL=Import("zklGSL");	// libGSL (GNU Scientific Library)
GSL.Matrix(2,3).set(1,2,3, 4,5,6).transpose().format(5).println();  // in place
println("---");
GSL.Matrix(2,2).set(1,2, 3,4).transpose().format(5).println();  // in place
println("---");
GSL.Matrix(3,1).set(1,2,3).transpose().format(5).println();  // in place


module MatrixOps;
type
	Matrix = array {math} *,* of integer;

	procedure WriteMatrix(x: array {math} *,* of integer);
	var
		i,j: integer;
	begin
		for i := 0 to len(x,0) - 1 do
			for j := 0 to len(x,1) - 1 do
				write(x[i,j]);
			end;
			writeln;
		end
	end WriteMatrix;

	procedure Transposition;
	var
		m,x: Matrix;
	begin
		m := [[1,2,3],[3,4,5]]; (* matrix initialization *)
		x := !m; (* matrix trasposition *)
		WriteMatrix(x);
	end Transposition;

begin
	Transposition;
end MatrixOps.


F encode(correct, guess)
   [String] output_arr

   L(i) 0 .< correct.len
      output_arr [+]= I guess[i] == correct[i] {‘X’} E I guess[i] C correct {‘O’} E ‘-’

   R output_arr

F safe_int_input(prompt, min_val, max_val)
   L
      V user_input_str = input(prompt)

      X.try
         V user_input = Int(user_input_str)
         I user_input C min_val .. max_val
            R user_input
      X.catch ValueError
         L.continue

F play_game()
   print(‘Welcome to Mastermind.’)
   print(‘You will need to guess a random code.’)
   print(‘For each guess, you will receive a hint.’)
   print(‘In this hint, X denotes a correct letter, and O a letter in the original string but in a different position.’)
   print()

   V number_of_letters = safe_int_input(‘Select a number of possible letters for the code (2-20): ’, 2, 20)
   V code_length = safe_int_input(‘Select a length for the code (4-10): ’, 4, 10)

   V letters = ‘ABCDEFGHIJKLMNOPQRST’[0 .< number_of_letters]
   V code = ‘’
   L 0 .< code_length
      code ‘’= random:choice(letters)
   [String] guesses

   L
      print()
      V guess = input(‘Enter a guess of length #. (#.): ’.format(code_length, letters)).uppercase()

      I guess.len != code_length | any(guess.map(char -> char !C @letters))
         L.continue
      E I guess == code
         print("\nYour guess "guess‘ was correct!’)
         L.break
      E
         guesses.append(‘#.: #. => #.’.format(guesses.len + 1, Array(guess).join(‘ ’), encode(code, guess).join(‘ ’)))

      L(i_guess) guesses
         print(‘------------------------------------’)
         print(i_guess)
      print(‘------------------------------------’)

play_game()


DEFINE MINCOLORS="2"
DEFINE MAXCOLORS="20"
DEFINE MINLENGTH="4"
DEFINE MAXLENGTH="10"
DEFINE MINGUESS="7"
DEFINE MAXGUESS="20"
TYPE Score=[BYTE spot,corr,err]
TYPE Settings=[BYTE colors,length,guesses,repeat]

PROC GetSettings(Settings POINTER s)
  CHAR ARRAY tmp(10)

  DO
    PrintF("Enter number of colors (%B-%B):",MINCOLORS,MAXCOLORS)
    s.colors=InputB()
  UNTIL s.colors>=MINCOLORS AND s.colors<=MAXCOLORS
  OD
  DO
    PrintF("Enter length of code (%B-%B):",MINLENGTH,MAXLENGTH)
    s.length=InputB()
  UNTIL s.length>=MINLENGTH AND s.length<=MAXLENGTH
  OD
  DO
    PrintF("Enter max number of guesses (%B-%B):",MINGUESS,MAXGUESS)
    s.guesses=InputB()
  UNTIL s.guesses>=MINGUESS AND s.guesses<=MAXGUESS
  OD
  IF s.colors<s.length THEN
    s.repeat=1
  ELSE
    DO
      Print("Allow repeated colors (Y/N):")
      InputS(tmp)
      IF tmp(0)=1 THEN
        IF tmp(1)='y OR tmp(1)='Y THEN
          s.repeat=1 EXIT
        ELSEIF tmp(1)='n OR tmp(1)='N THEN
          s.repeat=0 EXIT
        FI
      FI
    OD
  FI
RETURN

PROC Generate(CHAR ARRAY code Settings POINTER s)
  CHAR ARRAY col(MAXCOLORS)
  BYTE i,j,d,tmp,count

  FOR i=0 TO MAXCOLORS-1
  DO
    col(i)=i+'A
  OD
  code(0)=s.length
  count=s.colors
  FOR i=1 TO s.length
  DO
    d=Rand(count)
    code(i)=col(d)
    IF s.repeat=0 THEN
      count==-1
      col(d)=col(count)
    FI
  OD
RETURN

BYTE FUNC GetCount(CHAR ARRAY s CHAR c)
  BYTE i,count

  count=0
  FOR i=1 TO s(0)
  DO
    IF s(i)=c THEN
      count==+1
    FI
  OD
RETURN (count)

PROC CheckScore(CHAR ARRAY code,guess
  Settings POINTER s Score POINTER res)
  BYTE i,j,codeCount,guessCount

  res.spot=0
  res.corr=0
  IF guess(0)#s.length THEN
    res.err=1
    RETURN
  FI
  res.err=0

  FOR i=0 TO s.colors-1
  DO
    codeCount=GetCount(code,i+'A)
    guessCount=GetCount(guess,i+'A)
    IF codeCount<guessCount THEN
      res.corr==+codeCount
    ELSE
      res.corr==+guessCount
    FI
  OD
  FOR i=1 TO s.length
  DO
    IF guess(i)=code(i) THEN
      res.spot==+1
      res.corr==-1
    FI
  OD
RETURN

PROC ToUpper(CHAR ARRAY s)
  BYTE i,c

  IF s(0)=0 THEN RETURN FI
  FOR i=1 TO s(0)
  DO
    c=s(i)
    IF c>='a AND c<='z THEN
      s(i)=c-'a+'A
    FI
  OD
RETURN

PROC PrintScore(Score POINTER res Settings POINTER s)
  INT i

  FOR i=1 TO res.spot
  DO Put('X) OD
  FOR i=1 TO res.corr
  DO Put('O) OD
  FOR i=1 TO s.length-res.spot-res.corr
  DO Put('-) OD
RETURN

PROC Main()
  CHAR ARRAY code(MAXLENGTH+1),guess(255)
  Score res
  Settings s
  BYTE tries

  PrintE("Mastermind") PutE()
  GetSettings(s) PutE()
  Generate(code,s)
  tries=s.guesses
  PrintF("Enter your guess (%B tries):%E",tries)
  DO
    InputS(guess) ToUpper(guess)
    CheckScore(code,guess,s,res)
    Put(28) ;cursor up
    PrintF("%S -> ",guess)
    IF res.err THEN
      Print("Wrong input")
    ELSE
      PrintScore(res,s)
      IF res.spot=s.length THEN
        PutE() PutE()
        PrintE("You won!")
        EXIT
      FI
      tries==-1
      IF tries=0 THEN
        PutE() PutE()
        PrintE("You lost!")
        EXIT
      FI
    FI
    PrintF(", try again (%B tries):%E",tries)
  OD
RETURN


with Ada.Text_IO;
with Ada.Numerics.Discrete_Random;
with Ada.Strings.Fixed;
with Ada.Containers.Ordered_Sets;

use Ada.Strings.Fixed;

procedure MasterMind
is
   subtype Color_Number is Positive range 2 .. 20;
   subtype Code_Size is Positive range 4 .. 10;
   subtype Guesses_Number is Positive range 7 .. 20;
   subtype Color is Character range 'A' .. 'T';

   function Hint(correct, guess : in String) return String
   is
      Xs : Natural := 0;
      Os : Natural := 0;
      to_display : String(1 .. correct'Length) := (others => '-');
   begin
      for I in guess'Range loop
         if guess(I) = correct(I) then
            Xs := Xs + 1;
            to_display(I) := 'X';
         end if;
      end loop;
      for I in guess'Range loop
         if to_display(I) = '-' then
            for J in correct'Range loop
               if J /= I and to_display(J) /= 'X' and correct(J) = guess(I) then
                  Os := Os + 1;
                  exit;
               end if;
            end loop;
         end if;
      end loop;
      return Xs * 'X' & Os * 'O' & (guess'Length - Xs - Os) * '-';
   end Hint;

   generic
      type Data is (<>);
   function Input(message : in String) return Data;
   -- Input will loop until a correct value is given by the user.
   -- For each wrong input, the program will prompt the range of expected values.

   function Input(message : in String) return Data is
   begin
      loop
         Ada.Text_IO.Put(message);
         declare
            S : constant String := Ada.Text_IO.Get_Line;
         begin
            return Data'Value(S);
         exception
            when Constraint_Error =>
               Ada.Text_IO.New_Line;
               Ada.Text_IO.Put_Line("Invalid input!");
               Ada.Text_IO.Put_Line
                 ("Expected values in range:"
                  & Data'First'Img & " .." & Data'Last'Img);
               Ada.Text_IO.New_Line;
         end;
      end loop;
   end;

   function Input_Color_Number is new Input(Color_Number);
   function Input_Code_Size is new Input(Code_Size);
   function Input_Guesses_Number is new Input(Guesses_Number);
   function Input_Boolean is new Input(Boolean);

   CN : constant Color_Number := Input_Color_Number("How many colors? ");
   GN : constant Guesses_Number := Input_Guesses_Number("How many guesses? ");
   CS : constant Code_Size := Input_Code_Size("Size of the code? ");
   repeats : Boolean := Input_Boolean("With repeats? ");
   -- Not constant: if Color < Code_Size, we will have repetitions anyway.

   subtype Actual_Colors is Color range Color'First .. Color'Val(Color'Pos(Color'First) + CN - 1);
   package Actual_Colors_Sets is new Ada.Containers.Ordered_Sets(Element_Type => Actual_Colors);

   package Color_Random is new Ada.Numerics.Discrete_Random(Result_Subtype => Actual_Colors);
   generator : Color_Random.Generator;

   function Random return String
   is
      C : String(1 .. CS);
      seen : Actual_Colors_Sets.Set;
   begin
      for I in C'Range loop
         C(I) := Color_Random.Random(generator);
         while (not repeats) and seen.Contains(C(I)) loop
            C(I) := Color_Random.Random(generator);
         end loop;
         seen.Include(C(I));
      end loop;
      return C;
   end Random;

   function Get_Code return String is
   begin
      loop
         Ada.Text_IO.Put("> ");
         declare
            input : constant String := Ada.Text_IO.Get_Line;
         begin
            if input'Length /= CS then
               raise Constraint_Error;
            end if;
            for C of input loop
               if C not in Actual_Colors then
                  raise Constraint_Error;
               end if;
            end loop;
            return input;
         exception
            when Constraint_Error =>
               Ada.Text_IO.New_Line;
               Ada.Text_IO.Put_Line("Invalid input!");
               Ada.Text_IO.New_Line;
         end;
      end loop;
   end Get_Code;

   found : Boolean := False;
begin
   if (not repeats) and (CN < CS) then
      Ada.Text_IO.Put_Line("Not enough colors! Using repeats anyway.");
      repeats := True;
   end if;

   Color_Random.Reset(generator);

   declare
      answer : constant String := Random;
      previous : array(1 .. GN) of String(1 .. CS*2);
   begin
      for I in 1 .. GN loop
         declare
            guess : constant String := Get_Code;
         begin
            if guess = answer then
               Ada.Text_IO.Put_Line("You won, congratulations!");
               found := True;
            else
               previous(I) := guess & Hint(answer, guess);
               Ada.Text_IO.Put_Line(44 * '-');
               for J in 1 .. I loop
                  Ada.Text_IO.Put_Line
                    (previous(J)(1 .. CS)
                     & " => " & previous(J)(CS+1 .. previous(J)'Last));
               end loop;
               Ada.Text_IO.Put_Line(44 * '-');
               Ada.Text_IO.New_Line;
            end if;
         end;
         exit when found;
      end loop;
      if not found then
         Ada.Text_IO.Put_Line("You lost, sorry! The answer was: " & answer);
      end if;
   end;
end MasterMind;


#!/usr/local/bin/apl -s -f --

⍝ Define the alphabet
A←'ABCDEFGHIJKLMNOPQRSTUVWXYZ'

⍝ Make ASCII values upper case
∇n←AscUp c
        n←c-32×(c≥97)∧(c≤122)
∇

⍝ Does a list have repeated values?
∇r←Rpts l
        r←(l⍳l)≢⍳⍴l
∇

⍝ Keyboard input using ⎕ and ⍞ doesn't work well using GNU APL in script mode,
⍝ so you kind of have to write your own.
⍝ Read a line of text from the keyboard
∇l←ReadLine up;k;z;data
        data←'' ⋄ csr←0 ⍝ Start out with empty string and cursor at 0

        ⍝⍝⍝ Keyboard input
in:     k←1⎕fio[41]1    ⍝ Read byte from stdin
handle: →(k>127)/skip   ⍝ Unicode is not supported (Wumpus doesn't need it)
        →(k∊8 127)/back ⍝ Handle backspace
        →(k=10)/done    ⍝ Newline = Enter key pressed
        →(k<32)/in      ⍝ For simplicity, disregard terminal control entirely

        k←(AscUp⍣up)k   ⍝ Make key uppercase if necessary
        z←k⎕fio[42]0    ⍝ Echo key to stdout
        data←data,k     ⍝ Insert key into data
        →in             ⍝ Go get next key

        ⍝⍝⍝ Skip UTF-8 input (read until byte ≤ 127)
skip:   k←1⎕fio[41]1 ⋄ →(k>127)/skip ⋄ →handle

        ⍝⍝ Backspace
back:   →(0=⍴data)/in   ⍝ If already at beginning, ignore
        z←k⎕fio[42]0    ⍝ Backspace to terminal
        data←¯1↓data    ⍝ Remove character
        →in             ⍝ Get next key

        ⍝⍝ We are done, return the line as text
done:   l←⎕UCS data
∇

⍝ Read a positive number from the keyboard in the range [min...max]
∇n←min ReadNum max;l;z
in:     l←ReadLine 0
        z←10⎕fio[42]0
        →(~l∧.∊'0123456789')/no
        →((min≤n)∧max≥n←⍎l)/0
no:     ⍞←'Please enter a number between ',(⍕min),' and ',(⍕max),': '
        →in
∇

⍝ Ask a numeric question
∇n←q Question lim;min;max
        (min max)←lim
        ⍞←q,' [',(⍕min),'..',(⍕max),']? '
        n←min ReadNum max
∇

⍝ Read a choice from the keyboard
∇c←Choice cs;ks;k;z
        ks←AscUp ⎕UCS ↑¨cs              ⍝ User should press first letter of choice
in:     →(~(k←AscUp 1⎕fio[41]1)∊ks)/in  ⍝ Wait for user to make choice
        z←(c←⊃cs[↑ks⍳k])⎕fio[42]0       ⍝ Select and output correspoinding choice
∇

⍝ Ask the user for game parameters
∇parms←InitGame;clrs;len;gss;rpts
        ⎕←'∘∘∘ MASTERMIND ∘∘∘' ⋄ ⎕←''
        clrs←'How many colors' Question 2 20
        len←'Code length' Question 4 10
        gss←'Maximum amount of guesses' Question 7 20
        ⍞←'Allow repeated colors in code (Y/N)? '
        rpts←'Yes'≡Choice 'Yes' 'No'
        parms←clrs len gss rpts
∇

⍝ Generate a code.
∇c←rpts MakeCode parms;clrs;len
        (clrs len)←parms
        c←A[(1+rpts)⊃(len?clrs)(?len/clrs)]
∇

⍝ Let user make a guess and handle errors
∇g←parms Guess code;clrs;rpts;l;right;in
        (clrs rpts num)←parms

guess:  ⍞←'Guess ',(¯2↑⍕num),': ' ⋄ g←ReadLine 1      ⍝ Read a guess from the keyboard

        ⍝ Don't count obvously invalid input against the user
        →((⍴code)≢⍴g)/len               ⍝ Length is wrong
        →(~g∧.∊A[⍳clrs])/inv            ⍝ Invalid code in input
        →((~rpts)∧Rpts g)/rpt           ⍝ No repeats allowed

        ⍝ Give feedback
        right←g=code                    ⍝ Colors in right position
        in←g∊code                       ⍝ Colors not in right position
        fb←(+/right)/'X'                ⍝ X = amount of matching ones
        fb←fb,(+/in∧~right)/'O'         ⍝ O = amount of non-matching ones
        fb←fb,(+/~in)/'-'               ⍝ - = amount of colors not in code
        ⍞←' --→ ',fb,⎕UCS 10
        →0
len:    ⎕←'Invalid length.' ⋄ →guess
inv:    ⎕←'Invalid color.' ⋄ →guess
rpt:    ⎕←'No repeats allowed.' ⋄ →guess
∇

⍝ Play the game
∇ Mastermind;clrs;len;gsmax;rpts;code;gs
        ⎕rl←(2*32)|×/⎕ts                ⍝ initialize random seed
        (clrs len gsmax rpts)←InitGame
        code←rpts MakeCode clrs len
        ⎕←2 0⍴''
        ⎕←'The code consists of: ',A[⍳clrs]
        gs←0
loop:   gs←gs+1
        →(gs>gsmax)/lose
        →(code≢(clrs rpts gs)Guess code)/loop
        ⎕←'○○○ Congratulations! ○○○'
        ⎕←'You won in ',(⍕gs),' guesses.'
        →0
lose:   ⎕←'Alas, you are out of guesses.'
        ⎕←'The code was: ',code
∇

Mastermind
)OFF


w := h := 32, maxRows := 10, numPegs := 8
ww := floor(w/2-2), hh := floor(h/2-2)
grid := [], dx := w*4.5
gosub, Decode

Gui, Font, S18, Consolas
loop, 4
{
	i := A_Index-1
	Gui, add, button, % "x" (Mod(i, 4)?"+0":"30") " y"
					.	(Mod(i, 4)?"10" : "10") " w" w " h" h " vGoal" A_Index , ?
}

Gui, Add, Text, % "section x30 h1 0x1000 w" w*6
loop, % maxRows
{
	Gui, Font, S18, consolas
	row := maxRows - A_Index + 1
	loop 4
	{
		col := A_Index, 	i:= col-1
		Gui, add, button, % "x" (Mod(i, 4)?"+0":"s") " y" (Mod(i, 4)?"p":"+2")
						. " w" w " h" h " vButton" row "_" col " gButton"
	}
	Gui, Font, S13, wingdings 2
	loop 2
	{
		col := A_Index, 	i:= col-1
		Gui, add, text, % "x" (Mod(i,2)?"+1":"s+" dx) " y" (Mod(i,2)?"p":"p+1")
						. " w" ww " h" hh " vKeyPeg" row "_" col, % Chr(167)
	}
	loop 2
	{
		col := A_Index+2, 	i:= col-1
		Gui, add, text, % "x" (Mod(i,2)?"+1":"s+" dx) " y" (Mod(i,2)?"p":"+1")
						. " w" ww " h" hh " vKeyPeg" row "_" col, % Chr(167)
	}
	Gui, Add, Text, % "section xs h1 0x1000 w" w*6 " y+4"
}
Gui, Font, S12, consolas
Gui, add, Button, % "xs y+10 gSubmit w" W*2 , Submit
Gui, add, Button, % "x+0 gResetMM w" W*2, Reset
Gui, add, Checkbox, % "x+4 vNoDup", No`nDuplicates
Gui, Font, S18
for i, v in pegs
	Gui, add, Radio, % "x" (!Mod(i-1, 4)?"10":"+10") " h" h " w" w+20 " vRadio" A_Index, % v
Gui, show
Row := 1
return
;-----------------------------------------------------------------------
GuiClose:
ExitApp
return
;-----------------------------------------------------------------------
Decode:
Gui, Submit, NoHide
pegs:=[], goal := [], usedPeg :=[]
pool := ["😺","🎃","🧨","⚽","😀","☠","👽","❄","🙉","💗"
	,"💥","🖐","🏈","🎱","👁","🗨","🤙","👄","🐶","🐴"
	,"🦢","🐍","🐞","💣","🐪","🐘","🐰","🐸","🌴","🏀"]

loop, % numPegs
{
	Random, rnd, 1, % pool.count()
	pegs[A_Index] := pool.RemoveAt(rnd)
}
i := 1
while (goal.count()<4)
{
	Random, rnd, 1, % pegs.count()
	if (NoDup && usedPeg[pegs[rnd]])
		continue
	goal[i++] := pegs[rnd]
	usedPeg[pegs[rnd]] := true
}
return
;-----------------------------------------------------------------------
Button:
if GameEnd
	return

Gui, Submit, NoHide
RegExMatch(A_GuiControl, "Button(\d+)_(\d+)", m)
if (m1 <> row)
{
	thisPeg := Grid[m1, m2]
	for i, v in pegs
		if (v=thisPeg)
			GuiControl,, Radio%i%, 1
	GuiControl,, % "Button" row "_" m2, % thisPeg
	Grid[row,m2] := thisPeg
}
else
{
	loop, % pegs.count()
		if Radio%A_Index%
			GuiControl,, % A_GuiControl , % grid[m1, m2] := pegs[A_Index]
}
return
;-----------------------------------------------------------------------
Submit:
if (grid[row].count()<4) || GameEnd
	return

Gui, submit, NoHide
Ans := [], FIP := [], inGoal := []
CIP := CNP := 0, KeyPeg := 1

for i, G in Goal
	inGoal[G] := (inGoal[G] ? inGoal[G] : 0) +1		; save inGoal
loop, 4
	Ans[A_Index] := Grid[row, A_Index]			; save Ans
for i, A in Ans
	if (goal[A_Index] = A)
		CIP++, FIP.push(i), inGoal[A]:=inGoal[A] -1	; Correct In Place, inGoal--
for i, v in FIP
	Ans.RemoveAt(v-i+1)					; remove Correct In Place from Answers
for i, A in Ans
	if (inGoal[A] > 0)
		CNP++, inGoal[A] := inGoal[A] -1		; Correct Not in Place
loop % CIP
	GuiControl,, % "KeyPeg" row "_" KeyPeg++, % Chr(82)	; "✔"
loop % CNP
	GuiControl,, % "KeyPeg" row "_" KeyPeg++, % Chr(83)	; "X"

if (CIP=4 || row=maxRows)
{
	loop 4
		GuiControl,, Goal%A_Index%, % Goal[A_Index]
	MsgBox % CIP = 4 ? "You Win" : "You lose"
	GameEnd := true
}
Row++
return
;-----------------------------------------------------------------------
LAlt:: ; peak at solution (for troubleshooting purposes only!)
loop 4
	GuiControl,, Goal%A_Index%, % Goal[A_Index]
While GetKeyState("Lalt", "P")
	continue
loop 4
	GuiControl,, Goal%A_Index%, % "?"
return
;-----------------------------------------------------------------------
ResetMM:
Grid :=[], GameEnd:= false
loop, 4
{
	Random, rnd, 1, % pegs.count()
	goal[A_Index] := pegs[rnd]
	GuiControl,, Goal%A_Index%, ?
}

loop, % maxRows
{
	row := maxRows - A_Index + 1
	loop 4
	{
		col := A_Index
		GuiControl,, % "KeyPeg" row "_" col, % Chr(167)	; "O"
		GuiControl,, % "Button" row "_" col
	}
}
gosub Decode
loop, 8
	GuiControl,, Radio%A_Index%, % pegs[A_Index]
return
;-----------------------------------------------------------------------


#include <iostream>
#include <algorithm>
#include <ctime>
#include <string>
#include <vector>

typedef std::vector<char> vecChar;

class master {
public:
    master( size_t code_len, size_t clr_count, size_t guess_count, bool rpt ) {
        std::string color = "ABCDEFGHIJKLMNOPQRST";

        if( code_len < 4 ) code_len = 4; else if( code_len > 10 ) code_len = 10;
        if( !rpt && clr_count < code_len ) clr_count = code_len;
        if( clr_count < 2 ) clr_count = 2; else if( clr_count > 20 ) clr_count = 20;
        if( guess_count < 7 ) guess_count = 7; else if( guess_count > 20 ) guess_count = 20;

        codeLen = code_len; colorsCnt = clr_count; guessCnt = guess_count; repeatClr = rpt;

        for( size_t s = 0; s < colorsCnt; s++ ) {
            colors.append( 1, color.at( s ) );
        }
    }
    void play() {
        bool win = false;
        combo = getCombo();

        while( guessCnt ) {
            showBoard();
            if( checkInput( getInput() ) ) {
                win = true;
                break;
            }
            guessCnt--;
        }
        if( win ) {
            std::cout << "\n\n--------------------------------\n" <<
                "Very well done!\nYou found the code: " << combo <<
                "\n--------------------------------\n\n";
        } else {
            std::cout << "\n\n--------------------------------\n" <<
                "I am sorry, you couldn't make it!\nThe code was: " << combo <<
                "\n--------------------------------\n\n";
        }
    }
private:
    void showBoard() {
        vecChar::iterator y;
        for( int x = 0; x < guesses.size(); x++ ) {
            std::cout << "\n--------------------------------\n";
            std::cout << x + 1 << ": ";
            for( y = guesses[x].begin(); y != guesses[x].end(); y++ ) {
                std::cout << *y << " ";
            }

            std::cout << " :  ";
            for( y = results[x].begin(); y != results[x].end(); y++ ) {
                std::cout << *y << " ";
            }

            int z = codeLen - results[x].size();
            if( z > 0 ) {
                for( int x = 0; x < z; x++ ) std::cout << "- ";
            }
        }
        std::cout << "\n\n";
    }
    std::string getInput() {
        std::string a;
        while( true ) {
            std::cout << "Enter your guess (" << colors << "): ";
            a = ""; std::cin >> a;
            std::transform( a.begin(), a.end(), a.begin(), ::toupper );
            if( a.length() > codeLen ) a.erase( codeLen );
            bool r = true;
            for( std::string::iterator x = a.begin(); x != a.end(); x++ ) {
                if( colors.find( *x ) == std::string::npos ) {
                    r = false;
                    break;
                }
            }
            if( r ) break;
        }
        return a;
    }
    bool checkInput( std::string a ) {
        vecChar g;
        for( std::string::iterator x = a.begin(); x != a.end(); x++ ) {
            g.push_back( *x );
        }
        guesses.push_back( g );

        int black = 0, white = 0;
        std::vector<bool> gmatch( codeLen, false );
        std::vector<bool> cmatch( codeLen, false );

        for( int i = 0; i < codeLen; i++ ) {
            if( a.at( i ) == combo.at( i ) ) {
                gmatch[i] = true;
                cmatch[i] = true;
                black++;
            }
        }

        for( int i = 0; i < codeLen; i++ ) {
            if (gmatch[i]) continue;
            for( int j = 0; j < codeLen; j++ ) {
                if (i == j || cmatch[j]) continue;
                if( a.at( i ) == combo.at( j ) ) {
                    cmatch[j] = true;
                    white++;
                    break;
                }
            }
        }

        vecChar r;
        for( int b = 0; b < black; b++ ) r.push_back( 'X' );
        for( int w = 0; w < white; w++ ) r.push_back( 'O' );
        results.push_back( r );

        return ( black == codeLen );
    }
    std::string getCombo() {
        std::string c, clr = colors;
        int l, z;

        for( size_t s = 0; s < codeLen; s++ ) {
            z = rand() % ( int )clr.length();
            c.append( 1, clr[z] );
            if( !repeatClr ) clr.erase( z, 1 );
        }
        return c;
    }

    size_t codeLen, colorsCnt, guessCnt;
    bool repeatClr;
    std::vector<vecChar> guesses, results;
    std::string colors, combo;
};

int main( int argc, char* argv[] ) {
    srand( unsigned( time( 0 ) ) );
    master m( 4, 8, 12, false );
    m.play();
    return 0;
}


col[] = [ 802 990 171 229 950 808 ]
len code[] 4
len guess[] 4
#
subr init_vars
  row = 7
.
func draw_rate r black white . .
  for j range 2
    for c range 2
      move c * 3.5 + 71.5 r * 11.5 + 10.4 + j * 3.5
      if black > 0
        color 000
        circle 1.4
        black -= 1
      elif white > 0
        color 999
        circle 1.4
        white -= 1
      else
        color 310
        circle 0.7
      .
    .
  .
.
func show_code . .
  color 531
  move 22 0
  rect 46 8
  for i range 4
    move i * 8 + 28 3
    color col[code[i]]
    circle 2
  .
.
func draw_guess . .
  for c range 4
    move c * 12 + 20 row * 11.5 + 12
    color col[guess[c]]
    circle 3.8
  .
.
func next_row . .
  color 420
  linewidth 11
  move 17 row * 11.5 + 12
  line 60 row * 11.5 + 12
  call draw_guess
  move 73.5 row * 11.5 + 12
  color 310
  circle 5.0
  color 753
  move 71.5 row * 11.5 + 8.5
  textsize 7
  text "✓"
.
func rate . .
  move 73.5 row * 11.5 + 12
  color 531
  circle 5.2
  c[] = code[]
  g[] = guess[]
  for i range 4
    if c[i] = g[i]
      black += 1
      c[i] = -1
      g[i] = -2
    .
  .
  for i range 4
    for j range 4
      if c[i] = g[j]
        white += 1
        c[i] = -1
        g[j] = -2
      .
    .
  .
  call draw_rate row black white
  color 531
  linewidth 12
  move 17 row * 11.5 + 12
  line 60 row * 11.5 + 12
  call draw_guess
  row -= 1
  if black = 4
    row = -1
  .
  if row = -1
    call show_code
    timer 2
  else
    call next_row
  .
.
on timer
  row = -2
.
func new . .
  call init_vars
  for i range 4
    code[i] = random 6
  .
  color 531
  move 10 10
  rect 70 80
  linewidth 10
  move 5 5
  line 5 95
  line 85 95
  line 85 5
  line 5 5
  color 310
  linewidth 7
  move 28 3.5
  line 58 3.5
  move 30 1.5
  color 864
  textsize 4
  text "Mastermind"
  color 310
  linewidth 0.5
  move 10 10
  line 10 96
  move 67 10
  line 67 96
  move 80 10
  line 80 96
  for r range 8
    for c range 4
      move c * 12 + 20 r * 11.5 + 12
      circle 2
    .
    call draw_rate r 0 0
  .
  guess[0] = 0
  guess[1] = 0
  guess[2] = 1
  guess[3] = 1
  call next_row
.
func do_move . .
  c = (mouse_x - 15) div 12
  guess[c] = (guess[c] + 1) mod 6
  call draw_guess
.
on mouse_down
  if row = -2
    call new
  elif mouse_y > row * 11.5 + 7 and mouse_y < row * 11.5 + 17 and row >= 0
    if mouse_x > 15 and mouse_x < 61
      call do_move
    elif mouse_x > 67 and mouse_x < 80
      call rate
    .
  .
.
call new


'--- Declaration of global variables ---
Dim As String colors(1 To 4) => {"A", "B", "C", "D"}
Dim Shared As Integer nr, ub', numlet=4, lencod=4
Dim Shared As String*4 master, pz
ub = Ubound(colors)
nr = 0

'--- SUBroutines and FUNCtions ---
Sub Encabezado
    Dim As String dup
    Color 11: Print "Welcome to Mastermind"
    Print "=====================" + Chr(13) + Chr(10) : Color 15
    Print "You will need to guess a random code."
    Print "For each guess, you will receive a hint:"
    Print "X - denotes a correct letter,"
    Print "O - denotes a letter in the original"
    Print "    string but a different position."
    Print "You have 12 attempts."
    Print "Duplicates are not allowed." + Chr(10)
    Print "Good luck!" + Chr(10) + Chr(10) : Color 7
End Sub

Sub showresult(test() As String, place1 As Byte, place2 As Byte, place3 As Byte)
    Dim As Integer r, n1, n2, n3
    Print Using "##: "; nr;
    For r = 1 To Ubound(test)
        Print test(r);
    Next R
    Print "  : ";
    For n1 = 1 To place1
        Print "X"; " ";
    Next N1
    For n2 = 1 To place2
        Print "O"; " ";
    Next N2
    For n3 = 1 To place3
        Print "-"; " ";
    Next N3
    Print : Print
End Sub

Sub Inicio
    Dim As Integer mind(ub), rands(ub)
    Dim As Integer n, aleat
    Dim As Boolean repeat = false

    For n = 1 To ub
        While true
            aleat = (Rnd * (ub-1)) + 1
            If rands(aleat) <> 1 Then
                mind(n) = aleat
                rands(aleat) = 1
                Exit While
            End If
        Wend
    Next n

    For n = 1 To ub
        Mid(master,n,1) = Chr(64 + mind(n))
        pz &= Chr(64 + mind(n))
    Next n
End Sub

'--- Main Program ---
Randomize Timer
Cls
Dim As Integer guesses = 12
Encabezado
Inicio
Color 15: Print pz : Color 7
Do
    Dim As Integer n, p, d, x, posic
    Dim As Integer places(1 To 2), place1, place2, place3
    Dim As String*4 testbegin
    Dim As String test(ub), mastertemp, tmp
    Dim As Boolean flag = True

    For p = 1 To Ubound(places)
        places(p) = 0
    Next p
    nr += 1
    Input "Your guess (ABCD)? " , testbegin
    For d = 1 To Ubound(test)
        test(d) = Mid(testbegin,d,1)
    Next d

    For n = 1 To Ubound(test)
        If Ucase(test(n)) <> Mid(master,n,1) Then flag = False
    Next n
    If flag = True Then
        Color 10: Print !"\nWell done! You guess correctly." : Sleep : Exit Do
    Else
        For x = 1 To Len(master)
            If Ucase(test(x)) = Mid(master,x,1) Then places(1) += 1
        Next x
        mastertemp = master
        For p = 1 To Ubound(test)
            posic = Instr(mastertemp, Ucase(test(p)))
            If posic > 0 Then
                tmp = mastertemp
                mastertemp = Left(tmp,posic-1) + Mid(tmp, posic+1, Len(tmp)-1)
                places(2) += 1
            End If
        Next p
    End If
    place1 = places(1)
    place2 = places(2) - place1
    place3 = Len(master) - (place1 + place2)
    showresult(test(), place1, place2, place3)
Loop Until nr = guesses
Color 14: Print "The correct combination was: "; pz
Color 7: Print !"\nEnd of game"
Sleep


package main

import (
	"errors"
	"flag"
	"fmt"
	"log"
	"math/rand"
	"strings"
	"time"
)

func main() {
	log.SetPrefix("mastermind: ")
	log.SetFlags(0)
	colours := flag.Int("colours", 6, "number of colours to use (2-20)")
	flag.IntVar(colours, "colors", 6, "alias for colours")
	holes := flag.Int("holes", 4, "number of holes (the code length, 4-10)")
	guesses := flag.Int("guesses", 12, "number of guesses allowed (7-20)")
	unique := flag.Bool("unique", false, "disallow duplicate colours in the code")
	flag.Parse()

	rand.Seed(time.Now().UnixNano())
	m, err := NewMastermind(*colours, *holes, *guesses, *unique)
	if err != nil {
		log.Fatal(err)
	}
	err = m.Play()
	if err != nil {
		log.Fatal(err)
	}
}

type mastermind struct {
	colours int
	holes   int
	guesses int
	unique  bool

	code   string
	past   []string // history of guesses
	scores []string // history of scores
}

func NewMastermind(colours, holes, guesses int, unique bool) (*mastermind, error) {
	if colours < 2 || colours > 20 {
		return nil, errors.New("colours must be between 2 and 20 inclusive")
	}
	if holes < 4 || holes > 10 {
		return nil, errors.New("holes must be between 4 and 10 inclusive")
	}
	if guesses < 7 || guesses > 20 {
		return nil, errors.New("guesses must be between 7 and 20 inclusive")
	}
	if unique && holes > colours {
		return nil, errors.New("holes must be > colours when using unique")
	}

	return &mastermind{
		colours: colours,
		holes:   holes,
		guesses: guesses,
		unique:  unique,
		past:    make([]string, 0, guesses),
		scores:  make([]string, 0, guesses),
	}, nil
}

func (m *mastermind) Play() error {
	m.generateCode()
	fmt.Printf("A set of %s has been selected as the code.\n", m.describeCode(m.unique))
	fmt.Printf("You have %d guesses.\n", m.guesses)
	for len(m.past) < m.guesses {
		guess, err := m.inputGuess()
		if err != nil {
			return err
		}
		fmt.Println()
		m.past = append(m.past, guess)
		str, won := m.scoreString(m.score(guess))
		if won {
			plural := "es"
			if len(m.past) == 1 {
				plural = ""
			}
			fmt.Printf("You found the code in %d guess%s.\n", len(m.past), plural)
			return nil
		}
		m.scores = append(m.scores, str)
		m.printHistory()
		fmt.Println()
	}
	fmt.Printf("You are out of guesses. The code was %s.\n", m.code)
	return nil
}

const charset = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
const blacks = "XXXXXXXXXX"
const whites = "OOOOOOOOOO"
const nones = "----------"

func (m *mastermind) describeCode(unique bool) string {
	ustr := ""
	if unique {
		ustr = " unique"
	}
	return fmt.Sprintf("%d%s letters (from 'A' to %q)",
		m.holes, ustr, charset[m.colours-1],
	)
}

func (m *mastermind) printHistory() {
	for i, g := range m.past {
		fmt.Printf("-----%s---%[1]s--\n", nones[:m.holes])
		fmt.Printf("%2d:  %s : %s\n", i+1, g, m.scores[i])
	}
}

func (m *mastermind) generateCode() {
	code := make([]byte, m.holes)
	if m.unique {
		p := rand.Perm(m.colours)
		for i := range code {
			code[i] = charset[p[i]]
		}
	} else {
		for i := range code {
			code[i] = charset[rand.Intn(m.colours)]
		}
	}
	m.code = string(code)
	//log.Printf("code is %q", m.code)
}

func (m *mastermind) inputGuess() (string, error) {
	var input string
	for {
		fmt.Printf("Enter guess #%d: ", len(m.past)+1)
		if _, err := fmt.Scanln(&input); err != nil {
			return "", err
		}
		input = strings.ToUpper(strings.TrimSpace(input))
		if m.validGuess(input) {
			return input, nil
		}
		fmt.Printf("A guess must consist of %s.\n", m.describeCode(false))
	}
}

func (m *mastermind) validGuess(input string) bool {
	if len(input) != m.holes {
		return false
	}
	for i := 0; i < len(input); i++ {
		c := input[i]
		if c < 'A' || c > charset[m.colours-1] {
			return false
		}
	}
	return true
}

func (m *mastermind) score(guess string) (black, white int) {
	scored := make([]bool, m.holes)
	for i := 0; i < len(guess); i++ {
		if guess[i] == m.code[i] {
			black++
			scored[i] = true
		}
	}
	for i := 0; i < len(guess); i++ {
		if guess[i] == m.code[i] {
			continue
		}
		for j := 0; j < len(m.code); j++ {
			if i != j && !scored[j] && guess[i] == m.code[j] {
				white++
				scored[j] = true
			}
		}
	}
	return
}

func (m *mastermind) scoreString(black, white int) (string, bool) {
	none := m.holes - black - white
	return blacks[:black] + whites[:white] + nones[:none], black == m.holes
}


class Mastermind {
  constructor() {
    this.colorsCnt;
    this.rptColors;
    this.codeLen;
    this.guessCnt;
    this.guesses;
    this.code;
    this.selected;
    this.game_over;
    this.clear = (el) => {
      while (el.hasChildNodes()) {
        el.removeChild(el.firstChild);
      }
    };
    this.colors = ["🤡", "👹", "👺", "👻", "👽", "👾", "🤖", "🐵", "🐭",
      "🐸", "🎃", "🤠", "☠", "🦄", "🦇", "🛸", "🎅", "👿", "🐲", "🦋"
    ];
  }

  newGame() {
    this.selected = null;
    this.guessCnt = parseInt(document.getElementById("gssCnt").value);
    this.colorsCnt = parseInt(document.getElementById("clrCnt").value);
    this.codeLen = parseInt(document.getElementById("codeLen").value);
    if (this.codeLen > this.colorsCnt) {
      document.getElementById("rptClr").selectedIndex = 1;
    }
    this.rptColors = document.getElementById("rptClr").value === "yes";
    this.guesses = 0;
    this.game_over = false;
    const go = document.getElementById("gameover");
    go.innerText = "";
    go.style.visibility = "hidden";
    this.clear(document.getElementById("code"));
    this.buildPalette();
    this.buildPlayField();
  }

  buildPalette() {
    const pal = document.getElementById("palette"),
      z = this.colorsCnt / 5,
      h = Math.floor(z) != z ? Math.floor(z) + 1 : z;
    this.clear(pal);
    pal.style.height = `${44 * h + 3 * h}px`;
    const clrs = [];
    for (let c = 0; c < this.colorsCnt; c++) {
      clrs.push(c);
      const b = document.createElement("div");
      b.className = "bucket";
      b.clr = c;
      b.innerText = this.colors[c];
      b.addEventListener("click", () => {
        this.palClick(b);
      });
      pal.appendChild(b);
    }
    this.code = [];
    while (this.code.length < this.codeLen) {
      const r = Math.floor(Math.random() * clrs.length);
      this.code.push(clrs[r]);
      if (!this.rptColors) {
        clrs.splice(r, 1);
      }
    }
  }

  buildPlayField() {
    const brd = document.getElementById("board");
    this.clear(brd);
    const w = 49 * this.codeLen + 7 * this.codeLen + 5;
    brd.active = 0;
    brd.style.width = `${w}px`;
    document.querySelector(".column").style.width = `${w + 20}px`;
    this.addGuessLine(brd);
  }

  addGuessLine(brd) {
    const z = document.createElement("div");
    z.style.clear = "both";
    brd.appendChild(z);
    brd.active += 10;
    for (let c = 0; c < this.codeLen; c++) {
      const d = document.createElement("div");
      d.className = "bucket";
      d.id = `brd${brd.active+ c}`;
      d.clr = -1;
      d.addEventListener("click", () => {
        this.playClick(d);
      })
      brd.appendChild(d);
    }
  }

  palClick(bucket) {
    if (this.game_over) return;
    if (null === this.selected) {
      bucket.classList.add("selected");
      this.selected = bucket;
      return;
    }
    if (this.selected !== bucket) {
      this.selected.classList.remove("selected");
      bucket.classList.add("selected");
      this.selected = bucket;
      return;
    }
    this.selected.classList.remove("selected");
    this.selected = null;
  }

  vibrate() {
    const brd = document.getElementById("board");
    let timerCnt = 0;
    const exp = setInterval(() => {
      if ((timerCnt++) > 60) {
        clearInterval(exp);
        brd.style.top = "0px";
        brd.style.left = "0px";
      }
      let x = Math.random() * 4,
        y = Math.random() * 4;
      if (Math.random() < .5) x = -x;
      if (Math.random() < .5) y = -y;
      brd.style.top = y + "px";
      brd.style.left = x + "px";
    }, 10);
  }

  playClick(bucket) {
    if (this.game_over) return;
    if (this.selected) {
      bucket.innerText = this.selected.innerText;
      bucket.clr = this.selected.clr;
    } else {
      this.vibrate();
    }
  }

  check() {
    if (this.game_over) return;
    let code = [];
    const brd = document.getElementById("board");
    for (let b = 0; b < this.codeLen; b++) {
      const h = document.getElementById(`brd${brd.active + b}`).clr;
      if (h < 0) {
        this.vibrate();
        return;
      }
      code.push(h);
    }
    this.guesses++;
    if (this.compareCode(code)) {
      this.gameOver(true);
      return;
    }
    if (this.guesses >= this.guessCnt) {
      this.gameOver(false);
      return;
    }
    this.addGuessLine(brd);
  }

  compareCode(code) {
    let black = 0,
      white = 0,
      b_match = new Array(this.codeLen).fill(false),
      w_match = new Array(this.codeLen).fill(false);
    for (let i = 0; i < this.codeLen; i++) {
      if (code[i] === this.code[i]) {
        b_match[i] = true;
        w_match[i] = true;
        black++;
      }
    }
    for (let i = 0; i < this.codeLen; i++) {
      if (b_match[i]) continue;
      for (let j = 0; j < this.codeLen; j++) {
        if (i == j || w_match[j]) continue;
        if (code[i] === this.code[j]) {
          w_match[j] = true;
          white++;
          break;
        }
      }
    }
    const brd = document.getElementById("board");
    let d;
    for (let i = 0; i < black; i++) {
      d = document.createElement("div");
      d.className = "pin";
      d.style.backgroundColor = "#a00";
      brd.appendChild(d);
    }
    for (let i = 0; i < white; i++) {
      d = document.createElement("div");
      d.className = "pin";
      d.style.backgroundColor = "#eee";
      brd.appendChild(d);
    }
    return (black == this.codeLen);
  }

  gameOver(win) {
    if (this.game_over) return;
    this.game_over = true;
    const cd = document.getElementById("code");
    for (let c = 0; c < this.codeLen; c++) {
      const d = document.createElement("div");
      d.className = "bucket";
      d.innerText = this.colors[this.code[c]];
      cd.appendChild(d);
    }
    const go = document.getElementById("gameover");
    go.style.visibility = "visible";
    go.innerText = win ? "GREAT!" : "YOU FAILED!";
    const i = setInterval(() => {
      go.style.visibility = "hidden";
      clearInterval(i);
    }, 3000);
  }
}
const mm = new Mastermind();
document.getElementById("newGame").addEventListener("click", () => {
  mm.newGame()
});
document.getElementById("giveUp").addEventListener("click", () => {
  mm.gameOver();
});
document.getElementById("check").addEventListener("click", () => {
  mm.check()
});