Re: proposal to include functions to read data from files




Here is a short demo of Maxima io.

(C1) load("l:/io.lisp");
(D1)                      l:/io.lisp
(C2) open_input_file("l:/maxima-io/fp.data")$
(C3) list_open_files();
(D3)                  [l:/maxima-io/fp.data]
(C4) read_matrix("l:/maxima-io/fp.data");
      [ 0  1  2 ]
      [         ]
(D4)                      [ 3  4  5 ]
      [         ]
      [ 6  7  8 ]
(C5) reset_file_position("l:/maxima-io/fp.data")$
(C6) read_list("l:/maxima-io/fp.data");
(D6)                [0, 1, 2, 3, 4, 5, 6, 7, 8]
(C7)  reset_file_position("l:/maxima-io/fp.data")$
(C8) read_matrix("l:/maxima-io/fp.data",2,2);
       [ 0  1 ]
(D8)                       [    ]
       [ 2  3 ]
(C9) close_all_files();
Closing file l:/maxima-io/fp.data
(D9)                         TRUE
(C10)

I have very little experience with io in general -- this was my first
time coding io in Common Lisp.  Expect bugs (especially with reading CSV
files).

Barton


-------------------io.lisp--------------------------------------------------


;;  Author: Barton Willis

;;  Maxima io is free software; you can redistribute it and/or
;;  modify it under the terms of the GNU General Public License,
;;  http://www.gnu.org/copyleft/gpl.html.

;;  Maxima io has NO WARRANTY, not even the implied warranty of
;;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

;;  I have not tested some parts of this code, and the rest of it
;;  has only been minimally tested. Exercise caution. At
;;  least for now, I don't plan to debug this code; instead, I hope that
;;  somebody adopts this project and finishes it (or throws it out and
;;  starts from scratch).

(in-package "MAXIMA")
($put '$io '0.0 '$version)

(defmacro while (cond &rest body)
  `(do ()
       ((not ,cond))
     ,@body))

;; Place all open files in a hash table open-files. For no particular
;; reason, initialize open-files to have 12 members.

(declaim (special open-files))
(setf open-files (make-hash-table :size 12 :test #'equal))

;; The structure io-stream holds a file stream, a function that
;; reads one object from the stream, and the character that
;; separates objects. When fs is an output stream, read-fun
;; isn't defined.

(defstruct io-stream (fs nil) read-fun ch)

;; If x is an io-stream structure, return its file stream; otherwise,
;; return nil.

(defun get-stream (x)
  (if (io-stream-p x) (io-stream-fs x) nil))

;; Convert a Maxima string to a Lisp string. When str isn't a Maxima
;; string, signal an error.

(defun require-string (str)
  (cond ((mstringp str)
  (symbol-name (stripdollar str)))
 (t
  (merror "Needed a string, instead found ~:M" str))))

(defun $open_input_file (fn)
  (let ((fs) (fp) (ft) (read-fun))
    (setq fn (require-string fn))
    (setq fp (pathname fn))
    (setq ft (pathname-type fp))
    (setq fs (gethash fn open-files))
    (setq fs (get-stream fs))
    (cond ((and (streamp fs) (output-stream-p fs))
    (setq fn (namestring fp))
    (merror "The file ~:S is open for output. It cannot be opened for
    input" fn))
   ((not (and (streamp fs) (input-stream-p fs)))
    (setq fs (open fp :direction :input
     :if-does-not-exist nil))))

    (setq read-fun (if (equal ft "csv") (intern "CSV-READ" 'MAXIMA)
       (intern "READ" 'lisp)))

    (if (and (streamp fs) (input-stream-p fs))
 (setf (gethash fn open-files) (make-io-stream :fs fs :read-fun read-fun))
      (merror "File ~:S not found" fn))))

(defun $open_output_file (fn)
  (let ((fs) (fp) (ft) (ch))
    (setq fn (require-string fn))
    (setq fp (pathname fn))
    (setq ft (pathname-type fp))
    (setq fs (gethash fn open-files))
    (setq fs (get-stream fs))
    (cond ((and (streamp fs) (input-stream-p fs))
    (setq fn (namestring fp))
    (merror "The file ~:S is open for input. It cannot be opened for
    output" fn))
   ((not (and (streamp fs) (input-stream-p fs)))
    (setq fs (open fp :direction :output
     :if-exists :append
     :if-does-not-exist :create))))
    (setq ch (cond ((equal ft "csv") #\,)
     ((equal ft "tsv") #\tab)
     (t #\space)))
    (if (and (streamp fs) (output-stream-p fs))
 (setf (gethash fn open-files) (make-io-stream :fs fs :ch ch))
      (merror "Unable to open file ~:S" fn))))

;; Close the file with name f and remove it from open-files.

(defun $closefile (f)
  (let* ((fn (require-string f)) (fs (gethash fn open-files)))
    (if (io-stream-p fs) (closefile fn fs)
      (merror "No file with name ~:M" f))))

(defun closefile (fn fs)
  (format t "Closing file ~A~%" (string-left-trim `(\#&) fn))
  (remhash fn open-files)
  (close (io-stream-fs fs)))

;; Reset the file position of fn to the start of the file.

(defun $reset_file_position (fn)
  (setq fn (require-string fn))
  (let ((fs (gethash fn open-files)))
    (setq fs (get-stream fs))
    (if (streamp fs) (file-position fs 0)
      (merror "No file with name ~:S" fn))))

;; Close all files in open-files.

(defun $close_all_files ()
  (maphash #'(lambda (fn fs) (closefile fn fs)) open-files)
  t)

;; Return a Maxima list of all open files.

(defun $list_open_files ( )
  (let ((acc))
    (maphash #'(lambda (x y)
   (declare (ignore y))
   (push (string-left-trim `(\#&) x) acc)) open-files)
    (cons '(mlist simp) acc)))

;; If read-delimited-list returns nil, backup to the original
;; file position and read the next object with read.

(defun csv-read (fs a b)
  (declare (ignore a b))
  (let ((pos (file-position fs))
 (x (ignore-errors (read-delimited-list #\, fs))))
    (cond ((null x)
    (file-position fs pos)
    (read fs nil nil))
   (t (car x)))))

;; If x is an integer, a float, or a string, return x.  If
;; x is a Lisp complex number or a Lisp rational number,
;; convert it to Maxima form; otherwise, signal an error.

(defun check-data (x)
  (cond ((or (floatp x) (integerp x) (stringp x)) x)
 ((and (rationalp x) (not (integerp x)))
  `((rat simp) ,(numerator x) ,(denominator x)))
 ((complexp x)
  `((mplus simp) ,(check-data (realpart x))
    ((mtimes simp) $%i ,(check-data (imagpart x)))))
 (t (merror "Bad data in input"))))

;; Read one line of the stream fs and return a list of the values and
;; the number of objects read.

(defun read-row (fs fread)
  (read-data (make-string-input-stream (read-line fs nil "")) fread 0 nil))

;; Skip s objects then read objects from the stream fs  until either
;; n have been read or fs has no more objects left to read.

(defun read-data (fs fread s n)
  (let ((x) (acc) (k 0))
    (dotimes (i s)
      (funcall fread fs nil nil))
    (while (and (or (not n) (< k n)) (setq x (funcall fread fs nil nil)))
      (incf k)
      (push (check-data x) acc))
    (values (nreverse acc) k)))

;; Return true iff each member of the lisp list l is a Maxima number.

(defun check-num-data (l)
  (every #'(lambda (x) ($numberp x)) l))

;; Return true iff m is a matrix and each matrix element is a Maxima
number.

(defun $numerical_matrixp (m)
  (and ($matrixp m) (every #'$numerical_listp (margs m))))

;; Return true iff l is a Maxima list and each list element is a Maxima
number.

(defun $numerical_listp (l)
  (and ($listp l) (check-num-data (margs l))))

;; When n isn't an integer that is >= m or nil, signal an error.

(defun require-nil-or-min-int (n m arg-pos fn)
  (if (not (or (and (integerp n) (>= n m)) (null n)))
      (merror "The ~:M argument to ~:M must be undefined or it must be a
      integer that is >= ~:M; instead found ~:M" arg-pos fn m n)))

;; Start reading the s-th object from file fn.  Read objects until
;; either n objects are read or there are no more objects left to read.
;; Return a Maxima list of the objects are read.

(defun $read_list (fn &optional s n)
  (let ((fs ($open_input_file fn)))
    (require-nil-or-min-int s 1 "$second" "$read_list")
    (require-nil-or-min-int n 0 "$third" "$read_list")
    (setq s (if (not (integerp s)) 0 (- s 1)))
    (setq n (if (not (integerp n)) nil n))
    (cons '(mlist simp) (read-data (io-stream-fs fs)
       (io-stream-read-fun fs) s n))))

(defun $write_list (l fn)
  (cond (($listp l)
  (setq fn ($open_output_file fn))
  (write-list (cdr l) (io-stream-fs fn) (io-stream-ch fn))
  t)
 (t (merror "First argument to write_list must be a list"))))

(defun my-mgrind (x fs)
  (cond ((not ($freeof '$i x))
  (let ((xr ($realpart x))
        (xi ($imagpart x)))
    (if (and ($numberp xr) ($numberp xi))
        (setq x (complex xr xi))
      (merror "Data must be a string or a number"))))

 ((and ($ratnump x) (not (integerp x)))
  (setq x (/ (nth 1 x) (nth 2 x))))

 ((mstringp x)
  (setq x (string-left-trim `(#\&) (symbol-name x)))))

  (format fs (cond ((floatp x) "~F")
     ((stringp x) "~S")
     (t "~W")) x))

(defun write-list (l fs ch)
  (cond ((not (null l))
  (mgrind (pop l) fs)
  (while l
    (write-char ch fs)
    (my-mgrind (pop l) fs))))
    (terpri fs)
  (finish-output fs))

(defun $write_matrix (e fn)
  (cond (($matrixp e)
  (setq fn ($open_output_file fn))
  (mapcar #'(lambda (x) (write-list (cdr x) (io-stream-fs fn)
        (io-stream-ch fn))) (cdr e))
  t)
 (t (merror "First argument to write_list must be a matrix"))))

;; Write expression e to file or stream fn and append a newline to the
file.
;; Return true.

(defun $write (e fn)
  (let ((fs (io-stream-fs ($open_output_file fn))))
    (my-mgrind e fs)
    (terpri fs)
    (finish-output fs))
  t)

;; Read a matrix from file fn.  When c isn't defined, each line
;; of the file is a matrix row. When r is defined, read rows until
;; r rows have been read or until no rows are left to read.

(defun $read_matrix (fn &optional r c)
  (let ((fn ($open_input_file fn)) (acc) (x) (i 0) (fs) (fr))
    (require-nil-or-min-int r 0 "$second" "$read_matrix")
    (require-nil-or-min-int c 0 "$third" "$read_matrix")
    (setq fs (io-stream-fs fn))
    (setq fr (io-stream-read-fun fn))
    (cond ((null c)
    (while (and (or (null r) (< i r)) (setq x (read-row fs fr)))
      (incf i)
      (push x acc)))
   (t
    (dotimes (i r)
      (push (read-data fs fr 0 c) acc))))
     (setq acc (mapcar #'(lambda (s) (cons '(mlist simp) s)) acc))
(cons '($matrix simp) (nreverse acc))))