home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / BIPL.ZIP / PROCS.ZIP / MATRIX.ICN < prev    next >
Encoding:
Text File  |  1992-11-27  |  1.6 KB  |  90 lines
  1. ############################################################################
  2. #
  3. #    File:     matrix.icn
  4. #
  5. #    Subject:  Procedures for matrix manipulation
  6. #
  7. #    Author:   Stephen B. Wampler and Ralph E. Griswold
  8. #
  9. #    Date:     April 19, 1992
  10. #
  11. ###########################################################################
  12.  
  13. procedure write_matrix(M)
  14.    local r, c, row, col
  15.  
  16.    r := *M
  17.    c := *M[1]
  18.  
  19.    writes("[")
  20.    every row := 1 to r do {
  21.       writes("[")
  22.       every col := 1 to c do {
  23.          writes(right(M[row][col], 8), ", ")
  24.          }
  25.       write("]")
  26.       }
  27.    write("]")
  28.  
  29. end
  30.  
  31. procedure create_matrix(n, m, x)
  32.    local M
  33.  
  34.    M := list(n)
  35.    every !M := list(m, x)
  36.  
  37.    return M
  38.  
  39. end
  40.  
  41. procedure identity_matrix(n, m)
  42.    local r, c
  43.  
  44.    M := create_matrix(n, m, 0)
  45.  
  46.    every r := 1 to n do {
  47.       every c := 1 to m do {
  48.          if r = c then M[r][c] := 1
  49.          }
  50.       }
  51.  
  52.    return M
  53.  
  54. end
  55.  
  56. procedure add_matrix(M1, M2)
  57.    local M3, r, c, n, m
  58.  
  59.    if (n := *M1 ~= *M2) | (m := *M1[1] ~= *M2[1]) then
  60.       stop("*** incorrect matrix sizes")
  61.  
  62.    M3 := create_matrix(n, m)
  63.  
  64.    every r := 1 to n do
  65.       every c := 1 to m do
  66.          M3[r][c] := M1[r][c] + M2[r][c]
  67.  
  68.    return M3
  69.  
  70. end
  71.  
  72. procedure mult_matrix(M1, M2)
  73.    local M3, r, c, n
  74.  
  75.    if (n := *M1[1]) ~= *M2 then stop("*** incorrect matrix sizes")
  76.  
  77.    M3 := create_matrix(*M1,*M2[1])
  78.    every r := 1 to *M1 do {
  79.       every c := 1 to *M2[1] do {
  80.          M3[r][c] := 0
  81.          every k := 1 to n do {
  82.              M3[r][c] +:= M1[r][k] * M2[k][c]
  83.              }
  84.          }
  85.       }
  86.  
  87.    return M3
  88.  
  89. end
  90.