なんだこれは

はてなダイアリーから移転しました。

部分部分で小計をとりながら合計したい → できた

家計などの計算であるような、部分部分で小計をとりながら合計したい
これは一気に答がでるのだが、まあこんなかんじ。

(+     (+ 1 2 3) (+ 4 5 6) (+ 7 8 9) )
;"all"   "a"      "b"       "c"

一気に計算するのではなく、部分部分で小計が欲しいのだ。

6 ; aの和
15 ; bの和
24 ; cの和
45 ; allの和


こうするとどうだろう?

(defun pplus-name (name  &rest numbers )
  (labels ((sum (lst aux)
	     (if (null lst)
		 aux
		 (sum (cdr lst) (+ aux (car lst))))))
    (format t "~a~%" name )
    (let ((result-here (sum numbers 0) ))
      (format t "~a:~a~%" name result-here )
      result-here)))
(pplus-name "all" (pplus-name "a" 1 2 3) (pplus-name "b" 4 5 6) (pplus-name "c" 7 8 9) ) 

a
a:6
b
b:15
c
c:24
all
all:45
45

やはり、評価順がこうなってしまう。関数呼出しがなんとも邪魔。
しかも下のようにはならない。

all
a
a:6
b
b:15
c
c:24
all:45

前からデータとしてよみこめるようにしないとだめか。

;;;;
(defun flatlst-p (x)
  (or (null x)
      (and (listp x)
	   (or (null (car x))
	       (not (listp (car x))))
	   (unit-p (cdr x)))))

(defun unit-p (x)
  (or (null x)
      (and (listp x)
	   (not (stringp (car x)))
	   (flatlst-p (cdr x)))) )

(defun suite-p (x)
  (and (listp x)
       (not (null x))
       (stringp (car x))
       (each-p
	#'(lambda (x) (or (unit-p x)
			  (suite-p x)))
	(cdr x))))

(defun each-p (pred-p lst)
  (or (null lst)
      (and 
       (listp lst)
       (funcall pred-p (car lst))
       (each-p pred-p (cdr lst)))))

(defun eval-unit (x)
  (if (unit-p x) (apply #'+ x) 0))

(defun eval-suite (x)
  (labels ((suite-loop (x aux)
	     (cond
	       ((null x) aux )
	       ((unit-p (car x))
		(suite-loop
		 (cdr x)
		 (+ aux (eval-unit (car x)))))
	       ((suite-p (car x))
		(suite-loop
		 (cdr x)
		 (+ aux (eval-suite (car x))))))))
    (if (suite-p x)
	(progn
	  (format t "~a~%" (car x) )
	  (let ((result-here (suite-loop (cdr x) 0)))  
	    (format t "~a:~a~%" (car x) result-here )
	    result-here))
	0)))
(eval-suite '("all" ("a" (1 2 3)) ("b" ( 4 5 6)) ("c" (7 8 9) )  ))

all
a
a:6
b
b:15
c
c:24
all:45
;-> 45