Advertisement
Guest User

Untitled

a guest
Jun 25th, 2017
55
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 2.12 KB | None | 0 0
  1. #-sbcl (error "This only works using SBCL")
  2. (declaim (optimize (speed 3)
  3. (compilation-speed 0)
  4. (debug 0)
  5. (safety 0)))
  6.  
  7. (defun pidigits (x-digits)
  8. (macrolet ((gen-arccot (sign opposite)
  9. `(,(intern (format nil "~a~a" 'arccot sign)) (x-rest n x-elevate product)
  10. (declare (type integer x-rest n))
  11. (declare (type bignum x-elevate product))
  12. (let ((term (floor x-elevate n)))
  13. (if (zerop term)
  14. product
  15. (,(intern (format nil "~a~a" 'arccot opposite)) x-rest (+ n 2)
  16. (the bignum (floor x-elevate x-rest))
  17. (the bignum (,(intern (format nil "~a" sign)) product term )))))))
  18. (labels ((gen-arccot + -)
  19. (gen-arccot - +))
  20. (let* ((limit (expt 10 (+ 10 x-digits)))
  21. (first-thread (sb-thread:make-thread
  22. (lambda () (* 44 (the bignum (arccot+ 3249 1 (the bignum (floor limit 57)) 1))))))
  23. (second-thread (sb-thread:make-thread
  24. (lambda () (* 7 (the bignum (arccot+ 57121 1 (the bignum (floor limit 239)) 1))))))
  25. (third-thread (sb-thread:make-thread
  26. (lambda () (* -12 (the bignum (arccot+ 465124 1 (the bignum (floor limit 682)) 1))))))
  27. (fourth-thread (sb-thread:make-thread
  28. (lambda () (* 24 (the bignum (arccot+ 167521249 1 (the bignum (floor limit 12943)) 1)))))))
  29. (declare (type bignum limit))
  30. (sb-thread:thread-yield)
  31. (format nil "3.~a" (the bignum (rem
  32. (the bignum (floor
  33. (the bignum (* 4
  34. (the bignum (+
  35. (the bignum (sb-thread:join-thread fourth-thread))
  36. (the bignum (sb-thread:join-thread third-thread))
  37. (the bignum (sb-thread:join-thread second-thread))
  38. (the bignum (sb-thread:join-thread first-thread))))))
  39. 10000000000))
  40. (/ limit 10000000000))))))))
  41.  
  42.  
  43. (if (not (cadr *posix-argv*))
  44. (format t "Error: you should pass an argument~%")
  45. (let ((n (parse-integer (cadr *posix-argv*))))
  46. (if (not (typep n 'integer))
  47. (print "The argument should be a integer~%")
  48. (print (pidigits n)))))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement