1. 基础工具集 szcom.lisp

#!lisp
;; szcom.lisp

(provide 'szcom)

(defpackage "szcom" 
  (:use "COMMON-LISP" "EXT")
  (:export "RMAT" "PMAT" "PDMAT" "PSMAT" ) 
  (:nicknames "SZCOM")
)

(in-package "szcom")

(defun RMAT (&optional input-stream) 
  (prog
   ((m (read input-stream))
    (n (read input-stream))
    tn
    )
   (if (not (and (integerp m)
                 (integerp n)))
       (error "RMAT: m or n must be intergers.~%") 
     )
   (setq A (make-array (list m n) :initial-element 0))
   (loop for i from 0 below m
         do
         (loop for j from 0 below n
               do
               (setq tn (read input-stream))
               (cond ((rationalp tn)
                      (setf (aref A i j) tn))
                     ((null tn) (error "RMAT: unexpected steam END.~%"))
                     (T (error "RMAT: the member of Array must be numbers~%"))
                     )
               )
         )
   (return A)
   )
  )
         

(defun PMAT (A)
  (prog
   ((m (car (array-dimensions A)))
    (n (cadr (array-dimensions A))))
   (format t "~%")
   (loop for i from 0 to (- m 1)
         do 
         (loop for j from 0 to (- n 1)
               do
               (format t "~12,6G" (aref A i j))
               )
         (format t "~%" )
         )
   )
  )

(defun PSMat (A)
  (prog
   ((n (decf (car (array-dimensions A)))))
   (loop for i from 0 to n
         do 
         (loop for j from 0 to n
               do
               (format t "~12,G~^"
                       (let ((ind (+ (- j i) 1)))
                         (if (and (<= 0 ind) (< ind 3))
                             (aref A i ind)
                           0
                           )
                         )
                       )
               )
         (format t "~%")
         )
   )
  )

(defun PDMAT (A)
  (prog
   ((n (car (array-dimensions A))))
   (format t "~%")
   (loop for i from 0 to (- n 1)
         do 
         (loop for j from 0 to (- n 1)
               do
               (format t "~12,6G~^" (if (= i  j) (aref A i) 0)
               )
               )
         (format t "~%" )
         )
   )
  )