share/contrib/diffequations/testodelin.lisp

   1 ;; Author Barton Willis
   2 ;; University of Nebraska at Kearney
   3 ;; Copyright (C) 2004, Barton Willis
   4
   5 ;; Brief Description: Maxima code for linear homogeneous second order
   6 ;; differential equations.
   7
   8 ;; Maxima odelin is free software; you can redistribute it and/or
   9 ;; modify it under the terms of the GNU General Public License,
  10 ;; http://www.gnu.org/copyleft/gpl.html.
  11
  12 ;; Maxima odelin has NO WARRANTY, not even the implied warranty of
  13 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  14
  15 ($put '$testodelin 1 '$version)
  16
  17
  18 (defun $testodelin (fn)
  19   (let ((acc) (strm) (de) (sol) (t1) (gork) (i 0) (times)
  20         (solved-des) (unsolved-des) (total-time 0)
  21         (longest-time 0))
  22
  23     (setq fn (string fn))
  24     (setq fn (make-pathname :name fn))
  25     ($load "odelin")
  26
  27     (setq strm (open fn :direction :input))
  28     (while (not (eq 'eof (setq de (mread strm 'eof))))
  29       (push (nth 2 de) acc))
  30     (close strm)
  31
  32     (setq acc (reverse acc))
  33     (dolist (de acc)
  34       (incf i)
  35       (meval '(($kill) $all)) ;; sigh....
  36       (format t "~%-- ~A ------------------------------------~%" i)
  37       (setq t1 (get-internal-run-time))
  38       (displa `((mequal) de ,de))
  39       (setq gork `(($errcatch) (($odelin) ,de  |$y| |$x|)))
  40       (setq sol (meval gork))
  41       (setq t1 (- (get-internal-run-time) t1))
  42       (push t1 times)
  43       (setq longest-time (max longest-time t1))
  44       (setq t1 (float (/ t1 internal-time-units-per-second)))
  45       (incf total-time t1)
  46       (setq t1 (mul t1 '$sec))
  47       (cond ((and (not (like sol '((mlist)))) (not (like ($first sol) nil)))
  48              (push de solved-des)
  49              (setq sol ($first sol))
  50              (displa `((mequal) sol ,sol))
  51              (displa `((mequal) time ,t1)))
  52             (t
  53              (push de unsolved-des)
  54              (displa `((mequal) time ,t1))
  55              (displa `((mequal) notsolved ,de)))))
  56
  57     (setq longest-time (float (/ longest-time internal-time-units-per-second)))
  58     (setq total-time (mul total-time '$sec))
  59     (displa `((mequal) totaltime ,total-time))
  60     (displa `((mequal) longest_time ,longest-time))
  61     (displa `((mequal) number_of_solved_des ,(length solved-des)))
  62     (displa `((mequal) number_of_unsolved_des ,(length unsolved-des)))
  63
  64     (setq times (sort times #'<))
  65     (push `(mlist) times)
  66     (displa `((mequal) times ,times))
  67
  68     (dolist (de unsolved-des)
  69       (displa de))))
  70