- 01
- 02
- 03
- 04
- 05
- 06
- 07
- 08
- 09
- 10
- 11
- 12
- 13
- 14
- 15
- 16
- 17
- 18
- 19
- 20
- 21
- 22
- 23
- 24
- 25
- 26
- 27
- 28
- 29
- 30
- 31
- 32
- 33
- 34
- 35
- 36
- 37
- 38
- 39
- 40
- 41
- 42
- 43
- 44
- 45
- 46
- 47
- 48
- 49
- 50
- 51
- 52
- 53
- 54
- 55
- 56
- 57
- 58
- 59
- 60
- 61
- 62
- 63
- 64
- 65
- 66
- 67
- 68
- 69
- 70
- 71
- 72
- 73
- 74
- 75
- 76
- 77
- 78
- 79
(defparameter n 2)
(setf middle (make-array 2 :initial-element 0))
(defparameter v 7)
(setf tr (make-array `(,(+ 1 n) ,n) :initial-element 4))
(setf ftr (make-array 3 :initial-element 1))
(defun pow (x n)
(cond((= n 0) 1)((= n 1) x)(T (* x (pow x (- n 1))))))
(defun f1 (x y)
(+ (* (pow v 2) (pow x 2))
(* (/ v (+ v 1)) x)
(* 15 (+ v 1) (pow y 2))
(* -1 2 v y) (* 4 v)))
(defun sigma1 (a)
(* a (/ (+ (sqrt (+ n 1)) (- n 1))
(* n (sqrt 2))) ))
(defun sigma2 (a)
(* a (/ (+ (sqrt (+ n 1)) -1)
(* n (sqrt 2))) ))
(defun setp (a)
(loop for i from 1 to n do
(loop for j from 0 to (- n 1) do
(cond
((= (- i 1) j) (setf (aref tr i j) (+ (aref tr 0 0) (sigma2 a))))
(T (setf (aref tr i j) (+ (aref tr 0 1) (sigma1 a))))))))
(defun evalfun ()
(loop for i from 0 to n do
(setf (aref ftr i) (f1 (aref tr i '0) (aref tr i '1)))
(format t "The functions in dot ~$:~$~$" `(,(aref tr i '0) ,(aref tr i '1)) (aref ftr i) #\newline))
(setf ftr (sort ftr #'<)))
(defun midp()
(loop for i from 0 to n do
(cond
((= (aref ftr n) (f1 (aref tr i '0) (aref tr i '1)))
(setq tp i))))
(setf middle (make-array n :initial-element 0))
(loop for i from 0 to n do
(cond
((/= i tp)
(setf (aref middle 0) (+ (aref middle 0) (aref tr i 0)))
(setf (aref middle 1) (+ (aref middle 1) (aref tr i 1))))))
(setf (aref middle 1) (/ (aref middle 1) 2))
(setf (aref middle 0) (/ (aref middle 0) 2))
(format t "The weight center in ~$,~$" (aref middle 0) (aref middle 0))
(princ #\newline))
(defun newp()
(setf (aref tr tp 0) (- (aref middle 0) (aref tr tp 0)))
(setf (aref tr tp 1) (- (aref middle 1) (aref tr tp 1))))
(defun prpolinom()
(format t "Polinom has this dots:~$" #\newline)
(loop for i to n do
(loop for j to (- n 1) do
(format t "|~$|" (aref tr i j)))
(princ #\newline)))
(setq c 1)
(defun mloop(a)
(setp a)
(defun subloop()
(setq c (+ c 1))
(setf tmiddle (make-array n :initial-element 0))
(loop for i to (- n 1) do
(setf (aref tmiddle i) (aref middle i)))
(evalfun)
(midp)
(newp)
(prpolinom)
(cond
((and (= (aref tmiddle 0) (aref middle 0)) (= (aref tmiddle 1) (aref middle 1)))(mloop (/ a 2)))
((> a 0.01) (subloop) (format t "Iteration ~$~$" c #\newline))))
(subloop))
(mloop 2)
Follow us!
Что вам не понравилось?
Ох какая страшная беда...
>принципы языка соблюдены чуть менее чем не соблюдены вообше
В CL их в принципе нет. Любой код на CL не поддерживаемый с таким гибким синтаксисом языка и его макросистемой.
>уважаемый дедушка
я записал тебя в свой блэклист.
ну и мудак ^^
fix
не благодари
EDIT: Кстати, только что заметил, тоже шедевр :)
ЗЫ а я и не заметил=) реально шедевр=)
Ну как бы человек впервые в жизни видимо писал, как бы со второго раза уже такие дурацкие ошибки никто бы не делал :)
На второй день фортраноид пишет вот такое. Это не LISP - это подстрочник с хренового C на LISP.