FC2ブログ
--.--
--
上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

10.06
Sat
Lispの凄さってマクロがその要因として語られること多いっぽいですけど,

たしかに凄そうな感じですね.まだまともに理解してないですけど

ということでテスト

(defmacro rexp (lst) (reverse lst))
(rexp ("hello, world" t format))


これでS式を逆さまに書いてもうまく行きます。

てかこの機能マジやばくないですか!?!?

こんなことできるとか構文解析どうなってんだ...

ということでマクロ書けばいくらでもLispを自分好みな感じにしてけますね。

ちょっと実験してみます.

loopマクロを手続き系のforと同じような感じに使えるようにするマクロ

(defmacro for (lst &rest body)
	`(loop
		for   ,(car lst)
		from  ,(cadr lst)
		by    ,(cadddr lst)
		while ,(caddr lst)
		do    ,@body
	 )
)

(for (index 0 (< index 10) 1)
	(print index)
)


ということでこないだの微分するやつ、

式を与えても評価しづらい感じだったので導関数自体を返せるようにします


(defun diff1 (expr &optional (symbolname 'x)) 
	(if (not (null expr))
		(cons (diff (car expr) symbolname) (diff1 (cdr expr) symbolname))
		nil
	)
)


(defun diff (expr &optional (symbolname 'x))
	(cond
		((null expr)
			nil
		)
		((atom expr)
			(if (equal expr symbolname)
				1
				0
			)
		)
		(t
			(let ((funcname (car expr)))
				(cond
					((or (equal funcname '+) (equal funcname '-))
						(if (= (length expr) 2)
							(if (equal funcname '-) 
								(* (diff (cadr expr) symbolname) -1) 
								(diff (cadr expr) symbolname)
							)
							(cons funcname (diff1 (cdr expr) symbolname))
						)
					)
					((equal funcname '*)
						(if (= (length expr) 3)
							(list '+ 
								(list '* (car (diff1 (cdr expr) symbolname)) (caddr expr)) 
								(list '* (cadr expr) (cadr (diff1 (cdr expr) symbolname)))
							)
							(list '+ 
								(list '* (diff (reverse(cdr(reverse expr))) symbolname) (car (last expr)))  
								(list '* (reverse(cdr(reverse expr))) (car (diff1  (last expr) symbolname)))
							)
						)
					)
					((equal funcname '/)
						(if (= (length expr) 3)
							(list '/  (list '- (list '* (diff (cadr expr) symbolname)(caddr expr)) (list '* (cadr expr) (diff (caddr expr) symbolname)))(list '* (caddr expr) (caddr expr)))
							"too many args!"
						)
					)
					(t
						(cond
							((equal funcname 'sin)
								(list '* (diff (cadr expr) symbolname) (list 'cos (cadr expr)))
							) 
							((equal funcname 'cos)
								(list '* -1 (diff (cadr expr) symbolname) (list 'sin (cadr expr)))	
							)
							((equal funcname 'tan)
								(list '* (list '/ 1 (list '* (list 'cos (cadr expr)) (list 'cos (cadr expr))))(diff (cadr expr) symbolname))
							)
							((equal funcname 'sqrt)
								(list '/ (diff (cadr expr) symbolname) (list '* 2 (list 'sqrt (cadr expr))) )
							)
							((equal funcname 'log)
								(list '/ (diff (cadr expr) symbolname) (cadr expr))
							)
						)
					)
				)
			)
		)
	)
)
(defmacro convrt (expr &optional (symbolname 'x))
	`(lambda (,(eval symbolname)) ,(eval expr))
)
(defun execf (funcname value)
	(eval(funcall funcname value))
)
(defun diffcalc (funcname &optional (symbolname 'x))
	(convrt '(diff (funcall funcname symbolname) symbolname) 'symbolname)
)


;target function
;f(x) = x*sin(x*cos(x-10)) - 20
;(defun func (num)
;	`(- (* ,num (sin (* ,num (cos (- ,num 10))))) 20)
;)

(defun func (num)
	`(* ,num ,num)
)


(defvar difunc (diffcalc 'func 'num))


(loop for x to 100 by 1
	do (format t "func(~a)  = ~a~%func'(~a) = ~a~%~%" x (execf 'func x) x (eval (funcall difunc x)))
)


ただ、いまいちいつの時点で評価されるのか理解できてないなぁー

スポンサーサイト

comment 0 trackback 0
トラックバックURL
http://telracsmoratori.blog.fc2.com/tb.php/143-01aa4993
トラックバック
コメント
管理者にだけ表示を許可する
 
上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。