求a^N幂方

aimisiyou

;;;求a^N幂方  如(pow 5 10000)将得到6990位的大数
(defun fbin (n)
(setq binlst nil)
(while (> n 0)
    (setq b (rem n 2))
    (setq binlst (cons b binlst))
    (setq n (lsh n -1))
)
binlst
)
(defun add (lst1 lst2)
  (setq k1 (length lst1))
  (setq k2 (length lst2))
  (if (> k1 k2)
          (repeat (- k1 k2)  (setq lst2 (cons 0 lst2)) )
          (repeat (- k2 k1)  (setq lst1 (cons 0 lst1)) )
   )
  (setq addlst (mapcar '(lambda (x y) (+ x y)) lst1 lst2 ))
  addlst
)
(defun lnum (lst n n0)
   (setq lst (mapcar '(lambda (x) (* x n))  lst))
   (setq zlst (reverse lst))
   (repeat n0 (setq zlst (cons 0 zlst) ) )
(reverse zlst)
)  
(defun xc(lst1 lst2)
   (setq n1 (length lst1))
   (setq n2 (length lst2))
   (setq j 1 fflst '(0))
   (if (> n1 n2)
          (while (<= j n2)
              (setq fflst (add (lnum lst1 (nth (- j 1) lst2) (- n2 j) ) fflst))
              (setq j (+ 1 j))
           )
          (while (<= j n1)
              (setq fflst (add (lnum lst2 (nth (- j 1) lst1) (- n1 j) ) fflst))
              (setq j (+ 1 j))
           )
    )
fflst
)
(defun jinw (blst)
    (while (not (apply 'and (mapcar '(lambda (x) (<= x 9)) blst )))
         (setq hlst (mapcar '(lambda (x) (rem x 10)) blst))
         (setq qlst (mapcar '(lambda (x) (/ x 10)) blst))
         (setq qlst (append qlst (list 0)))
         (setq blst (add hlst qlst))
    )
  blst
)
(defun sr (a)
   (setq n (strlen a) i 1 lst nil)
   (while (<= i n)
        (setq lst (cons (atoi (substr a i 1)) lst))
        (setq i (+ 1 i))
   )
   (reverse lst)
)
(defun dc (a b)
  (setq lst1 (sr a))
  (setq lst2 (sr b))
  (setq tenlst (jinw (xc lst1 lst2)))
  (setq str (apply 'strcat (mapcar '(lambda (x) (itoa x)) tenlst ) ) )
  (if (= (car tenlst) 0)
      (setq str (vl-string-left-trim "0" str))
  )
str
)
(defun pow (x n)
   (setq x (itoa x))
   (if (= (rem n 2) 0) (setq y "1")(setq y x))
   (setq binlst (cdr (reverse (fbin n))))
   (setq xlst (mapcar '(lambda (i) (setq x (dc x x)))  binlst))
   (setq ylst (mapcar '(lambda (i j) (if (= i 1) (setq y (dc y j)))) binlst xlst))                  
   (last ylst)   
)
(pow 5 10000)

aimisiyou

原先没有采用xlst，ylst，而是将其合并，最后直接返回y的方式，代码如下：(mapcar '(lambda (i)  (setq x (dc x x)) (if (= i 1)(setq y (dc y x))))  binlst)，但程序运行不正确，返回的y值总是为初始的x字符串，不知什么原因？

Highflybird

楼主的帖子 曲高和寡。很佩服楼主用LISP来做高精度和大数计算。毕竟用LISP来做这件事是有点难。

aimisiyou

Highflybird 发表于 2014-12-1 16:28
楼主的帖子 曲高和寡。很佩服楼主用LISP来做高精度和大数计算。毕竟用LISP来做这件事是有点难。

感兴趣而已，就当做表处理函数基础练习题了。其实理解算法就不难了。不知其它语言中大数类怎么高效运算的？或许有更效率的算法。

XDSoft

aimisiyou 发表于 2014-12-1 20:04
感兴趣而已，就当做表处理函数基础练习题了。其实理解算法就不难了。不知其它语言中大数类怎么高效运算的 ...

高飞鸟是个爱钻研的孩子{:soso_e113:}，看来楼主也是，楼主的数学功底一定很强吧，希望多在论坛讨论讨论基础理论、算法的东西。

wowan1314

路过。。支持下!

ucuc2003

看看，学习下！

aimisiyou

wowan1314 发表于 2014-12-1 20:45
路过。。支持下!

谢谢，说实话我在用lisp解决约瑟夫数圈问题时，关于表处理有个问题一直卡住，后来在你空间得到解答，再次感谢！

qqqincccken

这么高深,真心看不懂了,支持一下

Highflybird

aimisiyou 发表于 2014-12-1 20:04
感兴趣而已，就当做表处理函数基础练习题了。其实理解算法就不难了。不知其它语言中大数类怎么高效运算的 ...

如果用C++语言的话，用数组方式处理这个问题是比较高效的。
C++里面的快速FFT变换可以用于大数计算。是很方便的。
可惜,AutoLISP中没有数组，用表处理就不那么高效了。

Highflybird

[ 本帖最后由 Highflybird 于 2014-12-1 23:47 编辑 ]\n\n如以下代码就是计算 : 2^6972593 &#8722;1 这是一个质数，在2000年的时候，它是被发现的最大的一个质数，当然，现在不再是了。

int m=754974721,N,t[1<<22],a,*p,i,e=4625195,j,s,b,c,U;f(d){for(s
=1<<23;s;s/=2,d=d*1LL*d%m)if(s<N)for(p=t;p<t+N;p+=s)for(i=s,c=1;
i;i--)b=*p+p[s],p[s]=(m+*p-p[s])*1LL*c%m,*p++=b%m,c=c*1LL*d%m;
for(j=0;i<N-1;){for(s=N/2;!((j^=s)&s);s/=2);if(++i<j)a=t[i],t[i]
=t[j],t[j]=a;}}main(){*t=2;U=N=1;while(e/=2){N*=2;U=U*1LL*(m+1)/
2%m;f(362);for(p=t;p<t+N;)*p++=*p*1LL**p%m*U%m;f(415027540);for(
a=0,p=t;p<t+N;)a+=*p<<(e&1),*p++=a%10,a/=10;}while(!*--p);t[0]--
;while(p>=t)printf("%d",*p--);}

代码是如此精炼，但又如此晦涩难懂。编写它的作者在国际Fabrice Bellard凭此获得了2000年的
国际C语言混乱代码大赛(International Obfuscated C Code Contest)大奖。
这段代码就用到了快速傅里叶变换。

/db_自贡黄明儒_

Highflybird 发表于 2014-12-1 23:41
[ 本帖最后由 Highflybird 于 2014-12-1 23:47 编辑 ]\n\n如以下代码就是计算 : 2^6972593 &#8722;1 这是一 ...

当时我也关注到这条消息，当时就奇怪了，一个质素就值得报道

aimisiyou

Highflybird 发表于 2014-12-1 22:43
如果用C++语言的话，用数组方式处理这个问题是比较高效的。
C++里面的快速FFT变换可以用于大数计算。是 ...

FFT需要用到数组，只好作罢。仔细分析，发现lisp效率低是因为不同长度表做加法运算时，短表前补零操作很占时间（尤其是一个表很长，一个表很短），如果能解决这个问题，效率估计有很大提高。

newer

aimisiyou 发表于 2014-12-6 18:07
FFT需要用到数组，只好作罢。仔细分析，发现lisp效率低是因为不同长度表做加法运算时，短表前补零操作很 ...

可以把你补零的代码贴上来吗，如果用 cons 添加效率不会低的。

aimisiyou

newer 发表于 2014-12-6 18:19
可以把你补零的代码贴上来吗，如果用 cons 添加效率不会低的。

(defun add (lst1 lst2)
  (setq k1 (length lst1))
  (setq k2 (length lst2))
  (if (> k1 k2)
          (repeat (- k1 k2)  (setq lst2 (cons 0 lst2)) )
          (repeat (- k2 k1)  (setq lst1 (cons 0 lst1)) )
   )
  (setq addlst (mapcar '(lambda (x y) (+ x y)) lst1 lst2 ))
  addlst
)
(defun lnum (lst n n0)
   (setq lst (mapcar '(lambda (x) (* x n))  lst))
   (setq zlst (reverse lst))
   (repeat n0 (setq zlst (cons 0 zlst) ) )
(reverse zlst)
)