Commit 17e1abc2 authored by Liam M. Healy's avatar Liam M. Healy
Browse files

Destination default if first source, and if subsequence sources, are not grids

Look through all sources for a "model" grid from which to extract
default destination specification, and if none is found, then make a
specification from global grid defaults.  This replaces looking at the
first source and generating an erroneous input if it's not a grid.
parent ad04bd80
;; Functions on grids
;; Liam Healy 2010-06-19 22:25:17EDT functions.lisp
;; Time-stamp: <2011-09-09 23:03:11EDT functions.lisp>
;; Time-stamp: <2012-11-24 15:46:32EST functions.lisp>
;; Copyright 2010, 2011 Liam M. Healy
;; Copyright 2010, 2011, 2012 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
......@@ -63,6 +63,8 @@
(defgeneric specification (grid)
(:documentation "The grid specification.")
(:method ((grid t))
(unless (gridp grid)
(error "No specification for a non-grid ~a." grid))
(cons
(cons (gridp grid) (dimensions grid))
(list (element-type grid)))))
......
;; Map and old grid to a new grid
;; Liam Healy 2009-11-15 18:05:16EST map.lisp
;; Time-stamp: <2012-11-12 08:16:52EST map.lisp>
;; Time-stamp: <2012-11-24 15:44:47EST map.lisp>
;;
;; Copyright 2009, 2010, 2012 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -46,13 +46,13 @@
;;; Elementwise mapping over multiple grids.
(defun map-n-grids
(&key sources
;; destination grid information
destination destination-affi destination-specification
initial-element ; default value
;; functions to apply
(element-functions (make-list (length sources) :initial-element nil))
combination-function
(combine-destination (or initial-element destination)))
;; destination grid information
destination destination-affi destination-specification
initial-element ; default value
;; functions to apply
(element-functions (make-list (length sources) :initial-element nil))
combination-function
(combine-destination (or initial-element destination)))
"Map on multiple source grids. The arguments are:
sources:
A list of (grid-or-function affi), each one representing
......@@ -82,19 +82,19 @@
If true, pass as the first argument to the combination-function
the prior value of the destination grid. Defaults to T if
:desination is specified; otherwise nil."
(let ((sources ; Warning! sources being redefined
(loop for source in sources
collect
(cons
(if (and (first source) (not (gridp (first source))))
nil
(first source))
(rest source))))
(index-functions ; Separate out the functions (if any) in the sources
(loop for source in sources
collect
(when (and (first source) (not (gridp (first source))))
(first source)))))
(let ((sources ; Warning! sources being redefined
(loop for source in sources
collect
(cons
(if (and (first source) (not (gridp (first source))))
nil
(first source))
(rest source))))
(index-functions ; Separate out the functions (if any) in the sources
(loop for source in sources
collect
(when (and (first source) (not (gridp (first source))))
(first source)))))
(dolist (source sources) ; set all the source affis
(unless (second source) (setf (second source) (affi (first source)))))
(unless destination-affi
......@@ -106,24 +106,29 @@
(setf destination
(make-destination
destination-affi
(or destination-specification (specification (caar sources)))
(or destination-specification
(alexandria:if-let
(source-grid (find (alexandria:compose #'gridp #'first) sources))
;; Find the first grid in the sources on which to model the destination grid
(specification source-grid)
(make-specification *default-grid-type* *default-dimensions* *default-element-type*)))
initial-element)))
(let* ((source-walkers
(mapcar (lambda (s) (affi:make-walker (second s))) sources))
(mapcar (lambda (s) (affi:make-walker (second s))) sources))
source-inds
(dest-walker (affi:make-walker destination-affi))
(destination-index nil))
(block loop
(loop
(setf source-inds
(loop for w in source-walkers
for inds = (funcall w)
unless inds do (return-from loop)
collect inds)
destination-index
(or (funcall dest-walker) (return-from loop))
(grid:aref* destination destination-index)
(let ((tsrcs
(setf source-inds
(loop for w in source-walkers
for inds = (funcall w)
unless inds do (return-from loop)
collect inds)
destination-index
(or (funcall dest-walker) (return-from loop))
(grid:aref* destination destination-index)
(let ((tsrcs
(mapcar
(lambda (element-function index-function source source-index)
(funcall
......@@ -138,12 +143,12 @@
index-functions
sources
source-inds)))
(if combination-function ; must have combination-function if >1 source
(if combine-destination
(apply combination-function
(grid:aref* destination destination-index) tsrcs)
(apply combination-function tsrcs))
(first tsrcs)))))))
(if combination-function ; must have combination-function if >1 source
(if combine-destination
(apply combination-function
(grid:aref* destination destination-index) tsrcs)
(apply combination-function tsrcs))
(first tsrcs)))))))
destination))
(defun map-grid
......
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