Re: proposal to include functions to read data from files

I'd like to put this in the contrib directory for now. I think the
functionality should moved into the core eventually, but I'd like to
consider the interfaces a little more first.

A slightly more descriptive name than "io" would probably be helpful.
How about "numericalio"? A better suggestion would be appreciated.

--Jim

On Fri, 2004-01-09 at 10:57, Barton Willis wrote:
> 
> 
> 
> 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))))
> 
> _______________________________________________
> Maxima mailing list
> Maxima@www.math.utexas.edu
> http://www.math.utexas.edu/mailman/listinfo/maxima