注册 登录
明经CAD社区 返回首页

mahuan1279的个人空间 http://www.mjtd.com/?7303115 [收藏] [复制] [分享] [RSS]

日志

分解质因数

已有 1378 次阅读2015-11-1 23:02 |个人分类:LISP|系统分类:开发| 质因数

(defun fj (n)
  (defun f (n)
      (cond
         ((= n 2) (setq va (list 2)))
         ((= n 3) (setq va (list 3 2)))
         ((= n 4) (setq va (list 3 2)))
         ((= n 5) (setq va (list 5 3 2)))
         ( t      (if (= (apply '* (mapcar '(lambda (x) (rem n x)) (f (fix (sqrt n))))) 0)
                         (if (> (rem n 6) 1)
                             (setq va (f (- n -1 (rem n 6))))
                             (setq va (f (- n 1 (rem n 6))))
                         ) 
                         (if   (= (rem n 6) 5)
                              (setq va (cons n (f (- n -1 (rem n 6)))))
                              (setq va (cons n (f (- n 1 (rem n 6)))))
                          )
                  )
          )
       )
    ) 
   (defun ff (x) 
       (if (= x 1) 
           (setq nn 0)
           (setq nn (fix (/ (log (/ (log x) (log 2)))  (log 2)  ))) 
        )
    )
   (setq k (ff n))
   (while (and (> n 1) 
               (/= (apply '* 
                       (setq flst 
                             (mapcar '(lambda (x) (if (= (rem n x) 0) 0 1)) 
                                      (setq qlst (reverse (f (fix (expt n (expt 0.5 k))))))
                              )
                         )
                     )
                0)
               (> (setq k (- k 1)) 0)
             )
    )
   (if (= n 1)
       (setq lst nil)
       (if (= k 0)
              (setq lst (list n))
              (progn
                 (setq a (cadr 
                               (car 
                                   (vl-member-if '(lambda (x) (= (car x) 0)) 
                                             (mapcar '(lambda (x y) (cons x (list y)))
                                                      flst  
                                                      qlst
                                              ) 
                                    )
                                 )
                           )
                   )
                  (setq lst (cons a (fj (/ n a))))  
              )
        )
   )
lst
)

路过

雷人

握手

鲜花

鸡蛋

评论 (0 个评论)

facelist doodle 涂鸦板

您需要登录后才可以评论 登录 | 注册

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 15:16 , Processed in 0.127426 second(s), 16 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

返回顶部