September 2017 Update

Task/Identity-matrix/360-Assembly/identity-matrix.360

@@ -0,0 +1,73 @@
+*        Identity matrix           31/03/2017
+INDENMAT CSECT
+         USING  INDENMAT,R13       base register
+         B      72(R15)            skip savearea
+         DC     17F'0'             savearea
+         STM    R14,R12,12(R13)    save previous context
+         ST     R13,4(R15)         link backward
+         ST     R15,8(R13)         link forward
+         LR     R13,R15            set addressability
+         L      R1,N               n
+         MH     R1,N+2             n*n
+         SLA    R1,2               *4
+         ST     R1,LL              amount of storage required
+         GETMAIN RU,LV=(R1)        allocate storage for matrix
+         USING  DYNA,R11           make storage addressable
+         LR     R11,R1             set addressability
+         LA     R6,1               i=1
+       DO WHILE=(C,R6,LE,N)        do i=1 to n
+         LA     R7,1                 j=1
+       DO WHILE=(C,R7,LE,N)          do j=1 to n
+       IF CR,R6,EQ,R7 THEN             if i=j then
+         LA     R2,1                     k=1
+       ELSE     ,                      else
+         LA     R2,0                     k=0
+       ENDIF    ,                      endif
+         LR     R1,R6                  i
+         BCTR   R1,0                   -1
+         MH     R1,N+2                 *n
+         AR     R1,R7                  (i-1)*n+j
+         BCTR   R1,0                   -1
+         SLA    R1,2                   *4
+         ST     R2,A(R1)               a(i,j)=k
+         LA     R7,1(R7)               j++
+       ENDDO    ,                    enddo j
+         LA     R6,1(R6)             i++
+       ENDDO    ,                  enddo i
+         LA     R6,1               i=1
+       DO WHILE=(C,R6,LE,N)        do i=1 to n
+         LA     R10,PG               pgi=0
+         LA     R7,1                 j=1
+       DO WHILE=(C,R7,LE,N)          do j=1 to n
+         LR     R1,R6                  i
+         BCTR   R1,0                   -1
+         MH     R1,N+2                 *n
+         AR     R1,R7                  (i-1)*n+j
+         BCTR   R1,0                   -1
+         SLA    R1,2                   *4
+         L      R2,A(R1)               a(i,j)
+         XDECO  R2,XDEC                edit
+         MVC    0(1,R10),XDEC+11       output
+         LA     R10,1(R10)             pgi+=1
+         LA     R7,1(R7)               j++
+       ENDDO    ,                    enddo j
+         XPRNT  PG,L'PG              print
+         LA     R6,1(R6)             i++
+       ENDDO    ,                  enddo i
+         LA     R1,A               address to free
+         LA     R2,LL              amount of storage to free
+         FREEMAIN A=(R1),LV=(R2)   free allocated storage
+         DROP   R11                drop register
+         L      R13,4(0,R13)       restore previous savearea pointer
+         LM     R14,R12,12(R13)    restore previous context
+         XR     R15,R15            rc=0
+         BR     R14                exit
+NN       EQU    10                 parameter n  (90=>32K)
+N        DC     A(NN)              n
+LL       DS     F                  n*n*4
+PG       DC     CL(NN)' '          buffer
+XDEC     DS     CL12               temp
+DYNA     DSECT
+A        DS     F                  a(n,n)
+         YREGS
+         END    INDENMAT

Task/Identity-matrix/APL/identity-matrix-3.apl

@@ -1 +1,2 @@
-    ID←{⍵ ⍵ ρ 1, ⍵ρ0}
+    ID←∘.=⍨⍳
+    ID←⍳∘.=⍳

Task/Identity-matrix/APL/identity-matrix-4.apl

@@ -0,0 +1 @@
+    ID←{⍵ ⍵ ρ 1, ⍵ρ0}

Task/Identity-matrix/AppleScript/identity-matrix.applescript

@@ -1,24 +1,30 @@
+-- ID MATRIX -----------------------------------------------------------------
+
 -- idMatrix :: Int -> [(0|1)]
 on idMatrix(n)
-    set xs to range(1, n)
+    set xs to enumFromTo(1, n)
 
     script row
-        on lambda(x)
-            script zeroOrOne
-                on lambda(i)
-                    cond(i = x, 1, 0)
-                end lambda
+        on |λ|(x)
+            script
+                on |λ|(i)
+                    if i = x then
+                        1
+                    else
+                        0
+                    end if
+                end |λ|
             end script
 
-            map(zeroOrOne, xs)
-        end lambda
+            map(result, xs)
+        end |λ|
     end script
 
     map(row, xs)
 end idMatrix
 
 
--- TEST
+-- TEST ----------------------------------------------------------------------
 on run
 
     idMatrix(5)
@@ -26,8 +32,21 @@ on run
 end run
 
 
+-- GENERIC FUNCTIONS ---------------------------------------------------------
 
--- GENERIC FUNCTIONS ------------------------------------------
+-- enumFromTo :: Int -> Int -> [Int]
+on enumFromTo(m, n)
+    if n < m then
+        set d to -1
+    else
+        set d to 1
+    end if
+    set lst to {}
+    repeat with i from m to n by d
+        set end of lst to i
+    end repeat
+    return lst
+end enumFromTo
 
 -- map :: (a -> b) -> [a] -> [b]
 on map(f, xs)
@@ -35,7 +54,7 @@ on map(f, xs)
         set lng to length of xs
         set lst to {}
         repeat with i from 1 to lng
-            set end of lst to lambda(item i of xs, i, xs)
+            set end of lst to |λ|(item i of xs, i, xs)
         end repeat
         return lst
     end tell
@@ -48,30 +67,7 @@ on mReturn(f)
         f
     else
         script
-            property lambda : f
+            property |λ| : f
         end script
     end if
 end mReturn
-
--- cond :: Bool -> a -> a -> a
-on cond(bool, f, g)
-    if bool then
-        f
-    else
-        g
-    end if
-end cond
-
--- range :: Int -> Int -> [Int]
-on range(m, n)
-    if n < m then
-        set d to -1
-    else
-        set d to 1
-    end if
-    set lst to {}
-    repeat with i from m to n by d
-        set end of lst to i
-    end repeat
-    return lst
-end range

Task/Identity-matrix/Elena/identity-matrix.elena

@@ -1,14 +1,14 @@
-#import system.
-#import extensions.
-#import system'routines.
-#import system'collections.
+import extensions.
+import system'routines.
+import system'collections.
 
-#symbol program=
+program =
 [
-    #var n := console write:"Enter the matrix size:" readLine toInt.
+    var n := console write:"Enter the matrix size:"; readLine; toInt.
 
-    #var identity := n repeat &each: i = [ n repeat &each: j = [ (i == j)iif:1:0 ] summarize:(ArrayList new) ] summarize:(ArrayList new).
+    var identity := 0 till:n repeat(:i)( 0 till:n repeat(:j)( (i == j)iif(1,0) ); summarize(ArrayList new) );
+                         summarize(ArrayList new).
 
-    identity run &each:
-        row = [ console writeLine:row ].
+    identity forEach
+        (:row) [ console printLine:row ].
 ].

Task/Identity-matrix/Forth/identity-matrix.fth

@@ -0,0 +1,16 @@
+S" fsl-util.fs" REQUIRED
+
+: build-identity ( 'p n -- 'p )  \ make an NxN identity matrix
+  0 DO
+    I 1+ 0 DO
+      I J = IF  1.0E0 DUP I J }} F!
+      ELSE
+        0.0E0 DUP J I }} F!
+        0.0E0 DUP I J }} F!
+      THEN
+    LOOP
+  LOOP ;
+
+6 6 float matrix a{{
+a{{ 6 build-identity
+6 6 a{{ }}fprint

Task/Identity-matrix/Haskell/identity-matrix-4.hs

@@ -0,0 +1,7 @@
+idMatrix :: Int -> [[Int]]
+idMatrix n =
+  let xs = [1 .. n]
+  in xs >>= \x -> [xs >>= \y -> [fromEnum (x == y)]]
+
+main :: IO ()
+main = (putStr . unlines) $ fmap (unwords . fmap show) (idMatrix 5)

Task/Identity-matrix/JavaScript/identity-matrix-2.js

@@ -7,7 +7,11 @@
             length: n
         }, (_, j) => i !== j ? 0 : 1));
 
+    // show :: a -> String
+    const show = JSON.stringify;
 
     // TEST
-    return idMatrix(5);
+    return idMatrix(5)
+        .map(show)
+        .join('\n');
 })();

Task/Identity-matrix/JavaScript/identity-matrix-3.js

@@ -1,2 +0,0 @@
-[[1, 0, 0, 0, 0], [0, 1, 0, 0, 0], [0, 0, 1, 0, 0],
-[0, 0, 0, 1, 0], [0, 0, 0, 0, 1]]

Task/Identity-matrix/K/identity-matrix.k

@@ -0,0 +1,11 @@
+  =4
+(1 0 0 0
+ 0 1 0 0
+ 0 0 1 0
+ 0 0 0 1)
+  =5
+(1 0 0 0 0
+ 0 1 0 0 0
+ 0 0 1 0 0
+ 0 0 0 1 0
+ 0 0 0 0 1)

Task/Identity-matrix/Kotlin/identity-matrix.kotlin

@@ -0,0 +1,17 @@
+// version 1.0.6
+
+fun main(args: Array<String>) {
+    print("Enter size of matrix : ")
+    val n = readLine()!!.toInt()
+    println()
+    val identity = Array(n) { IntArray(n) } // create n x n matrix of integers
+
+    // enter 1s in diagonal elements
+    for(i in 0 until n) identity[i][i] = 1
+
+    // print identity matrix if n <= 40
+    if (n <= 40)
+        for (i in 0 until n) println(identity[i].joinToString(" "))
+    else
+        println("Matrix is too big to display on 80 column console")
+}

Task/Identity-matrix/OoRexx/identity-matrix.rexx

@@ -0,0 +1,29 @@
+say "a 3x3 identity matrix"
+say
+call printMatrix createIdentityMatrix(3)
+say
+say "a 5x5 identity matrix"
+say
+call printMatrix createIdentityMatrix(5)
+
+::routine createIdentityMatrix
+  use arg size
+  matrix = .array~new(size, size)
+  loop i = 1 to size
+      loop j = 1 to size
+          if i == j then matrix[i, j] = 1
+          else matrix[i, j] = 0
+      end j
+  end i
+  return matrix
+
+::routine printMatrix
+  use arg matrix
+
+  loop i = 1 to matrix~dimension(1)
+      line = ""
+      loop j = 1 to matrix~dimension(2)
+          line = line matrix[i, j]
+      end j
+      say line
+  end i

Task/Identity-matrix/Phix/identity-matrix.phix

@@ -0,0 +1,13 @@
+function identity(integer n)
+sequence res = repeat(repeat(0,n),n)
+    for i=1 to n do
+        res[i][i] = 1
+    end for
+    return res
+end function
+
+ppOpt({pp_Nest,1})
+pp(identity(3))
+pp(identity(5))
+pp(identity(7))
+pp(identity(9))

Task/Identity-matrix/Sidef/identity-matrix.sidef

@@ -1,12 +1,14 @@
 func identity_matrix(n) {
-    1..n -> map { |i|
-        1..n -> map {|j| j == i ? 1 : 0 }
+    n.of { |i|
+        n.of { |j|
+            i == j ? 1 : 0
+        }
     }
 }
 
-(ARGV.len ? ARGV.map{.to_i} : [4, 5, 6]) -> each { |n|
-  say "\n#{n}:";
-  identity_matrix(n).each { |row|
-    say row.join(' ');
+for n (ARGV ? ARGV.map{.to_i} : [4, 5, 6]) {
+  say "\n#{n}:"
+  for row (identity_matrix(n)) {
+    say row.join(' ')
   }
 }

Task/Identity-matrix/Sinclair-ZX81-BASIC/identity-matrix.sinclair

@@ -0,0 +1,12 @@
+ 10 INPUT S
+ 20 DIM M(S,S)
+ 30 FOR I=1 TO S
+ 40 LET M(I,I)=1
+ 50 NEXT I
+ 60 FOR I=1 TO S
+ 70 SCROLL
+ 80 FOR J=1 TO S
+ 90 PRINT M(I,J);
+100 NEXT J
+110 PRINT
+120 NEXT I

Task/Identity-matrix/TypeScript/identity-matrix.type

@@ -0,0 +1,14 @@
+function identity(n) {
+    if (n < 1) return "Not defined";
+    else if (n == 1) return 1;
+    else {
+        var idMatrix:number[][];
+        for (var i: number = 0; i < n; i++) {
+            for (var j: number = 0; j < n; j++) {
+                if (i != j) idMatrix[i][j] = 0;
+                else idMatrix[i][j] = 1;
+            }
+        }
+        return idMatrix;
+    }
+}

Task/Identity-matrix/Unicon/identity-matrix.unicon

@@ -1,6 +0,0 @@
-link matrix
-procedure main(argv)
-    if not (integer(argv[1]) > 0) then stop("Argument must be a positive integer.")
-    matrix1 := identity_matrix(argv[1], argv[1])
-    write_matrix(&output,matrix1)
-end

Task/Identity-matrix/ZX-Spectrum-Basic/identity-matrix.zx

@@ -0,0 +1,16 @@
+10 INPUT "Matrix size: ";size
+20 GO SUB 200: REM Identity matrix
+30 FOR r=1 TO size
+40 FOR c=1 TO size
+50 LET s$=CHR$ 13
+60 IF c<size THEN LET s$=" "
+70 PRINT i(r,c);s$;
+80 NEXT c
+90 NEXT r
+100 STOP
+200 REM Identity matrix size
+220 DIM i(size,size)
+230 FOR i=1 TO size
+240 LET i(i,i)=1
+250 NEXT i
+260 RETURN

Task/Identity-matrix/Zkl/identity-matrix.zkl

@@ -0,0 +1,7 @@
+fcn idMatrix(n){
+   m:=(0).pump(n,List.createLong(n).write,0)*n;
+   m.apply2(fcn(row,rc){ row[rc.inc()]=1 },Ref(0));
+   m
+}
+idMatrix(5).println();
+idMatrix(5).pump(Console.println);