Commit 2b6faf80 authored by Liam Healy's avatar Liam Healy

Merge branch 'master' into documentation

Conflicts:
	grid/iterate.lisp
	init/package.lisp
	optimize/one-dim.lisp
parents ed8d8676 b6c0fc62
;; Make arrays from other arrays
;; Liam Healy 2009-11-11 11:33:22EST compose-array.lisp
;; Time-stamp: <2011-12-03 20:38:35EST compose.lisp>
;; Time-stamp: <2013-11-11 11:41:28EST compose.lisp>
;;
;; Copyright 2009, 2010, 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -167,9 +167,10 @@ is an optional pre-existing grid in which to write the result."
diagonal)
;;; This could become a more general to make a grid?
(defun make-grid-with-diagonal (diagonal &key (offset 0) initial-element)
(defun make-grid-with-diagonal (diagonal &key (offset 0) (initial-element 0))
"Make a matrix with the default element, setting the diagonal
to the given diagonal."
;; [2013-11-11 Mon 11:40] If initial-element is nil (the previous default), it seems to grab a random grid from memory and return it.
(let ((grid
(make-grid
(merge-specification
......
;; Iterate
;; Norman Werner 2009-05-26 22:23:40EDT iterate.lisp
;; Time-stamp: <2013-12-25 15:40:34EST iterate.lisp>
;; Time-stamp: <2015-11-19 22:42:29EST iterate.lisp>
;;
;; Copyright 2009, 2013 Norman Werner, Liam M. Healy
;; Copyright 2009, 2013, 2014, 2015 Norman Werner, 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
......@@ -62,6 +62,7 @@ As an example try:
:element-doc-string "(copied) columns of a matrix"
:index-doc-string "index of the columns in a matrix")
;;; Define the defclause-sequence on vectors for iter:for. To be consistent with matrix elements, this shouldn't be defined, but it is used in macroexpansion to define the antik:for clauses, and there's little harm in leaving it in.
(defclause-sequence vector-element vector-element-index
:access-fn
'(lambda (vector index)
......@@ -77,7 +78,41 @@ As an example try:
:element-doc-string "(copied) elements of a vector"
:index-doc-string "index of elements in a vector")
(defmacro-driver (FOR element matrix-element matrix)
;;; Define the defclause-sequence on vectors for antik:for
(PROGN
(DEFCLAUSE-DRIVER (antik:FOR VAR VECTOR-ELEMENT SEQ &SEQUENCE)
"(copied) elements of a vector"
(RETURN-SEQUENCE-CODE :ELEMENT-VAR VAR :SEQUENCE SEQ :ACCESS-FN
'(LAMBDA (VECTOR INDEX)
(ASSERT
(AND (GRID:GRIDP VECTOR)
(EQL (GRID:RANK VECTOR) 1))
(VECTOR))
(GRID:AREF VECTOR INDEX))
:SIZE-FN
'(LAMBDA (VECTOR)
(ASSERT
(AND (GRID:GRIDP VECTOR)
(EQL (GRID:RANK VECTOR) 1))
(VECTOR))
(FIRST (GRID:DIMENSIONS VECTOR)))
:ELEMENT-TYPE T :SEQUENCE-TYPE T))
(DEFCLAUSE-DRIVER (antik:FOR VAR VECTOR-ELEMENT-INDEX SEQ &SEQUENCE)
"index of elements in a vector"
(COND
(WITH-INDEX
(CLAUSE-ERROR "WITH-INDEX should not be specified for this clause"))
(T (SETQ WITH-INDEX VAR)
(RETURN-SEQUENCE-CODE :SEQUENCE SEQ :SIZE-FN
'(LAMBDA (VECTOR)
(ASSERT
(AND (GRID:GRIDP VECTOR)
(EQL (GRID:RANK VECTOR) 1))
(VECTOR))
(FIRST (GRID:DIMENSIONS VECTOR)))
:SEQUENCE-TYPE T)))))
(defmacro-driver (antik:FOR element matrix-element matrix)
"Iterates over all (copied) elements in matrix"
(alexandria:with-unique-names (row-index col-index row-size col-size m)
(when generate
......@@ -88,7 +123,7 @@ As an example try:
(with ,col-index = 0)
(with ,row-size = (first (grid:dimensions ,m)))
(with ,col-size = (second (grid:dimensions ,m)))
(for ,element
(iter:for ,element
:next
(if (>= ,row-index ,row-size)
(terminate)
......@@ -105,7 +140,7 @@ As an example try:
(grid:aref ,m ,row-index ,col-index)
(incf ,col-index))))))))
(defmacro-driver (FOR indexes matrix-element-index matrix)
(defmacro-driver (antik:FOR indexes matrix-element-index matrix)
"Iterates over the indexes in matrix. indexes is a list like (row-index-name
column-index-name) "
(alexandria:with-unique-names (row-index col-index row-size col-size m)
......@@ -117,7 +152,7 @@ As an example try:
(with ,col-index = 0)
(with ,row-size = (first (grid:dimensions ,m)))
(with ,col-size = (second (grid:dimensions ,m)))
(for ,indexes next (if (>= ,row-index ,row-size)
(iter:for ,indexes next (if (>= ,row-index ,row-size)
(terminate)
(if (>= ,col-index ,col-size)
(progn
......
;; Extend the iterate macro
;; Liam Healy 2008-12-22 16:02:33EST iterate.lisp
;; Time-stamp: <2011-10-18 19:34:31EDT iterate.lisp>
;; Time-stamp: <2014-02-01 10:35:29EST iterate.lisp>
;; Copyright 2011 Liam M. Healy
;; Copyright 2008, 2011, 2014 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
......@@ -20,7 +20,7 @@
(in-package :iterate)
(defclause-driver (for var-spec &sequence)
(defclause-driver (antik:for var-spec &sequence)
"Numbers"
(top-level-check)
(if with-index
......@@ -67,16 +67,22 @@
;;; Shamelessly cribbed from the iterate manual
(defmacro-clause (MULTIPLY expr &optional INTO var)
(defmacro-clause (antik:MULTIPLY expr &optional INTO var)
`(reducing ,expr by #'antik::*i into ,var initial-value 1))
(defmacro-clause (SUM expr &optional INTO var)
(defsynonym antik:multiplying antik:multiply)
(defmacro-clause (antik:SUM expr &optional INTO var)
`(reducing ,expr by #'antik::+i into ,var initial-value 0))
(defclause (maximize expr &optional into var)
(defsynonym antik:summing antik:sum)
(defclause (antik:maximize expr &optional into var)
"Maximize value of an expression"
(return-extremum-code expr var 'antik:max))
(defsynonym antik:maximizing antik:maximize)
#|
;;; This does not work; can't use 'leave
(defmacro-clause (FINDING expr MAXIMIZING func &optional INTO var)
......@@ -98,10 +104,12 @@
(finally (leave ,winner))))))
|#
(defclause (minimize expr &optional into var)
(defclause (antik:minimize expr &optional into var)
"Minimize value of an expression"
(return-extremum-code expr var 'antik:min))
(defsynonym antik:minimizing antik:minimize)
#|
;;; This does not work
(defmacro-clause (FINDING expr MINIMIZING func &optional INTO var)
......
;; Define package and reader for Antik
;; Liam Healy 2010-12-24 09:12:15EST package.lisp
;; Time-stamp: <2015-04-05 22:34:43EDT package.lisp>
;; Time-stamp: <2015-11-19 22:41:32EST package.lisp>
;; Copyright 2010, 2011, 2015 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -21,18 +21,23 @@
(in-package :cl-user)
(defpackage #:antik
;; (:nicknames)
(:shadow #:+ #:- #:* #:/
#:sin #:cos #:tan #:asin #:acos #:atan
#:sinh #:cosh #:tanh
#:sqrt #:expt #:log #:exp #:abs
#:plusp #:minusp #:zerop #:min #:max
#:= #:>= #:> #:<= #:<
#:coerce #:floor #:round #:signum
#:incf #:decf
#:length #:time
#+ccl #:@)
(:export #:make-user-package #:physical-quantity #:physical-quantity-p #:@)
;; (:nicknames)
(:shadow #:+ #:- #:* #:/
#:sin #:cos #:tan #:asin #:acos #:atan
#:sinh #:cosh #:tanh
#:sqrt #:expt #:log #:exp #:abs
#:plusp #:minusp #:zerop #:min #:max
#:= #:>= #:> #:<= #:<
#:coerce #:floor #:round #:signum
#:incf #:decf
#:length #:time
;; Iterate clause redefinitions
#:for #:sum #:summing #:multiply #:multiplying
#:minimize #:minimizing #:maximize #:maximizing
#+ccl #:@)
(:export #:make-user-package #:physical-quantity #:physical-quantity-p #:@
#:for #:sum #:summing #:multiply #:multiplying
#:minimize #:minimizing #:maximize #:maximizing)
(:use #:common-lisp #:iterate))
;; As a consolation for 'antik:* shadowing 'cl:* for things like
......
;; Minimize or maximize the function in one variable.
;; Liam Healy 2011-01-14 12:18:15EST minimize.lisp
;; Time-stamp: <2013-11-30 12:01:09EST one-dim.lisp>
;; Time-stamp: <2015-11-19 22:40:44EST one-dim.lisp>
;; Copyright 2011, 2013 Liam M. Healy
;; Copyright 2011, 2014, 2015 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
......@@ -33,9 +33,9 @@
function derivative
(lambda (x) (values (funcall function x) (funcall derivative x)))
initial)))
(iter (for oldroot first initial then root)
(iter (iter:for oldroot first initial then root)
(gsl:iterate solver)
(for root = (gsl:solution solver))
(iter:for root = (gsl:solution solver))
(until (and
oldroot
(gsl:root-test-delta root oldroot absolute-error relative-error))))
......
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