port functional version of partitions-M algorithm

[sritchie]

port functional version of partitions-M algorithm

[sritchie]

Beginning of my attempt at a functional version:

(declare stack-partitions-M)

(defn multiset-partitions-M
  [multiset r s]
  (let [m     (count multiset)
        init  (reduce (fn [acc i]
                        (let [v (multiset i)]
                          (assoc acc i [v v])))
                      (sorted-map)
                      (range m))
        stack  [init]]
    (stack-partitions-M stack r s)))

(defn stack-partitions-M [stack r s]
  (letfn [(next-block [block]
            (second
             (reduce (fn [[v-changed? acc] [ci [ui vi]]]
                       (let [uj (- ui vi)]
                         (if (zero? uj)
                           [true acc]
                           (let [changed? (or v-changed? (< uj vi))
                                 vj   (if changed?
                                        uj
                                        (min uj vi))
                                 elem [ci [uj vj]]]
                             [changed? (conj acc elem)]))))
                     [false []]
                     block)))

          (m5 [stack]
            (let [block (peek stack)
                  head  (pop stack)
                  ;; Also assumes no fully zero entries.
                  j (loop [j (into [] (keys block))]
                      (if (zero? (block j))
                        (recur (pop j))
                        j))]
              (cond
                (and (= j a)
                     (or (= (v j) 1)
                         (and r
                              (let [new-val (dec (v j))
                                    uj      (block j)]
                                (> (+ (inc l)
                                      (dec (quot uj new-val)))
                                   r)))))
                (if (= 1 (count block))
                  []
                  (recur head))

                :else
                (let [v      (update v j dec)
                      prefix (subvec v 0 (inc j))
                      v      (into prefix (subvec u (inc j)))
                      amount-to-dec (if s
                                      (let [diff-uv (apply + (for [i (range a (inc j))]
                                                               (- (u i) (v i))))
                                            min-partitions-left (- s (inc l))]
                                        (max 0 (- min-partitions-left diff-uv)))
                                      0)
                      v (if (zero? amount-to-dec)
                          v
                          (loop [k-1    (dec b)
                                 v      v
                                 amount amount-to-dec]
                            (let [vk (v k-1)]
                              (if (> amount vk)
                                (recur (dec k-1)
                                       (assoc v k-1 0)
                                       (- amount vk))
                                (assoc v k-1 (- vk amount))))))]
                  (if (zero? (v a))
                    (recur (pop stack))
                    (conj head ,,,))))))]

    (let [n-blocks  (count stack)
          candidate (next-block (peek stack))]
      (cond (seq candidate)
            (if (and r (= n-blocks r))
              (recur (m5 stack) r s)
              (recur (conj stack candidate) r s))

            ;; Did we NOT march forward, but we don't have enough blocks yet?
            (and s (< n-blocks s))
            (recur (m5 stack) r s)

            :else
            (lazy-seq
             (let [part (for [block stack]
                          ;; TODO recover the zero filter?
                          (zipmap (map first block)
                                  (map (comp second second) stack)))]
               (cons part (stack-partitions-M (m5 stack) r s))))))))


(defn items->multiset
  "returns [ditems, multiset]"
  [items]
  (let [freqs  (frequencies items)
        ditems (into [] (distinct) items)]
    [ditems (into {} (map-indexed
                      (fn [i item]
                        [i (freqs item)]))
                  ditems)]))

(defn multiset->items
  "Returns the items."
  [ditems mset]
  (into [] (mapcat
            (fn [[i n]]
              (repeat n (ditems i))))
        mset))

(defn- partitions-M
  [items & {from :min to :max}]
  (let [N (count items)]
    (if (= N 0)
      (if (<= (or from 0) 0 (or to 0))
        '(())
        ())
      ;; `from` and `to` only make sense inside the bounds.
      (let [from (if (and from (<= from 1)) nil from)
            to   (if (and to (>= to N)) nil to)]
        (cond
          ;; Check if the order is reversed?
          (not (<= 1 (or from 1) (or to N) N)) ()
          (= N 1) (list (list [(first items)]))
          :else
          (let [[ditems start-multiset] (items->multiset items)]
            (for [part (multiset-partitions-M start-multiset to from)]
              (for [multiset part]
                (multiset->items ditems multiset)))))))))

[sritchie]

This comes from my attempts to find a minimal bugfix for https://clojure.atlassian.net/browse/MCOMB-11...

[sritchie]

sympy has a well documented version of this algorithm.

• notes on the modification of m5: https://github.com/sympy/sympy/blob/e56ec3aa582b05d306b973ba7290e3e6260df471/sympy/utilities/enumerative.py#L531-L564 This is an implementation of the upper bound, described in the exercise. Did they do a better job?

I think they do. Here are two more tests we can implement: https://github.com/sympy/sympy/blob/e56ec3aa582b05d306b973ba7290e3e6260df471/sympy/utilities/enumerative.py#L576-L594

[sritchie]

Here is some code to count the number of partitions, vs just generating and counting: https://github.com/sympy/sympy/blob/e56ec3aa582b05d306b973ba7290e3e6260df471/sympy/utilities/enumerative.py#L1021-L1090

[sritchie]

Another take on the lower bound code: https://github.com/sympy/sympy/blob/e56ec3aa582b05d306b973ba7290e3e6260df471/sympy/utilities/enumerative.py#L597-L662