N阶单位矩阵 修改

muwind

；N阶矩阵

1. (defun tt (n / x  m lst1 lst2 lst3)
   
2.   (if (> n 1)
   
3.     (progn
   
4.       (setq x 0
   
5.           lst1 '()
   
6.       lst3 '()
   
7.       )   
   
8.       (while (< x n)
   
9.        (setq lst1 (cons (strcat "x" (vl-princ-to-string  x)) lst1)
   
10.            x (1+ x))
    
11.       )
    
12.     (while (> x 0)
    
13.        (setq lst2 '()
    
14.            x (- x 1))  
    
15.      (foreach m lst1
    
16.          (if (=  m  (strcat "x" (vl-princ-to-string  x)))
    
17.           (setq lst2 (cons 1.0 lst2))
    
18.           (setq lst2 (cons 0.0 lst2))
    
19.        )
    
20.         )
    
21.      (setq lst3 ( cons lst2 lst3))   
    
22.       )
    
23.     )
    
24.   )
    
25.   lst3
    
26. )

(defun tt (n / x  m lst1 lst2 lst3)<br />   (if (> n 1)<br />     (progn <br />       (setq x 0<br />           lst1 '()<br />       lst3 '()<br />       )    <br />       (while (< x n)<br />        (setq lst1 (cons (strcat "x" (vl-princ-to-string  x)) lst1)<br />            x (1+ x))<br />       )<br />     (while (> x 0)<br />        (setq lst2 '()<br />            x (- x 1))  <br />      (foreach m lst1<br />          (if (=  m  (strcat "x" (vl-princ-to-string  x)))<br />           (setq lst2 (cons 1.0 lst2))<br />           (setq lst2 (cons 0.0 lst2))<br />        )<br />         )<br />      (setq lst3 ( cons lst2 lst3))   <br />       )<br />     )<br />   )<br />   lst3<br /> )

以上是以前仿照（XD::Mat:Identity）写的一个任一N阶单位矩阵的  ，

(defun tt (n / x  m lst1 lst2 lst3)
  (if (> n 1)
    (progn
      (setq x 0
                lst1 '()
                        lst3 '()
                        )         
      (while (< x n)
             (setq lst1 (cons (strcat "x" (vl-princ-to-string  x)) lst1)
                       x (1+ x))
      )
          (while (> x 0)
             (setq lst2 '()
                       x (- x 1))       
                 (mapcar  
                   '(lambda(m)
                     (if (= m  (strcat "x" (vl-princ-to-string  x)))
                            (setq lst2 (cons 1.0 lst2))
                            (setq lst2 (cons 0.0 lst2))
                         )
                    ) lst1
              )
                 (setq lst3 ( cons lst2 lst3))         
      )
    )
  )
  lst3
)

kkq0305

我也写了一个
(defun mkeye (n / f1 f2)
  (setq        f1 (lambda (x)
             (if (> x 0)
               (cons 0 (f1 (1- x)))
             )
           )
  )
  (setq        f2
         (lambda (lst x)
           (if (> x 0)
             (cons
               lst               
               (f2 (cons (last lst) (reverse (cdr (reverse lst))))(1- x))
             )
           )
         )
  )
  (f2 (cons 1 (f1 (1- n))) n)
)

muwind

kkq0305 发表于 2021-9-22 01:46
我也写了一个
(defun mkeye (n / f1 f2)
  (setq        f1 (lambda (x)

你这个比较简洁， 以我对lambda的应用能力以及递归的理解， 基本是蒙圈的 ，我的方法比较笨
我把你的拆成三个 函数 大致理解到怎么回事了  
(defun  f1 (x / )
(if (> x 0)   (cons 0.0 (f1 (1- x))))
)

(defun  f2 (lst x)  
(if (> x 0)
     (cons  lst (f2 (cons (last lst) (reverse (cdr (reverse lst))))(1- x)) )
)
)

(defun  f3 (n)  
    (f2 (cons 1.0 (f1 (1- n))) n)
)

kkq0305

;; (abc 5) → ((1 0 0 0 0) (0 1 0 0 0) (0 0 1 0 0) (0 0 0 1 0) (0 0 0 0 1))
(defun abc (n / a lst)
  (setq a '(1))
  (repeat (1- n) (setq a (cons 0 a)))
  (setq lst (list a))
  (repeat (1- n)
    (setq lst (cons (setq a (append (cdr a) '(0))) lst))
  )
  lst
)
院长写的 更简单

xj6019

不懂啥情况用的到

tigcat

xj6019 发表于 2021-9-23 10:17
不懂啥情况用的到

坐标变换时用