;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; LUSH Lisp Universal Shell
;;;   Copyright (C) 2002 Leon Bottou, Yann Le Cun, AT&T Corp, NECI.
;;; Includes parts of TL3:
;;;   Copyright (C) 1987-1999 Leon Bottou and Neuristique.
;;; Includes selected parts of SN3.2:
;;;   Copyright (C) 1991-2001 AT&T Corp.
;;;
;;; 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 2 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, write to the Free Software
;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; $Id: idx-array.lsh,v 1.2 2002/08/19 17:47:10 leonb Exp $
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

#? *** Arrays of vectors and matrices
;; arrays of idx1 of floats, and idx2 of floats.
;; This class is convenient way of handling sets
;; of vectors or matrices of disparate sizes.



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; class: array of vectors of floats
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(libload "dynamic")


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
#? (to-idx1flt <gptr>)
;; Casts a gptr into a (-idx1- (-flt-))
;; No checks are performed in compiled mode.
(de to-idx1flt(g)
  (when (is-of-class g |GPTR|)
    (setq g (to-obj g)) )
  (when (not (and (indexp g) 
                  (= (idx-ndim g) 1)
                  (is-of-class (idx-storage g) |FSTORAGE|) ))
    (error 'to-idx1flt "Incorrect index type" g) )
  g )

#? (to-idx2flt <gptr>)
;; Casts a gptr into a (-idx2- (-flt-))
;; No checks are performed in compiled mode.
(de to-idx2flt(g)
  (when (is-of-class g |GPTR|)
    (setq g (to-obj g)) )
  (when (not (and (indexp g) 
                  (= (idx-ndim g) 2)
                  (is-of-class (idx-storage g) |FSTORAGE|) ))
    (error 'to-idx2flt "Incorrect index type" g) )
  g )

(putp to-idx1flt 'dharg '(1 . dht-flt))
(putp to-idx2flt 'dharg '(2 . dht-flt))

(dhm-t to-idx1flt(source)
  (when (<> 2 (length source))
    (dhc-error "one arguments was expected" source) )
  (let* ((dharg (getp (get-dhm-target source) 'dharg))
         (xnode (dhc-parse-expr-t (cadr source))) 
         (type ()) )
    (setq type (new dhc-type 'dht-ptr
                    (new dhc-type 'dht-idx (car dharg)
                         (new dhc-type 'dht-srg
                              (new dhc-type (cdr dharg) ) ) ) ))
    (if (not (or (==> :xnode:type is-a-dc)
                 (==> :xnode:type is-a-gptr)
                 (==> :xnode:type is-an-idxptr) ) )
        (dhc-error "A gptr or an idx is expected" source) )
    (when (==> :xnode:type is-an-idxptr)
      (dhc-unify-types :xnode:type type) )
    (new t-node (list xnode) type) ) )

(dhm-c to-idx1flt(source treetype retplace)
  (sprintf "(struct idx*)(%s)"
           (dhc-parse-expr-c (cadr source) 
                             (cadr :treetype:tn-list) ()) ) )

(dhm-t-declare to-idx1flt to-idx2flt)
(dhm-c-declare to-idx1flt to-idx2flt)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
#? * idx1-array
;; array of idx1 of floats.
(defclass idx1-array object
  ((-idx1- (-gptr-)) pt)
  ((-obj- (pool)) idx-pool))

#? (new idx1-array <n>)
;; Create an array of idx1 of float.  Each entry can have a different sizes. 
;; The methods of this object are:
;;.VP
;;    (==> <idx1-array> set <i> <mat>) 
;;    <i> is an int, which must be less than <n>, <mat> is an idx1 of float.
;;    This method set the <i>-th entry of the array to <mat>.
;;
;;    (==> <idx1-array> get <i>)
;;    <i> is an int, which must be less than <n>.  
;;    This method returns the <i>-th entry of the array.
;;
;;    (==> <idx1-array> set-array <ar>)
;;    Take an array of idx1 and do a set for each element (not compiled).
;;
;; Example:
;;  (setq ar {[3 4 5] [1] [1 2 3]})
;;  (setq n (idx-dim ar 0))
;;  (setq c-ar (new idx1-array n))
;;
;;  (for (i 0 (1- n))              ;; equivalent to: (==> c-ar set-array ar)
;;      (==> c-ar set i (ar i)))
;;
;; In a compiled or interpreted function
;;
;;   (de foo (c-ar ...)
;;      ((-obj- (idx1-array)) c-ar)
;;      (for (i 0 (1- n))
;;            ... (==> c-ar get i)...   ;; returns an idx1 of float
;;.SEE (new idx2-array <n>)
;;
(defmethod idx1-array idx1-array (n)
  ((-int-) n)
  (setq pt (gptr-matrix n))
  (setq idx-pool (new pool)))

#? (==> <idx1-array> set <i> <mat>)
(defmethod idx1-array set (i mat)
  ((-int-) i)
  ((-idx1- (-flt-)) mat)
  (pt i (to-gptr (in-pool idx-pool (idx-clone mat)))))

#? (==> <idx1-array> get <i>)
(defmethod idx1-array get (i)
  ((-int-) i)
  (if ~(pt i) (error "Null pointer"))
  (to-idx1flt (pt i)) )

#? (==> <idx1-array> set-array <ar>)
(defmethod idx1-array set-array (ar)
  (for (i 0 (1- (idx-dim ar 0)))
    (==> this set i (ar i))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

#? * idx2-array
;; array of idx2 of floats
(defclass idx2-array object
  ((-idx1- (-gptr-)) pt)
  ((-obj- (pool)) idx-pool))

#? (new idx2-array <n>)
;; Create an array of idx2 of float.  Each entry can have a different sizes. 
;; The methods of this object are:
;;.VP
;;    (==> <idx2-array> set <i> <mat>) 
;;    <i> is an int, which must be less	than <n>, <mat> is an idx2 of float.
;;    This method set the <i>-th entry of the array to <mat>.
;;
;;    (==> <idx2-array> get <i>)
;;    <i> is an int, which must be less	than <n>.  
;;    This method returns the <i>-th entry of the array.
;;
;;    (==> <idx2-array> set-array <ar>)
;;    Take an array of idx2 and do a set for each element.
;;
;; Example:
;;  (setq ar {[[3 4 5][2 2 2]] [[1]] [[1] [2] [3]]})
;;  (setq n (idx-dim ar 0))
;;  (setq c-ar (new idx2-array n))
;;
;;  (for (i 0 (1- n))              ;; equivalent to: (==> c-ar set-array ar)
;;      (==> c-ar set i (ar i)))
;;
;; In a compiled or interpreted function
;;
;;   (de foo (c-ar ...)
;;      ((-obj- (idx1-array)) c-ar)
;;      (for (i 0 (1- n))
;;            ... (==> c-ar get i)...   ;; returns an idx1 of float
;;
;;.SEE (new idx1-array <n>)
;;
(defmethod idx2-array idx2-array (n)
  ((-int-) n)
  (setq pt (gptr-matrix n))
  (setq idx-pool (new pool)))

#? (==> <idx2-array> set <i> <mat>)
(defmethod idx2-array set (i mat)
  ((-int-) i)
  ((-idx2- (-flt-)) mat)
  (pt i (to-gptr (in-pool idx-pool (idx-clone mat)))))

#? (==> <idx2-array> get <i>)
(defmethod idx2-array get (i)
  ((-int-) i)
  (if ~(pt i) (error "Null pointer"))
  (to-idx2flt (pt i)))

#? (==> <idx2-array> set-array <ar>)
(defmethod idx2-array set-array (ar)
  (for (i 0 (1- (idx-dim ar 0)))
    (==> this set i (ar i))))

;;-----------------------------------------------------------------------------
(dhc-make ()
          (idx1-array idx1-array set get)
          (idx2-array idx2-array set get))