[foo-cvs] foo/elkfoo/scm/control/node node-function-database.foo,1.1,1.2 node-functionalities.foo,1.1,1.2

[Martin R. <ru...@us...>]

Update of /cvsroot/foo/foo/elkfoo/scm/control/node
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv8357/node

Modified Files:
	node-function-database.foo node-functionalities.foo 
Log Message:
raw checkin of new control

Index: node-functionalities.foo
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/scm/control/node/node-functionalities.foo,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** node-functionalities.foo	7 Aug 2004 22:53:01 -0000	1.1
--- node-functionalities.foo	27 Feb 2005 20:06:34 -0000	1.2
***************
*** 63,67 ****
  	    (if (= Numb 1) (car aux) aux))))
  
!        `(define-method Node (,name . garbage)
  	   (let* ((aux) (Numb (send self 'get-NumResults)) (Args)
  		  (End (+ Index Numb)))
--- 63,67 ----
  	    (if (= Numb 1) (car aux) aux))))
  
!        `(define-method Node (,name . unusedargs)
  	   (let* ((aux) (Numb (send self 'get-NumResults)) (Args)
  		  (End (+ Index Numb)))

Index: node-function-database.foo
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/scm/control/node/node-function-database.foo,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** node-function-database.foo	7 Aug 2004 22:53:01 -0000	1.1
--- node-function-database.foo	27 Feb 2005 20:06:33 -0000	1.2
***************
*** 4,12 ****
  ;;
  ;
  (define (rand01) (/ (random) 2147483647))
  
  (define (randint a z) (+ a (* (- z a) (rand01))))
  
! (define (alea a z) (inexact->exact (round (randint a z))))
  
  (define (mk-ordrlst lnz . start)
--- 4,26 ----
  ;;
  ;
+ (define (rround n)
+   (if (= n 0.) 0.
+       (let ((t (truncate n))
+ 	    (inc (/ n (abs n))))
+ 	(if (>= (abs (- n t)) 0.5) (+ t inc) t))))
+ ;
+ (define (rrund n) (inexact->exact (rround n)))
+ ;
  (define (rand01) (/ (random) 2147483647))
  
  (define (randint a z) (+ a (* (- z a) (rand01))))
  
! (define (alea a z) (inexact->exact (rround (randint a z))))
! 
! (define between randint)
! 
! (define (betweenlst lst) (apply between lst))
! 
! (define (alealst lst) (apply alea lst))
  
  (define (mk-ordrlst lnz . start)
***************
*** 106,111 ****
  	  (aux1 (/ lnz totn)))
       (if (> indx totn) (set! indx totn))
!      (if (>= lnz totn) (list-ref Lst indx)
! 		  (list-ref Lst (inexact->exact (truncate (* aux1 indx)))))))
  
  
--- 120,126 ----
  	  (aux1 (/ lnz totn)))
       (if (> indx totn) (set! indx totn))
!      (if (>= lnz totn) 
! 	(list-ref Lst (- indx 1))
! 	(list-ref Lst (- (inexact->exact (truncate (* aux1 indx))) 1)))))
  
  
***************
*** 114,118 ****
      (if (null? Dum)
  	(set! Numaux1 (map (lambda (x) (+ x mini))
! 	    				(mk-ordrlst (- maxi mini))))
  	(set! val     (car Dum))
  	(set! num     (cadr Dum))
--- 129,133 ----
      (if (null? Dum)
  	(set! Numaux1 (map (lambda (x) (+ x mini))
! 			   (mk-ordrlst (- maxi mini))))
  	(set! val     (car Dum))
  	(set! num     (cadr Dum))
***************
*** 120,123 ****
--- 135,140 ----
  	(set! Numaux2 (cadddr Dum))
  	(set! Lstaux  (car (cddddr Dum))))
+ ;    (prn "Dum "Dum)
+ ;    (prn val num Numaux1 Numaux2 Lstaux)
      (if (not (null? num))
  	(set! num (if (= num 2) '() (- num 1)))
***************
*** 184,187 ****
--- 201,272 ----
    (reverse rsl)))
  
+ 
+ (define (betweenlstlinint xi xa lsta xz lstz)
+    (betweenlst (map (lambda (ya yz) (linint xi xa ya xz yz)) lsta lstz)))
+ 
+ (define (betweenlstexpint xi xa lsta xz lstz pnd)
+    (betweenlst (map (lambda (ya yz) (expint xi xa ya xz yz pnd)) lsta lstz)))
+ 
+ (define (betweenlststadint xi xa lsta xz lstz)
+     (betweenlst (map (lambda (ya yz) (stadint xi xa ya xz yz)) lsta lstz)))
+ 
+ ;
+ (define (tendencylinseg xi xa Lsta xz Lstz)
+   (apply mk-ordrlst (map (lambda (x) (rrund x))
+ 			 (lstlinint xi xa Lsta xz Lstz))))
+ 
+ (define (tendencyexpseg xi xa Lsta xz Lstz pnd)
+   (apply mk-ordrlst (map (lambda (x) (rrund x))
+ 			 (lstexpint xi xa Lsta xz Lstz pnd))))
+ 
+ (define (tendencylinint xi xa Lsta xz Lstz)
+   (apply randint (lstlinint xi xa Lsta xz Lstz)))
+ 
+ (define (tendencyexpint xi xa Lsta xz Lstz pnd)
+   (apply randint (lstexpint xi xa Lsta xz Lstz pnd)))
+ 
+ (define (tendencylinsel xi xa Lsta xz Lstz Lst)
+   (list-ref Lst (rround (tendencylinint xi xa Lsta xz Lstz))))
+ 
+ (define (tendencysxpsel xi xa Lsta xz Lstz pnd Lst)
+   (list-ref Lst (rround (tendencyexpint xi xa Lsta xz Lstz pnd))))
+ ;
+ (define (tendencylinseg xi xa Lsta xz Lstz)
+   (apply mk-ordrlst (map (lambda (x) (rrund x))
+ 			 (lstlinint xi xa Lsta xz Lstz))))
+ 
+ (define (tendencyexpseg xi xa Lsta xz Lstz pnd)
+   (apply mk-ordrlst (map (lambda (x) (rrund x))
+ 			 (lstexpint xi xa Lsta xz Lstz pnd))))
+ 
+ (define (tendencyaleasel xi xa Lsta xz Lstz Lst)
+   (list-ref Lst (aleasel (tendencylinseg xi xa Lsta xz Lstz))))
+ 
+ (define (sersel Lst Dum)
+   (let ((lnz (1- (length Lst))) (elm) (aux))
+ ;    (prn "A" Dum lnz Lst)
+     (if (null? Dum)
+ 	(set! Dum (Lstshuffle (mk-ordrlst lnz)))
+ 	(for-each (lambda (x) (if (<= x lnz) (set! aux (cons x aux)))) Dum)
+ 	(set! Dum (if (null? aux) (Lstshuffle (mk-ordrlst lnz)) aux))
+         (if (= (length Dum) 1)
+ 	   (begin (set! elm (car Dum))
+ 	   	  (set! Dum (Lstshuffle (mk-ordrlst lnz)))
+ 	   	  (while (and (> lnz 1) (= elm (car Dum)))
+ 		  	(set! Dum (Lstshuffle (mk-ordrlst lnz))))
+ 		  (set! Dum (cons elm Dum)))))
+     (set! elm (car Dum))
+ ;    (prn "B" Dum elm (nth Lst elm))
+     (list (nth Lst elm) (cdr Dum))))
+ ;
+ (define (tendencylinsersel xi xa Lsta xz Lstz Lst Dum)
+   (let ((aux (sersel (tendencylinseg xi xa Lsta xz Lstz) Dum)))
+     (list (list-ref Lst (- (car aux) 1)) (cadr aux))))
+ ;
+ (define (tendencyexpsersel xi xa Lsta xz Lstz Lst pnd Dum)
+   (let ((aux (sersel (tendencyexpseg xi xa Lsta xz Lstz pnd) Dum)))
+     (list (list-ref Lst (- (car aux) 1)) (cadr aux))))
+ ;
+ (define tendencymask tendencylinsersel)
  ;
  ;;
***************
*** 191,195 ****
--- 276,298 ----
  
  (add-Node-Function ALEA	(aleasel Data))
+ 
+ (add-Node-Function ALEALSTSTADINT
+     (lambda (x)
+       (aleasel 
+ 	 (lststadint x (car Data) (cadr Data) (caddr Data) (cadddr Data))))
+       Xi)
+ 
  (add-Node-Function ALCIRC (alcircsel Data Index))
+ 
+ (add-Node-Function BETWEENLSTEXPINT
+     (lambda (x)
+ 	(betweenlstexpint x (car Data) (cadr Data) (caddr Data) (cadddr Data)
+ 	    					(car (cddddr Data))))
+     Xi)
+ (add-Node-Function BETWEENLSTLININT
+     (lambda (x)
+ 	(betweenlstlinint x (car Data) (cadr Data) (caddr Data) (cadddr Data)))
+     Xi)
+ 
  (add-Node-Function CIRC	(circsel Data Index))
  (add-Node-Function EXPINT
***************
*** 217,220 ****
--- 320,324 ----
  	(linint x (car Data) (cadr Data) (caddr Data) (cadddr Data)))
      Xi)
+ 
  (add-Node-Function LSTEXPINT
      (lambda (x)
***************
*** 244,245 ****
--- 348,395 ----
  	(stepfun x (car Data) (cadr Data) (caddr Data) (cadddr Data)))
      Xi)
+ ;
+ ;;
+ ;
+ (add-Node-Function TENDENCY
+     (lambda (x)
+       (let ((aux1 (apply tendencylinsersel (append (list x) 
+ 						   Data 
+ 						   (list Partial-Result)))))
+ 	(set! Partial-Result (cadr aux1)) (car aux1)))
+       Xi)
+ 
+ (add-Node-Function TENDENCYX
+     (lambda (x)
+       (let ((aux1 (apply tendencyexpsersel (append (list x) 
+ 						   Data 
+ 						   (list Partial-Result)))))
+ 	(set! Partial-Result (cadr aux1)) (car aux1)))
+       Xi)
+ ;
+ (add-Node-Function ENV_TENDENCY
+     (lambda (x)
+       (let* ((xa (car Data)) (Lsta (cadr Data)) 
+ 	     (xz (caddr Data)) (Lstz (cadddr Data))
+ 	     (Lst) (aux1))
+ 	(set! Lsta (car Lsta))
+ 	(set! Lst (cadr Lstz))
+ 	(set! Lstz (car Lstz))
+ 	(set! aux1 (tendencylinsersel x xa Lsta xz Lstz Lst Partial-Result))
+ 	(set! Partial-Result (cadr aux1)) (car aux1)))
+     Xi)
+ 
+ (add-Node-Function ENV_TENDENCYX
+     (lambda (x)
+       (let* ((xa (car Data))   (Lsta (cadr Data)) 
+ 	     (xz (caddr Data)) (Lstz (cadddr Data)) 
+ 	     (Lst) (pnd) (aux1))
+        (set! Lsta (car Lsta))
+        (set! pnd (caddr Lstz))
+        (set! Lst (cadr Lstz))
+        (set! Lstz (car Lstz))
+        (set! aux1 (tendencyexpsersel x xa Lsta xz Lstz Lst pnd Partial-Result))
+        (set! Partial-Result (cadr aux1)) (car aux1)))
+     Xi)
+ ;
+ 
+