14: Removed record from ARC file that the ARCReader didn't like

filedesc://WCT-20070813080023-00003-skynet.arc.open 0.0.0.0 20070813080023 text/plain 1157
1 1 InternetArchive
URL IP-address Archive-date Content-type Archive-length
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<arcmetadata xmlns:dc="http://purl.org/dc/elements/1.1/" xmlns:dcterms="http://purl.org/dc/terms/" xmlns:arc="http://archive.org/arc/1.0/" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns="http://archive.org/arc/1.0/" xsi:schemaLocation="http://archive.org/arc/1.0/ http://www.archive.org/arc/1.0/arc.xsd">
<arc:software>Heritrix 1.8.0 http://crawler.archive.org</arc:software>
<arc:hostname>skynet</arc:hostname>
<arc:ip>192.122.171.75</arc:ip>
<arc:operator>WCT</arc:operator>
<ns0:date xmlns:ns0="http://purl.org/dc/elements/1.1/" xsi:type="dcterms:W3CDTF">2007-08-13T08:00:21+00:00</ns0:date>
<arc:http-header-user-agent>Mozilla/5.0 (compatible; heritrix/1.8.0 +http://webcurator.sourceforge.net/)</arc:http-header-user-agent>
<arc:http-header-from>wct-noreply@natlib.govt.nz</arc:http-header-from>
<arc:robots>ignore</arc:robots>
<dc:format>ARC file version 1.1</dc:format>
<dcterms:conformsTo xsi:type="dcterms:URI">http://www.archive.org/web/researcher/ArcFileFormat.php</dcterms:conformsTo>
</arcmetadata>

dns:www.nzcee.co.nz 192.122.171.130 20070813080023 text/dns 56
20070813080023
www.nzcee.co.nz.	3600	IN	A	202.27.243.13

http://www.nzcee.co.nz/ 202.27.243.13 20070813080025 text/html 12057
HTTP/1.1 200 OK
Connection: close
Date: Mon, 13 Aug 2007 08:01:15 GMT
Server: Microsoft-IIS/6.0
X-Powered-By: ASP.NET
Content-Length: 11793
Content-Type: text/html
Set-Cookie: ASPSESSIONIDCQBDCCTQ=HMHBKCEDMOJJIMPGCOMIKGPH; path=/
Cache-control: private

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">

  <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">

  <title>NZCEE: New Zealand Center for Ecological Economics</title>

  <meta name="Keywords" content="Ecological economics, ecological footprints, environmental accounting, environmental valuation, New Zealand, Massey University, Manaaki Whenua, Landcare Research, systems dynamics">
  <meta name="Description" content="The New Zealand Centre for Ecological Economics, based in New Zealand, works in the ecological economics, ecological footprints, environmental accounting, environmental valuation, systems dynamics areas">
  <meta name="Abstract" content="The New Zealand Centre for Ecological Economics, based in New Zealand, works in the ecological economics, ecological footprints, environmental accounting, environmental valuation, systems dynamics areas">
  <meta name="Security" content="public">
  <meta name="DC.Rights" content="Copyright (c) 2005 by NZCEE">
  <meta name="Robots" content="index,follow">
  <meta name="DC.Language" scheme="rfc1766" content="en-NZ">

  <link rel="stylesheet" href="css/NZCEE_rma.css" type="text/css">
  <link rel="stylesheet" href="css/nzcee_print.css" type="text/css" media="print">
  <link rel="stylesheet" href="css/nzcee_header_homepage.css" type="text/css">

  <link rel="shortcut icon" href="/favicon.ico" type="image/x-icon">

								Home |
								About NZCEE |
								Research Projects |
								Expertise & Services |
								Publications |
								Contact Us

 <form style="margin-top: 4px; margin-bottom: 4px;" method="get" name="searchform" action="http://www.google.co.nz/search" target="_blank"> <input name="as_sitesearch" value="www.nzcee.org.nz" type="hidden"/> <input style="width: 120px;" name="as_q" size="20" type="text"/> <input value="Search site" type="submit"/>
 </form>

Welcome to the New Zealand Centre for Ecological Economics (NZCEE) Website

The New Zealand Centre for Ecological Economics conducts  research that explores the links between   the environment, economy and people.

Our research goal is to explore ways the quality of the New Zealand environment can be   maintained and enhanced while still allowing the economy and people of New Zealand to   prosper.

Manaaki Whenua - Landcare Research and Massey University are collaborative   partners in this research centre.

The new reality show "WA$TED" that airs 8pm Tuesdays on TV3  uses an Ecological Footprint Calculator produced by NZCEE. You can calculate your own "household footprint" at the WA$TED website: http://www.wastedtv.co.nz/index.cfm?&action=calculator

To link to NZCEE's latest newsletter August 2007

					This WWW site and all contents are the copyright of

					Landcare Research New Zealand Ltd (Disclaimer) and

					Massey University 2007 (Disclaimer).

					This website is hosted by Landcare Research.

filedesc://WCT-20070813080023-00003-skynet.arc.open 0.0.0.0 20070813080023 text/plain 1157
1 1 InternetArchive
URL IP-address Archive-date Content-type Archive-length
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<arcmetadata xmlns:dc="http://purl.org/dc/elements/1.1/" xmlns:dcterms="http://purl.org/dc/terms/" xmlns:arc="http://archive.org/arc/1.0/" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns="http://archive.org/arc/1.0/" xsi:schemaLocation="http://archive.org/arc/1.0/ http://www.archive.org/arc/1.0/arc.xsd">
<arc:software>Heritrix 1.8.0 http://crawler.archive.org</arc:software>
<arc:hostname>skynet</arc:hostname>
<arc:ip>192.122.171.75</arc:ip>
<arc:operator>WCT</arc:operator>
<ns0:date xmlns:ns0="http://purl.org/dc/elements/1.1/" xsi:type="dcterms:W3CDTF">2007-08-13T08:00:21+00:00</ns0:date>
<arc:http-header-user-agent>Mozilla/5.0 (compatible; heritrix/1.8.0 +http://webcurator.sourceforge.net/)</arc:http-header-user-agent>
<arc:http-header-from>wct-noreply@natlib.govt.nz</arc:http-header-from>
<arc:robots>ignore</arc:robots>
<dc:format>ARC file version 1.1</dc:format>
<dcterms:conformsTo xsi:type="dcterms:URI">http://www.archive.org/web/researcher/ArcFileFormat.php</dcterms:conformsTo>
</arcmetadata>

dns:www.nzcee.co.nz 192.122.171.130 20070813080023 text/dns 56
20070813080023
www.nzcee.co.nz.	3600	IN	A	202.27.243.13

http://www.nzcee.co.nz/robots.txt 202.27.243.13 20070813080025 text/html 1814
HTTP/1.1 404 Not Found
Content-Length: 1635
Content-Type: text/html
Server: Microsoft-IIS/6.0
X-Powered-By: ASP.NET
Date: Mon, 13 Aug 2007 08:01:15 GMT
Connection: close

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">
<TITLE>The page cannot be found</TITLE>
<META HTTP-EQUIV="Content-Type" Content="text/html; charset=Windows-1252">

The page cannot be found

The page you are looking for might have been removed, had its name changed, or is temporarily unavailable.

Please try the following:

Make sure that the Web site address displayed in the address bar of your browser is spelled and formatted correctly.

If you reached this page by clicking a link, contact
 the Web site administrator to alert them that the link is incorrectly formatted.

Click the Back button to try another link.

HTTP Error 404 - File or directory not found.
Internet Information Services (IIS)

Technical Information (for support personnel)

Go to Microsoft Product Support Services and perform a title search for the words HTTP and 404.

Open IIS Help, which is accessible in IIS Manager (inetmgr),
 and search for topics titled Web Site Setup, Common Administrative Tasks, and About Custom Error Messages.

http://www.nzcee.co.nz/ 202.27.243.13 20070813080025 text/html 12057
HTTP/1.1 200 OK
Connection: close
Date: Mon, 13 Aug 2007 08:01:15 GMT
Server: Microsoft-IIS/6.0
X-Powered-By: ASP.NET
Content-Length: 11793
Content-Type: text/html
Set-Cookie: ASPSESSIONIDCQBDCCTQ=HMHBKCEDMOJJIMPGCOMIKGPH; path=/
Cache-control: private

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">

  <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">

  <title>NZCEE: New Zealand Center for Ecological Economics</title>

  <meta name="Keywords" content="Ecological economics, ecological footprints, environmental accounting, environmental valuation, New Zealand, Massey University, Manaaki Whenua, Landcare Research, systems dynamics">
  <meta name="Description" content="The New Zealand Centre for Ecological Economics, based in New Zealand, works in the ecological economics, ecological footprints, environmental accounting, environmental valuation, systems dynamics areas">
  <meta name="Abstract" content="The New Zealand Centre for Ecological Economics, based in New Zealand, works in the ecological economics, ecological footprints, environmental accounting, environmental valuation, systems dynamics areas">
  <meta name="Security" content="public">
  <meta name="DC.Rights" content="Copyright (c) 2005 by NZCEE">
  <meta name="Robots" content="index,follow">
  <meta name="DC.Language" scheme="rfc1766" content="en-NZ">

  <link rel="stylesheet" href="css/NZCEE_rma.css" type="text/css">
  <link rel="stylesheet" href="css/nzcee_print.css" type="text/css" media="print">
  <link rel="stylesheet" href="css/nzcee_header_homepage.css" type="text/css">

  <link rel="shortcut icon" href="/favicon.ico" type="image/x-icon">

								Home |
								About NZCEE |
								Research Projects |
								Expertise & Services |
								Publications |
								Contact Us

 <form style="margin-top: 4px; margin-bottom: 4px;" method="get" name="searchform" action="http://www.google.co.nz/search" target="_blank"> <input name="as_sitesearch" value="www.nzcee.org.nz" type="hidden"/> <input style="width: 120px;" name="as_q" size="20" type="text"/> <input value="Search site" type="submit"/>
 </form>

Welcome to the New Zealand Centre for Ecological Economics (NZCEE) Website

The New Zealand Centre for Ecological Economics conducts  research that explores the links between   the environment, economy and people.

Our research goal is to explore ways the quality of the New Zealand environment can be   maintained and enhanced while still allowing the economy and people of New Zealand to   prosper.

Manaaki Whenua - Landcare Research and Massey University are collaborative   partners in this research centre.

The new reality show "WA$TED" that airs 8pm Tuesdays on TV3  uses an Ecological Footprint Calculator produced by NZCEE. You can calculate your own "household footprint" at the WA$TED website: http://www.wastedtv.co.nz/index.cfm?&action=calculator

To link to NZCEE's latest newsletter August 2007

					This WWW site and all contents are the copyright of

					Landcare Research New Zealand Ltd (Disclaimer) and

					Massey University 2007 (Disclaimer).

					This website is hosted by Landcare Research.


arc2b/xe: added symeval special form

arc2b/xe: added symeval special form

; xe = expand expression     xe :: (expr,cte) -> ast

(def xe (e cte)
  (if
    (const-expr? e)
      (xe-const-expr e cte)
    (ident-expr? e)
      (xe-ident-expr e cte)
    (form-expr? e)
      (xe-form-expr e cte)
      (err "syntax-error" e)))

(def const-expr? (e)
  (or (in e t nil) (in (type e) 'int 'num 'char 'string)))

(def ident-expr? (e)
  (isa e 'sym))

(def form-expr? (e)
  (and e (alist e))) ; a non-empty list

(def xe-const-expr (e cte)
  (make-lit '() e))

(def xe-ident-expr (e cte)
  (let b (xe-lookup e cte)
    (if (avar b)
      (make-ref '() b)
      (err "can't reference a nonvariable" e))))

(def xe-form-expr (e cte)
  (let h (car e)
    (let b (and (ident-expr? h) (xe-lookup h cte))
      (if (amacro b)
        (b!expander e cte)
        (make-app (xe-exprs e cte))))))

(def xe-exprs (le cte)
  (map [xe _ cte] le))

(= initial-ctes* '())

(mac add-macro (name nbargs)
  (w/uniq prim-name
    `(let ,prim-name (coerce (+ "%" (coerce ',name 'string)) 'sym)
      (push (make-macro ',name
        (fn (e cte)
          (if (is (len (cdr e)) ,nbargs)
            (make-prim (xe-exprs (cdr e) cte) ,prim-name)
            (err:string ',name " : expects " ,nbargs "arg(s)")))) initial-ctes*))))

(add-macro < 2)
(add-macro > 2)
(add-macro <= 2)
(add-macro >= 2)
(add-macro + 2)
(add-macro - 2)
(add-macro * 2)
(add-macro / 2)
(add-macro mod 2)

(push (make-macro 'do
  (fn (e cte)
    (if
      (is (len (cdr e)) 0)
        (xe nil cte)
      (is (len (cdr e)) 1)
        (xe (cadr e) cte)
        (make-seq (xe-exprs (cdr e) cte))))) initial-ctes*)

(push (make-macro 'let
  (fn (e cte)
    (if (>= (len (cdr e)) 1)
      (xe (list (+ (list 'fn (list e.1)) (cut e 3)) e.2) cte)
      (err "let expects a binding")))) initial-ctes*)

(push (make-macro 'or
  (fn (e cte)
    (if
      (is (len (cdr e)) 0)
        (xe nil cte)
      (is (len (cdr e)) 1)
        (xe (cadr e) cte)
        (xe `((lambda (t1 t2) (if t1 t1 (t2))) ,(cadr e) (lambda () (or ,@(cddr e)))) cte)))) initial-ctes*)

(push (make-macro 'and
  (fn (e cte)
    (if
      (is (len (cdr e)) 0)
        (xe t cte)
      (is (len (cdr e)) 1)
        (xe (cadr e) cte)
        (xe `((lambda (t1 t2) (if t1 (t2) t1)) ,(cadr e) (lambda () (and ,@(cddr e)))) cte)))) initial-ctes*)

(push (make-macro '=
  (fn (e cte)
    (xe (cons 'set (cdr e)) cte))) initial-ctes*)

(push (make-macro 'def
  (fn (e cte)
    (xe `(set ,(cadr e) (fn ,(car:cddr e) ,@(cdr:cddr e))) cte))) initial-ctes*)

;-----------------------------------------------------------------------------
; all the macros above this line should eventually be ported
; into lib-ac.scm.arc or in our version of arc.arc

(push (make-macro 'quote
  (fn (e cte)
    (if (is (len (cdr e)) 1)
      (make-quote '() (cadr e))
      (err "quote expects 1 arg")))) initial-ctes*)

(push (make-macro 'set
  (fn (e cte)
    (if (is (len (cdr e)) 2)
      (let b (xe-lookup (cadr e) cte)
        (if (avar b)
          (make-set (xe-exprs (cddr e) cte) b)
          (err "can't set a nonvariable" e)))
      (err "set expects 2 args")))) initial-ctes*)

(push (make-macro 'if
  (fn (e cte)
    (if
      (is (len (cdr e)) 3)
        (make-cnd (xe-exprs (cdr e) cte))
      (is (len (cdr e)) 2)
        (xe `(if ,(cadr e) ,(car:cddr e) nil) cte)
        (err "if expects 2 or 3 args")))) initial-ctes*)

(push (make-macro 'fn
  (fn (e cte)
    (let (_ exp-params . body) e
      (if (>= (len (cdr e)) 1)
        (withs
          ; support proper and improper lists
          ; as argument list: (arg arg) or (arg . arg)
          (params (map-improper new-var exp-params)
           proper-params (if (alist params) (makeproper params) (cons params nil))
           new-cte (extend proper-params cte))
          (make-lam (list:xe (cons 'do body) new-cte) params))
        (err "fn expects a parameter list"))))) initial-ctes*)

(push (make-macro 'symeval
  (fn (e cte)
    (if (isnt 2 (len e)) (err "symeval expects 1 arg"))
    (let (_ form) e
      (if (caris form 'quote)
          (make-ref '() (xe-lookup (cadr form) '()))
          (make-prim (list:xe form cte) '%symeval))))) initial-ctes*)

(def make-initial-cte ()
  initial-ctes*)

(def xe-lookup (id cte)
  (or
    (lookup id cte)
    (lookup id xe-global-cte*)
    (let v (new-global id)
      (push v xe-global-cte*)
      v)))

(= xe-global-cte* (make-initial-cte))

(def parse-file (filename)
  (= xe-global-cte* (make-initial-cte))
  (xe
    (w/infile f filename
      (cons 'do (readall f
                         (list 'used-to-detect-eof))))
    '()))

; xe = expand expression     xe :: (expr,cte) -> ast

(def xe (e cte)
  (if
    (const-expr? e)
      (xe-const-expr e cte)
    (ident-expr? e)
      (xe-ident-expr e cte)
    (form-expr? e)
      (xe-form-expr e cte)
      (err "syntax-error" e)))

(def const-expr? (e)
  (or (in e t nil) (in (type e) 'int 'num 'char 'string)))

(def ident-expr? (e)
  (isa e 'sym))

(def form-expr? (e)
  (and e (alist e))) ; a non-empty list

(def xe-const-expr (e cte)
  (make-lit '() e))

(def xe-ident-expr (e cte)
  (let b (xe-lookup e cte)
    (if (avar b)
      (make-ref '() b)
      (err "can't reference a nonvariable" e))))

(def xe-form-expr (e cte)
  (let h (car e)
    (let b (and (ident-expr? h) (xe-lookup h cte))
      (if (amacro b)
        (b!expander e cte)
        (make-app (xe-exprs e cte))))))

(def xe-exprs (le cte)
  (map [xe _ cte] le))

(= initial-ctes* '())

(mac add-macro (name nbargs)
  (w/uniq prim-name
    `(let ,prim-name (coerce (+ "%" (coerce ',name 'string)) 'sym)
      (push (make-macro ',name
        (fn (e cte)
          (if (is (len (cdr e)) ,nbargs)
            (make-prim (xe-exprs (cdr e) cte) ,prim-name)
            (err:string ',name " : expects " ,nbargs "arg(s)")))) initial-ctes*))))

(add-macro < 2)
(add-macro > 2)
(add-macro <= 2)
(add-macro >= 2)
(add-macro + 2)
(add-macro - 2)
(add-macro * 2)
(add-macro / 2)
(add-macro mod 2)

(push (make-macro 'do
  (fn (e cte)
    (if
      (is (len (cdr e)) 0)
        (xe nil cte)
      (is (len (cdr e)) 1)
        (xe (cadr e) cte)
        (make-seq (xe-exprs (cdr e) cte))))) initial-ctes*)

(push (make-macro 'let
  (fn (e cte)
    (if (>= (len (cdr e)) 1)
      (xe (list (+ (list 'fn (list e.1)) (cut e 3)) e.2) cte)
      (err "let expects a binding")))) initial-ctes*)

(push (make-macro 'or
  (fn (e cte)
    (if
      (is (len (cdr e)) 0)
        (xe nil cte)
      (is (len (cdr e)) 1)
        (xe (cadr e) cte)
        (xe `((lambda (t1 t2) (if t1 t1 (t2))) ,(cadr e) (lambda () (or ,@(cddr e)))) cte)))) initial-ctes*)

(push (make-macro 'and
  (fn (e cte)
    (if
      (is (len (cdr e)) 0)
        (xe t cte)
      (is (len (cdr e)) 1)
        (xe (cadr e) cte)
        (xe `((lambda (t1 t2) (if t1 (t2) t1)) ,(cadr e) (lambda () (and ,@(cddr e)))) cte)))) initial-ctes*)

(push (make-macro '=
  (fn (e cte)
    (xe (cons 'set (cdr e)) cte))) initial-ctes*)

(push (make-macro 'def
  (fn (e cte)
    (xe `(set ,(cadr e) (fn ,(car:cddr e) ,@(cdr:cddr e))) cte))) initial-ctes*)

;-----------------------------------------------------------------------------
; all the macros above this line should eventually be ported
; into lib-ac.scm.arc or in our version of arc.arc

(push (make-macro 'quote
  (fn (e cte)
    (if (is (len (cdr e)) 1)
      (make-quote '() (cadr e))
      (err "quote expects 1 arg")))) initial-ctes*)

(push (make-macro 'set
  (fn (e cte)
    (if (is (len (cdr e)) 2)
      (let b (xe-lookup (cadr e) cte)
        (if (avar b)
          (make-set (xe-exprs (cddr e) cte) b)
          (err "can't set a nonvariable" e)))
      (err "set expects 2 args")))) initial-ctes*)

(push (make-macro 'if
  (fn (e cte)
    (if
      (is (len (cdr e)) 3)
        (make-cnd (xe-exprs (cdr e) cte))
      (is (len (cdr e)) 2)
        (xe `(if ,(cadr e) ,(car:cddr e) nil) cte)
        (err "if expects 2 or 3 args")))) initial-ctes*)

(push (make-macro 'fn
  (fn (e cte)
    (let (_ exp-params . body) e
      (if (>= (len (cdr e)) 1)
        (withs
          ; support proper and improper lists
          ; as argument list: (arg arg) or (arg . arg)
          (params (map-improper new-var exp-params)
           proper-params (if (alist params) (makeproper params) (cons params nil))
           new-cte (extend proper-params cte))
          (make-lam (list:xe (cons 'do body) new-cte) params))
        (err "fn expects a parameter list"))))) initial-ctes*)

(def make-initial-cte ()
  initial-ctes*)

(def xe-lookup (id cte)
  (or
    (lookup id cte)
    (lookup id xe-global-cte*)
    (let v (new-global id)
      (push v xe-global-cte*)
      v)))

(= xe-global-cte* (make-initial-cte))

(def parse-file (filename)
  (= xe-global-cte* (make-initial-cte))
  (xe
    (w/infile f filename
      (cons 'do (readall f
                         (list 'used-to-detect-eof))))
    '()))


fubared gauss-elim

fubared gauss-elim

(= pi 3.14159265358979323846)
(= e  2.71828182845904523536)

;matrix fns

(def init-matrix(dims initval)
  (zap flat dims)
  (if cdr.dims
    (n-of car.dims (init-matrix cdr.dims initval))
    (n-of car.dims initval)))

(def matrix-rank (mat)
  (if atom.mat 0
      (let rec (afn (M r)
		 (if (atom car.M) r
		     (self car.M (+ r 1))))
	(rec mat 1))))

(def zeros dims
  (init-matrix dims 0))

(def ones dims
  (init-matrix dims 1))

(mac elt (mat pos)
  "access the element of the matix given by co-ords listed in pos"
  (if (cdr pos)
      `(elt (,mat ,(last pos)) ,(butlast pos))
      `(,mat ,(car pos))))

(def mat-to-table (mat)
  "coerces a list-of-lists representation of a matrix into a hash table one where the key is a list of indices (0 referenced)"
  (let ans (table)
       (let rec (afn (X pre)
		  (if (atom:car X)
		      (for i 0 (- len.X 1)
			 (= (ans (cons i pre)) X.i))
		      (for i 0 (- len.X 1)
			 (self X.i (cons i pre)))))
	    (rec mat (list)))
       ans))

(def table-to-mat (tab)
  "coerces a table representation of a matrix into a list-of-lists one"
  (let key-val-lis (list)
    (maptable (fn (key val) (push (cons key val) key-val-lis)) tab)
    (let rec (afn (lis)
	       (if (is (len caar.lis) 1)  (map cdr (sort (fn (x y) (< caar.x caar.y)) lis)) ;if there is only one index sort by it
		   (map (fn (tp) (self:map [cons (butlast car._) cdr._] tp))            ;
			    (tuples (sort (fn (x y) (< (last car.x) (last car.y))) lis) ; if there is more than one index: collect into tuples of the rightmost index and list the answers of rec on each tuple
				    (len:keep [is (last car._) 0] lis)))))              ;

	 (rec key-val-lis))))

(def ident-matrix (rank size (o table? nil))
  (let M (mat-to-table (zeros (n-of rank size)))
       (for i 0 (- size 1)
	 (= (M (n-of size i)) 1))
       (if table? M
	   (table-to-mat M))))

(def matrix-multiply (a b)
  "multiplies the matrix a by the matrix b (N.B. Rank one row vectors need to be in the form ((a b c d ...)) /NOT/ (a b c d), i.e. initiated with dims=(1 n) not (n))"
  (with (col (fn (mat i) (map [_ i] mat))
	 result-matrix (list))
    (for rw 0 (- len.a 1)
          (push (let result-row (list)
		  (for cl 0 (- (len b.0) 1)
		       (push (apply + (map * a.rw (col b cl))) result-row))
		  rev.result-row)
		result-matrix))
    rev.result-matrix));could be generalised as a recursive macro to work on arbitrary rank tensors?

(def gauss-elim (mat rhs)
  "solves the linear equations:

mat_00*x_0 + mat_01*x_1 ... mat_0n*x_n = rhs_0
mat_10*x_0 + mat_11*x_1 ... mat_1n*x_n = rhs_1
...
mat_n0*x_0 + mat_n1*x_1 ... mat_nn*x_n = rhs_n

using gaussian elimination and returns a list of x's (N.B. not efficient for large sparce matrices)"
  (zap flat rhs)
  (if (isa mat 'table)
      (withs (MAX 0
	      i 0 j 0 k 0
	      keys (list)
	      _ (maptable (fn (key _) (push key keys)) mat)
	      N (+ 1 (apply max (map car keys))) N2 (+ 1 (apply max (map cadr keys)))
	      X (if (is N N2 len.rhs) (zeros N) (do (pr "N:")(prn N)(pr "N2:")(prn N2)(pr "rhs:")(prn rhs)(err "mat must be a square matrix of the same size as rhs, use 0 elements for equations which dont feature a variable"))))
	  (let M (copy mat)
	       (for i 0 N (= (M (list (+ 1 N2) i)) rhs.i))
	       ;;elimination step
	       (loop (= i 0) (<= i (- N 1)) (++ i)
		  (= MAX i)
		  (loop (= j (+ i 1)) (<= j (- N 1)) (++ j)
		     (if (> (abs:M (list i j)) (abs:M (list i MAX))) (= MAX j)))
		  (if (isnt MAX i) (let temp ()
					(for a 0 N
					     (= temp (M (list a i)))
					     (= (M (list a i)) (M (list a MAX)))
					     (= (M (list a MAX)) temp))))
		  (loop (= j (+ i 1)) (<= j (- N 1)) (++ j)
		     (loop (= k N) (>= k i) (-- k)
			(-- (M (list k j)) (/ (* (M (list k i)) (M (list i j))) (M (list i i))))))) ;;end of elimination step
	       ;;substitution
	       (loop (= j (- N 1)) (>= j 0) (-- j)
		  (let tmp 0.0
		       (loop (= k (+ j 1)) (<= k(- N 1)) (++ k) (++ tmp (* (M (list k j)) X.k)))
		       (= X.j (/ (- (M (list N j)) tmp) (M (list j j)))))))
	  X)))

;calculus fns

(def deriv (f)
  "provides differential of a function of a single vairable"
  (fn (x)
    (let dx (if (is x 0) 1d-9 (abs:* x 1d-9))
       (/ (- (f (+ x dx))
	     (f x))
          dx))))

(mac partial-diff (f n arity)
  "returns deriv function of f (w/ num args ARITY) wrt Nth variable(from 0) "
  (withs (arglis (n-of arity (uniq))
	  a-lis (firstn n arglis)
	  x arglis.n
	  b-lis (nthcdr (+ n 1) arglis))
    `(fn ,arglis
      (let dx (if (is ,x 0) 1d-9 (abs:* ,x 1d-9))
	(/ (- (,f ,@a-lis (+ ,x dx) ,@b-lis)
	      (,f ,@a-lis    ,x     ,@b-lis))
	   dx)))))

(mac partial-diff-vec (f n arity)
  "returns vector with each element differentiated with respect to Nth argument"
  (withs (arglis (n-of arity (uniq))
	  a-lis (firstn n arglis)
	  x arglis.n
	  b-lis (nthcdr (+ n 1) arglis))
    `(fn ,arglis
	(let dx (if (is ,x 0) 1d-9 (abs:* ,x 1d-9))
	   (vec-scale (vec- (,f ,@a-lis	(+ ,x dx) ,@b-lis)
			    (,f ,@a-lis    ,x     ,@b-lis))
		      (/ 1 dx))))))

(def grad (f)
  "gradient of 3D scalar field given by F"
  (fn (x y z)
    (list ((partial-diff f 0 3) x y z)
	  ((partial-diff f 1 3) x y z)
	  ((partial-diff f 2 3) x y z))))

(def div (f)
  "divergence of 3D vector field given by F"
  (fn (x y z)
      (+ (((partial-diff-vec f 0 3) x y z) 0)
	 (((partial-diff-vec f 1 3) x y z) 1)
	 (((partial-diff-vec f 2 3) x y z) 2))))

(def curl (f)
  "curl of 3D vector field given by F"
  (with (d/dx (partial-diff-vec f 0 3)
	 d/dy (partial-diff-vec f 1 3)
	 d/dz (partial-diff-vec f 2 3))
  (fn (x y z)
    (list (- ((d/dy x y z) 2)
	     ((d/dz x y z) 1))
	  (- ((d/dz x y z) 0)
	     ((d/dx x y z) 2))
	  (- ((d/dx x y z) 1)
	     ((d/dy x y z) 0))))))

(def integral (f)
  "returns the integral of a single argument function using Simpson's method"
  (fn (lower upper (o its 100))
    (withs (dx      (/ (- upper lower) its)
	    x       lower
	    current (f x)
	    next    (f (+ x dx))
	    accum   0)
      (while (<= x (- upper dx))
	     (++ accum (/ (+ (* (+ current next) 1/2 dx)
			     (* 2 dx (f (+ x (/ dx 2)))))
			  3))
	     (++ x dx)
	     (= current next)
	     (= next (f:+ x dx)))
      accum)))

(def adaptive-integral (f)
  (let int (memo:integral f)
       (afn (lower upper (o tol 0.001))
	    (with (a (int lower upper 2)
		   b (int lower upper 8))
	       (if (and (isnt b 0) (< (abs:/ (- a b) b) tol))
		   b
		   (let half (+ lower (/ (- upper lower) 2))
			(+ (self lower half tol) (self half upper tol))))))))

; vector fns

(def vec-dot (v1 v2)
  (apply + (map (fn (x y) (* x y)) v1 v2)))

(def vec-cross (v1 v2 . args)
  (if (car args)(vec-cross (vec-cross v1 v2) (car args) (cdr args))
                (list (- (* v1.1 v2.2) (* v2.1 v1.2))
		      (- (* v1.2 v2.0) (* v2.2 v1.0))
		      (- (* v1.0 v2.1) (* v2.0 v1.1)))))

(with (v+ (fn (v1 v2)
	     (map (fn (x y) (+ x y)) v1 v2))
       v- (fn (v1 v2)
	     (map (fn (x y) (- x y)) v1 v2)))

  (def vec+ (v1 . args)
    (if no.args v1
	(reduce v+ (cons v1 args))))

  (def vec- (v1 . args)
    (if no.args (map [- _] v1)
	(v- v1 (apply vec+ args))))
)

(def vec-scale (vec . scalars)
  (let c (apply * scalars)
    (map [* _ c] vec)))

(def quad-add args
  ((afn (tot xs)
     (if no.xs (sqrt tot)
	 (self (+ tot (expt (car xs) 2)) (cdr xs))))
   0 args))

(def vec-norm (vec)
  (vec-scale vec (/ (apply quad-add vec))))

;others

(def square (x) (* x x))
(def cube (x) (* x x x))
(def floor (n) (trunc n))
(def ceiling (n) (int ($.ceiling n)))
(def highbyte (n) (floor (/ n 256)))
(def lowbyte (n) (mod n 256))

(def fact (num)
  "factorial of num (num must be a fixnum)"
  (if (or (< num 0)(no:isa num 'int)) (err "num must be a positive integer")
      ((afn (n x)
	 (if (<= n 1)
	     x
	     (self (- n 1) (* n x))))
       num 1)))

(def n-bessel (n (o terms 100))
  "gives a fn for the nth bessel function of the first kind evaluated at x"
  (fn (x)
    (with (i 0
	   tot 0)
      (while (< i terms)
	     (++ tot (/ (* (expt -1 i) (expt (/ x 2) (+ n i i)))
			(* (fact i) (fact (+ n i)))))
	     (++ i 1))
      tot)))

(def mean lis
  ((afn (tot i x . xs)
     (if no.xs (/ (+ tot x) (+ i 1))
	 (self (+ tot x) (+ i 1) car.xs cdr.xs)))
   0 0 car.lis cdr.lis))

(def std-dev lis
  (let m mean.lis
    (sqrt:/ (apply + (map [expt (- _ m) 2] lis))
	    len.lis)))

(def choose (n x)
  "number of ways of picking n elements from x (ie no. of ways of mixing 2 different sets of identical objects of size n and (- x n))"
  (if (> n x)
      (do (prn "")(pr n)(pr " is greater than ")(prn x))
      (/ (fact x) (* (fact n) (fact (- x n))))))

(def gauss-random (sigma (o middle 0))
  "aproximation to a gausian distributed random with width sigma around middle, max possible deviation +/- 1000sigma"
  (let tot 0
    (for i 0 999
      (++ tot  (- (* (rand) 2.0) 1)))
    (+ (* tot (/ sigma 25)) middle)))

(def quad-roots (a b c)
  "returns roots of the equation ax^2+bx+c=0"
  (let sqroot (sqrt (- (* b b) (* 4 a c)))
    (if (is sqroot 0) (list (/ (- b) 2 a))
	(list (/ (- sqroot b) 2 a)
	      (/ (- 0 sqroot b) 2 a)))))

(= pi 3.14159265358979323846)
(= e  2.71828182845904523536)

;matrix fns

(def init-matrix(dims initval)
  (zap flat dims)
  (if cdr.dims
    (n-of car.dims (init-matrix cdr.dims initval))
    (n-of car.dims initval)))

(def matrix-rank (mat)
  (if atom.mat 0
      (let rec (afn (M r)
		 (if (atom car.M) r
		     (self car.M (+ r 1))))
	(rec mat 1))))

(def zeros dims
  (init-matrix dims 0))

(def ones dims
  (init-matrix dims 1))

(mac elt (mat pos)
  "access the element of the matix given by co-ords listed in pos"
  (if (cdr pos)
      `(elt (,mat ,(last pos)) ,(butlast pos))
      `(,mat ,(car pos))))

(def mat-to-table (mat)
  "coerces a list-of-lists representation of a matrix into a hash table one where the key is a list of indices (0 referenced)"
  (let ans (table)
       (let rec (afn (X pre)
		  (if (atom:car X)
		      (for i 0 (- len.X 1)
			 (= (ans (cons i pre)) X.i))
		      (for i 0 (- len.X 1)
			 (self X.i (cons i pre)))))
	    (rec mat (list)))
       ans))

(def table-to-mat (tab)
  "coerces a table representation of a matrix into a list-of-lists one"
  (let key-val-lis (list)
    (maptable (fn (key val) (push (cons key val) key-val-lis)) tab)
    (let rec (afn (lis)
	       (if (is (len caar.lis) 1)  (map cdr (sort (fn (x y) (< caar.x caar.y)) lis)) ;if there is only one index sort by it
		   (map (fn (tp) (self:map [cons (butlast car._) cdr._] tp))            ;
			    (tuples (sort (fn (x y) (< (last car.x) (last car.y))) lis) ; if there is more than one index: collect into tuples of the rightmost index and list the answers of rec on each tuple
				    (len:keep [is (last car._) 0] lis)))))              ;

	 (rec key-val-lis))))

(def ident-matrix (rank size (o table? nil))
  (let M (mat-to-table (zeros (n-of rank size)))
       (for i 0 (- size 1)
	 (= (M (n-of size i)) 1))
       (if table? M
	   (table-to-mat M))))

(def matrix-multiply (a b)
  "multiplies the matrix a by the matrix b (N.B. Rank one row vectors need to be in the form ((a b c d ...)) /NOT/ (a b c d), i.e. initiated with dims=(1 n) not (n))"
  (with (col (fn (mat i) (map [_ i] mat))
	 result-matrix (list))
    (for rw 0 (- len.a 1)
          (push (let result-row (list)
		  (for cl 0 (- (len b.0) 1)
		       (push (apply + (map * a.rw (col b cl))) result-row))
		  rev.result-row)
		result-matrix))
    rev.result-matrix));could be generalised as a recursive macro to work on arbitrary rank tensors?

(def gauss-elim (mat rhs)
  "solves the linear equations:

mat_00*x_0 + mat_01*x_1 ... mat_0n*x_n = rhs_0
mat_10*x_0 + mat_11*x_1 ... mat_1n*x_n = rhs_1
...
mat_n0*x_0 + mat_n1*x_1 ... mat_nn*x_n = rhs_n

using gaussian elimination and returns a list of x's (N.B. not efficient for large sparce matrices)"
  (zap flat rhs)
  (if (acons mat)
      (withs (N (if (no (is len.mat (len car.mat))) (err "mat must be a square matrix, use co-effs of 0 for equations which dont have a certain variable in them")
		    len.mat)
		tmp (list)
		MAX 0
		i 0 j 0 k 0
		X (zeros N))
	     (for i 0 (- N 1) (push (join mat.i (cons rhs.i ())) tmp))
	     (let M rev.tmp
		  ;;elimination step
		  (loop (= i 0) (<= i (- N 1)) (++ i)
		     (= MAX i)
		     (loop (= j (+ i 1)) (<= j (- N 1)) (++ j)
			(if (> (abs:elt M (i j)) (abs:elt M (i MAX))) (= MAX j)))
		     (if (isnt MAX i) (swap M.i M.MAX))
		     (loop (= j (+ i 1)) (<= j (- N 1)) (++ j)
			(loop (= k N) (>= k i) (-- k)
			   (-- (elt M (k j)) (/ (* (elt M (k i)) (elt M (i j))) (elt M (i i))))))) ;;end of elimination step
		  ;;substitution
		  (loop (= j (- N 1)) (>= j 0) (-- j)
		     (= tmp 0.0)
		     (loop (= k (+ j 1)) (<= k(- N 1)) (++ k) (++ tmp (* (elt M (k j)) X.k)))
		     (= X.j (/ (- (elt M (N j)) tmp) (elt M (j j))))))
	     X)
      (do (zap table-to-mat mat)
	  (withs (N (if (no (is len.mat (len car.mat))) (err "mat must be a square matrix, use co-effs of 0 for equations which dont have a certain variable in them")
			len.mat)
		    tmp (list)
		    MAX 0
		    i 0 j 0 k 0
		    X (zeros N))
		 (for i 0 (- N 1) (push (join mat.i (cons rhs.i ())) tmp))
		 (let M (mat-to-table rev.tmp)
		      ;;elimination step
		      (loop (= i 0) (<= i (- N 1)) (++ i)
			 (= MAX i)
			 (loop (= j (+ i 1)) (<= j (- N 1)) (++ j)
			    (if (> (abs:M (list i j)) (abs:M (list i MAX))) (= MAX j)))
			 (if (isnt MAX i) (let temp ()
					       (for a 0 N
						 (= temp (M (list a i)))
						 (= (M (list a i)) (M (list a MAX)))
						 (= (M (list a MAX)) temp))))
			 (loop (= j (+ i 1)) (<= j (- N 1)) (++ j)
			    (loop (= k N) (>= k i) (-- k)
			       (-- (M (list k j)) (/ (* (M (list k i)) (M (list i j))) (M (list i i))))))) ;;end of elimination step
		      ;;substitution
		      (loop (= j (- N 1)) (>= j 0) (-- j)
			 (= tmp 0.0)
			 (loop (= k (+ j 1)) (<= k(- N 1)) (++ k) (++ tmp (* (M (list k j)) X.k)))
			 (= X.j (/ (- (M (list N j)) tmp) (M (list j j))))))
	     X))))

;calculus fns

(def deriv (f)
  "provides differential of a function of a single vairable"
  (fn (x)
    (let dx (if (is x 0) 1d-9 (abs:* x 1d-9))
       (/ (- (f (+ x dx))
	     (f x))
          dx))))

(mac partial-diff (f n arity)
  "returns deriv function of f (w/ num args ARITY) wrt Nth variable(from 0) "
  (withs (arglis (n-of arity (uniq))
	  a-lis (firstn n arglis)
	  x arglis.n
	  b-lis (nthcdr (+ n 1) arglis))
    `(fn ,arglis
      (let dx (if (is ,x 0) 1d-9 (abs:* ,x 1d-9))
	(/ (- (,f ,@a-lis (+ ,x dx) ,@b-lis)
	      (,f ,@a-lis    ,x     ,@b-lis))
	   dx)))))

(mac partial-diff-vec (f n arity)
  "returns vector with each element differentiated with respect to Nth argument"
  (withs (arglis (n-of arity (uniq))
	  a-lis (firstn n arglis)
	  x arglis.n
	  b-lis (nthcdr (+ n 1) arglis))
    `(fn ,arglis
	(let dx (if (is ,x 0) 1d-9 (abs:* ,x 1d-9))
	   (vec-scale (vec- (,f ,@a-lis	(+ ,x dx) ,@b-lis)
			    (,f ,@a-lis    ,x     ,@b-lis))
		      (/ 1 dx))))))

(def grad (f)
  "gradient of 3D scalar field given by F"
  (fn (x y z)
    (list ((partial-diff f 0 3) x y z)
	  ((partial-diff f 1 3) x y z)
	  ((partial-diff f 2 3) x y z))))

(def div (f)
  "divergence of 3D vector field given by F"
  (fn (x y z)
      (+ (((partial-diff-vec f 0 3) x y z) 0)
	 (((partial-diff-vec f 1 3) x y z) 1)
	 (((partial-diff-vec f 2 3) x y z) 2))))

(def curl (f)
  "curl of 3D vector field given by F"
  (with (d/dx (partial-diff-vec f 0 3)
	 d/dy (partial-diff-vec f 1 3)
	 d/dz (partial-diff-vec f 2 3))
  (fn (x y z)
    (list (- ((d/dy x y z) 2)
	     ((d/dz x y z) 1))
	  (- ((d/dz x y z) 0)
	     ((d/dx x y z) 2))
	  (- ((d/dx x y z) 1)
	     ((d/dy x y z) 0))))))

(def integral (f)
  "returns the integral of a single argument function using Simpson's method"
  (fn (lower upper (o its 100))
    (withs (dx      (/ (- upper lower) its)
	    x       lower
	    current (f x)
	    next    (f (+ x dx))
	    accum   0)
      (while (<= x (- upper dx))
	     (++ accum (/ (+ (* (+ current next) 1/2 dx)
			     (* 2 dx (f (+ x (/ dx 2)))))
			  3))
	     (++ x dx)
	     (= current next)
	     (= next (f:+ x dx)))
      accum)))

(def adaptive-integral (f)
  (let int (memo:integral f)
       (afn (lower upper (o tol 0.001))
	    (with (a (int lower upper 2)
		   b (int lower upper 8))
	       (if (and (isnt b 0) (< (abs:/ (- a b) b) tol))
		   b
		   (let half (+ lower (/ (- upper lower) 2))
			(+ (self lower half tol) (self half upper tol))))))))

; vector fns

(def vec-dot (v1 v2)
  (apply + (map (fn (x y) (* x y)) v1 v2)))

(def vec-cross (v1 v2 . args)
  (if (car args)(vec-cross (vec-cross v1 v2) (car args) (cdr args))
                (list (- (* v1.1 v2.2) (* v2.1 v1.2))
		      (- (* v1.2 v2.0) (* v2.2 v1.0))
		      (- (* v1.0 v2.1) (* v2.0 v1.1)))))

(with (v+ (fn (v1 v2)
	     (map (fn (x y) (+ x y)) v1 v2))
       v- (fn (v1 v2)
	     (map (fn (x y) (- x y)) v1 v2)))

  (def vec+ (v1 . args)
    (if no.args v1
	(reduce v+ (cons v1 args))))

  (def vec- (v1 . args)
    (if no.args (map [- _] v1)
	(v- v1 (apply vec+ args))))
)

(def vec-scale (vec . scalars)
  (let c (apply * scalars)
    (map [* _ c] vec)))

(def quad-add args
  ((afn (tot xs)
     (if no.xs (sqrt tot)
	 (self (+ tot (expt (car xs) 2)) (cdr xs))))
   0 args))

(def vec-norm (vec)
  (vec-scale vec (/ (apply quad-add vec))))

;others

(def square (x) (* x x))
(def cube (x) (* x x x))
(def floor (n) (trunc n))
(def ceiling (n) (int ($.ceiling n)))
(def highbyte (n) (floor (/ n 256)))
(def lowbyte (n) (mod n 256))

(def fact (num)
  "factorial of num (num must be a fixnum)"
  (if (or (< num 0)(no:isa num 'int)) (err "num must be a positive integer")
      ((afn (n x)
	 (if (<= n 1)
	     x
	     (self (- n 1) (* n x))))
       num 1)))

(def n-bessel (n (o terms 100))
  "gives a fn for the nth bessel function of the first kind evaluated at x"
  (fn (x)
    (with (i 0
	   tot 0)
      (while (< i terms)
	     (++ tot (/ (* (expt -1 i) (expt (/ x 2) (+ n i i)))
			(* (fact i) (fact (+ n i)))))
	     (++ i 1))
      tot)))

(def mean lis
  ((afn (tot i x . xs)
     (if no.xs (/ (+ tot x) (+ i 1))
	 (self (+ tot x) (+ i 1) car.xs cdr.xs)))
   0 0 car.lis cdr.lis))

(def std-dev lis
  (let m mean.lis
    (sqrt:/ (apply + (map [expt (- _ m) 2] lis))
	    len.lis)))

(def choose (n x)
  "number of ways of picking n elements from x (ie no. of ways of mixing 2 different sets of identical objects of size n and (- x n))"
  (if (> n x)
      (do (prn "")(pr n)(pr " is greater than ")(prn x))
      (/ (fact x) (* (fact n) (fact (- x n))))))

(def gauss-random (sigma (o middle 0))
  "aproximation to a gausian distributed random with width sigma around middle, max possible deviation +/- 1000sigma"
  (let tot 0
    (for i 0 999
      (++ tot  (- (* (rand) 2.0) 1)))
    (+ (* tot (/ sigma 25)) middle)))

(def quad-roots (a b c)
  "returns roots of the equation ax^2+bx+c=0"
  (let sqroot (sqrt (- (* b b) (* 4 a c)))
    (if (is sqroot 0) (list (/ (- b) 2 a))
	(list (/ (- sqroot b) 2 a)
	      (/ (- 0 sqroot b) 2 a)))))