约瑟夫环问题

aimisiyou

标号为1、2、3、……n的n个人围成一个圆圈，现在从标号为1的人开始按1、2、3……m的循环报数，报1的人出圈，求依次出圈人的标号？
;|构造由大到小的列表|;
(defun f (n)  
   (if (= n 1)
      '(1)
     (cons n (f (- n 1)))
  )
)

;|将表中为n的值替换为值0(表中无重复数值)|;
(defun fh (lst n)
  (setq lfst (reverse (cdr (member n (reverse lst)))))
  (setq lhst (cons 0 (cdr (member n lst))))
  (setq lst (append lfst lhst))
)

(setq n (getint "请输入总人数n="))
(setq m (getint "按照1、2、3、、m报数，报1的人出圈。请输入循环数m="))
(setq lst (reverse (f n)))
(setq k 0)
(while lst
  (setq llst lst)
  (foreach i lst
      (if (= 0 (rem (+ (vl-position i lst) k) m) )
        (progn
           (princ i)
           (princ "  ")
           (setq llst (fh llst i))
         )
       )
   )
  (setq k (+ k (rem (length llst) m)))
  (setq lst (vl-remove 0 llst))
)

daierfull

这个挺有意思，貌似以后会很有用

aimisiyou

(defun f (n m)
  (setq i 1 j 0 lst nil llst nil flag t)
  (while (<= i n)
      (setq lst (cons i lst))
      (setq i (+ 1 i))
   )
  (setq lst (reverse lst))
  (while flag
     (setq count (length lst))
     (if (< j count)
         (progn
            (setq out (nth j lst))
            (setq llst (cons out llst))
            (setq lst (vl-remove out lst))
            (setq j (+ j m -1))
          )
          (progn
                (setq j (rem j count))  
                (setq out (nth j lst))
                (setq llst (cons out llst))
                (setq lst (vl-remove out lst))
                (setq j (+ j m -1))
            )
        )
      (if (= count 1) (setq flag nil))
    )
  (reverse llst)
)
(f 10000 3)

aimisiyou

若只求最后一位出圈人标号，可根据递推公式$$a_2=2$$ $$a_n=2+(a_{n-1}+m-2)mod(n-1)$$来计算$$a_n$$ 但当n很大时，如取1亿，运算量仍不小，考虑简化运算。

aimisiyou

;;;本例m=3（不同的m对应的fun会不同）
;;;若按递归公式需循环运算1亿次，本例循环不超过50次，大大提高运算效率
(defun f (n)
  (defun fun (i) (+ 1 (fix (* 1.622270502884 (expt 1.5 i)))))
  (setq i 1)
  (while (< (/ (setq b (fun i)) 2) n)
          (setq i (+ 1 i))
   )
  (- (* 3 n) b)
)
(f 100000000)

aimisiyou

(defun f (n m)
  (defun f1 (k m) (- (* k m) 2))
  (defun f2 (k x) (- (f1 k m) (rem (- (f1 k m) x) (- k 1))))
  (setq k 2 b (f1 k m))
  (setq a (f2 (+ 1 k) b))
  (while (< b (* (- m 1) n))
      (while (< (fix (/ (* m b) (- m 1))) a)
                (setq b a)
                (setq a (f2 (+ 1 k) b))
                (setq k (+ 1 k))
        )
       (setq a (+ a (fix (/ a (- m 1)))))
       (setq b a)
  )
  (- (* m n) b)
)

aimisiyou

(defun ff (n m)
(setq i 1 k 0 lst nil)
(while (<= i n)
  (setq lst (cons i lst))
  (setq i (+ i 1))
)
(setq k 0 lst (reverse lst))
(while (> (setq nn (length lst)) 1)
   (if (>= k nn) (setq k (rem k nn)))
   (setq lst (vl-remove (nth k lst) lst))
   (setq k (+ k m -1))
)
(car lst)
)

xvjiex

感谢楼主分享约瑟夫环问题

aimisiyou

;;;模拟出圈的list操作太费时了，直接找出递推关系，数值计算优化
;;;n>>m
(defun ff (n m)
  (setq i 2 b (- (* i m) 2) flag t)
  (while flag
    (setq bb b i (+ i 1))
        (setq b (- (- (* i m) 2) (rem (- (- (* i m) 2) b) (- i 1))))
        (if (= b (+ bb (/ bb (- m 1))))  (setq flag nil))
  )
  (while (null flag)
    (setq bbb (+ b (/ b (- m 1))) b bbb)
        (if (>= b (* (- m 1) n))(setq flag t))
   )
  (- (* m n) b)
)

_$ (ff 1000000000 6)
902845264
_$