Pastebin launched a little side project called VERYVIRAL.com, check it out ;-) Want more features on Pastebin? Sign Up, it's FREE!
Guest

http://programmingpraxis.com/2012/06/15/counting-ones/

By: a guest on Jun 15th, 2012  |  syntax: Lisp  |  size: 0.73 KB  |  views: 56  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
This paste has a previous version, view the difference. Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. (defun digits (n &optional (b 10))
  2.   (loop for i = n then (floor i b) with lst = ()
  3.      do (push (mod i b) lst)
  4.      while (> i (1- b))
  5.      finally (return lst)))
  6.  
  7. (defun onep (n) (equal 1 n))
  8. (defun count-ones (n)
  9.   (reduce #'+ (remove-if-not #'onep (digits n))))
  10.  
  11. (defun count-ones-find (fun)
  12.   (loop for i = 1 then (1+ i) with sum = 0
  13.      do (progn
  14.           (setf sum (+ sum (funcall fun i))))
  15.      until (and (> i 1) (equal i sum))
  16.      finally (return i)))
  17.  
  18. ; CL-USER> (time (count-ones-find #'count-ones))
  19. ; Evaluation took:
  20. ;   0.081 seconds of real time
  21. ;   0.084005 seconds of total run time (0.084005 user, 0.000000 system)
  22. ;   103.70% CPU
  23. ;   248,871,367 processor cycles
  24. ;   23,818,080 bytes consed
  25. ;  
  26. ; 199981
clone this paste RAW Paste Data