Commit 26220c37 authored by Liam M. Healy's avatar Liam M. Healy
Browse files

New connected systems math-high-pd, io-fa

Define new connected systems math-high-pd, io-fa and move definitions
so that they are loaded in the proper order.
parent 2ea2bd70
;; Foreign array system definition
;; Liam Healy 2012-03-23 19:06:29EDT foreign-array.asd
;; Time-stamp: <2013-11-28 09:45:51EST foreign-array.asd>
;; Time-stamp: <2013-11-30 15:44:26EST foreign-array.asd>
;; Copyright 2012 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -44,6 +44,14 @@
(:file "vector-matrix" :depends-on ("element-types" "subclass"))
(:file "methods" :depends-on ("foreign-array" "vector-matrix"))))))
(asdf:defsystem-connection #:io-fa
:serial t
:requires (#:foreign-array #:input-output)
:components
((:module foreign-array
:components
((:file "print-foreign-array")))))
(asdf:defsystem-connection #:foreign-array-tests
:serial t
:requires (#:foreign-array #:lisp-unit)
......
;; Foreign (C or C-compatible) arrays
;; Liam Healy 2008-12-28 10:44:22EST foreign-array.lisp
;; Time-stamp: <2013-11-27 10:44:57EST foreign-array.lisp>
;; Time-stamp: <2013-11-30 15:34:43EST foreign-array.lisp>
;;
;; Copyright 2008, 2009, 2010, 2011, 2012, 2013 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -30,8 +30,7 @@
;;;;****************************************************************************
(export '(foreign-array foreign-pointer dimensions
cl-array metadata-slot
*print-contents* *print-foreign-array-readably*
cl-array metadata-slot *print-contents*
make-foreign-array
make-fortran-array
ensure-foreign-array
......@@ -149,22 +148,17 @@
(defparameter *print-contents* t
"Print the contents of the foreign-array.")
(defparameter *print-foreign-array-readably* t
"Print the contents of the foreign-array with the #m reader macro.")
(defmethod print-grid-readably ((object foreign-array) contents-writer stream)
(format stream "#~@[~d~]m" (hashm-numeric-code (element-type object)))
(funcall contents-writer stream))
(defmethod print-object ((object foreign-array) stream)
(if (and *print-foreign-array-readably* *print-contents*)
(antik::cl-readable-nf (antik::nf-grid object stream))
(print-unreadable-object (object stream :type t)
(if *print-contents*
(if (slot-boundp object 'foreign-pointer)
(princ (contents object) stream)
(princ "with no pointer" stream))
(format stream "dimensions ~a" (dimensions object))))))
(print-unreadable-object (object stream :type t)
(if *print-contents*
(if (slot-boundp object 'foreign-pointer)
(princ (contents object) stream)
(princ "with no pointer" stream))
(format stream "dimensions ~a" (dimensions object)))))
(defmacro metadata-slot (object name)
"Access a slot in the foreign-metadata."
......
;; Format of foreign (C or C-compatible) arrays
;; Liam Healy 2008-12-28 10:44:22EST foreign-array.lisp
;; Time-stamp: <2013-11-30 15:34:44EST print-foreign-array.lisp>
;;
;; Copyright 2013 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
(in-package :grid)
(export '(*print-foreign-array-readably*))
(defparameter *print-foreign-array-readably* t
"Print the contents of the foreign-array with the #m reader macro.")
(defmethod print-object :around ((object foreign-array) stream)
(if (and *print-foreign-array-readably* *print-contents*)
(antik::cl-readable-nf (antik::nf-grid object stream))
(call-next-method)))
;;
;; Liam Healy 2012-02-20 10:14:49EST physical-dimension.asd
;; Time-stamp: <2013-11-28 09:49:44EST mathematics.asd>
;; Time-stamp: <2013-11-30 12:08:59EST mathematics.asd>
;; Copyright 2013 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -40,7 +40,7 @@
;;; High level mathematics built on other libraries.
(asdf:defsystem-connection #:math-high
:serial t
:requires (#:foreign-array #:gsll)
:requires (#:mathematics #:gsll)
:components
((:module optimize
:components
......@@ -60,3 +60,11 @@
((:module linear-algebra
:components
((:file "linear-algebra-tests")))))
(asdf:defsystem-connection #:math-high-pd
:serial t
:requires (#:math-high #:physical-dimension)
:components
((:module optimize
:components
((:file "one-dim-pq")))))
;; Minimize or maximize the function in one variable, method with physical dimension
;; Liam Healy 2013-11-30 11:59:12EST one-dim-pq.lisp
;; Time-stamp: <2013-11-30 12:02:34EST one-dim-pq.lisp>
;; Copyright 2011, 2013 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; This requires GSLL and physical-dimension
(in-package :antik)
(defmethod root-1d (function (initial physical-quantity) derivative
&optional
(absolute-error 0.0001d0)
(relative-error 0.0001d0)
(method gsl:+newton-fdfsolver+))
(multiple-value-bind (initial-num initial-units)
(pqval initial)
(multiple-value-bind (x f)
(call-next-method
(lambda (x) (pqval (funcall function (make-pq x initial-units))))
initial-num
(lambda (x) (pqval (funcall derivative (make-pq x initial-units))))
absolute-error
relative-error
method)
(values (make-pq x initial-units) f))))
;; Minimize or maximize the function in one variable.
;; Liam Healy 2011-01-14 12:18:15EST minimize.lisp
;; Time-stamp: <2011-04-02 16:57:34EDT one-dim.lisp>
;; Time-stamp: <2013-11-30 12:01:09EST one-dim.lisp>
;; Copyright 2011 Liam M. Healy
;; Copyright 2011, 2013 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
;;
;; This program is free software: you can redistribute it and/or modify
......@@ -24,41 +24,22 @@
(export '(root-1d minimize-1d maximize-1d))
(defun root-1d (function initial derivative
&optional
(absolute-error 0.0001d0)
(relative-error 0.0001d0)
(method gsl:+newton-fdfsolver+))
"Find the root of a real function of a real variable. Returns the
argument value of the root and the computed value of the function at
that value. The argument and return values may be physical quantities."
(flet ((root-1d-nopq ; If argument is a number
(function initial derivative absolute-error relative-error method)
(let ((solver (gsl:make-one-dimensional-root-solver-fdf
method
function derivative
(lambda (x) (values (funcall function x) (funcall derivative x)))
initial)))
(iter (for oldroot first initial then root)
(gsl:iterate solver)
(for root = (gsl:solution solver))
(until (and
oldroot
(gsl:root-test-delta root oldroot absolute-error relative-error))))
(values (gsl:solution solver) (funcall function (gsl:solution solver))))))
(if (physical-quantity-p initial)
(multiple-value-bind (initial-num initial-units)
(pqval initial)
(multiple-value-bind (x f)
(root-1d-nopq
(lambda (x) (pqval (funcall function (make-pq x initial-units))))
initial-num
(lambda (x) (pqval (funcall derivative (make-pq x initial-units))))
absolute-error
relative-error
method)
(values (make-pq x initial-units) f)))
(root-1d-nopq function initial derivative absolute-error relative-error method))))
(defgeneric root-1d (function initial derivative &optional absolute-error relative-error method)
(:documentation
"Find the root of a real function of a real variable. Returns the argument value of the root and the computed value of the function at that value. The argument and return values may be physical quantities.")
(:method (function (initial t) derivative &optional absolute-error relative-error method)
(let ((solver (gsl:make-one-dimensional-root-solver-fdf
method
function derivative
(lambda (x) (values (funcall function x) (funcall derivative x)))
initial)))
(iter (for oldroot first initial then root)
(gsl:iterate solver)
(for root = (gsl:solution solver))
(until (and
oldroot
(gsl:root-test-delta root oldroot absolute-error relative-error))))
(values (gsl:solution solver) (funcall function (gsl:solution solver))))))
(defun minimize-1d
(function x-lower x-upper
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment