interesting gear program

interesting gear program

[Emanuel Berg]

Hey guys, does this look right to you?

;; (print-gears '(34 50) '(12 13 15 17 19 21 23 25) 622)
;;
;;                          =>
;;
;; 622 wheel
;;
;; chainring   sprocket   gear
;;
;;    34          25      2657.5360544880004
;;    34          23      2888.626146182609
;;    34          21      3163.7333982000005
;;    34          19      3496.7579664315795
;;    50          25      3908.1412566000004
;;    34          17      3908.1412566000004
;;    50          23      4247.97962673913
;;    34          15      4429.226757480001
;;    50          21      4652.549115000001
;;    34          13      5110.64625863077
;;    50          19      5142.291127105264
;;    34          12      5536.5334468500005
;;    50          17      5747.266553823531
;;    50          15      6513.568761
;;    50          13      7515.656262692309
;;    50          12      8141.960951250001

(require 'cl-lib)

(defun compute-gear (chainring sprocket wheel)
  (let*((pi     3.14159265)
        (radius (/ wheel 2.0))
        (circum (* 2 radius pi))
        (gear   (* (/ chainring sprocket 1.0) circum)))
    (list chainring sprocket gear)))

(defun gear (chainrings sprockets wheel)
  (let*((gears
         (cl-loop for c in chainrings
                  append (cl-loop for s in sprockets
                                  collect (compute-gear c s wheel) )
                  )))
        (cl-sort gears #'<= :key #'cl-caddr)))

(defun print-gears (chainrings sprockets wheel)
  (let ((out-buffer (get-buffer-create "*Gears*")))
    (with-current-buffer out-buffer
      (erase-buffer)
      (insert (format "%s wheel\n\n" wheel))
      (insert "chainring   sprocket   gear\n\n")
      (let ((gears (gear chainrings sprockets wheel)))
        (cl-loop for g in gears
                 do (let ((c (   car   g))
                          (s (   cadr  g))
                          (d (cl-caddr g)))
                      (insert (format "   %s          %s      %s\n" c s d)) ))))
    (pop-to-buffer out-buffer) ))

-- 
underground experts united
http://user.it.uu.se/~embe8573