Уменьшить значения списка по соотношению в Clojure

Question

У меня есть небольшая программная проблема, которую я пытаюсь решить в Clojure.

Скажем, у меня есть список с целочисленными значениями (они также включают нули). Эти значения имеют сумму, которую я хочу уменьшить на определенное значение. Чтобы получить эту более низкую сумму, я хочу уменьшить значения в списке на соотношение.

Скажите, у меня есть следующий список: [0, 10, 30, 40, 20, 0]. Сумма равна 100, и я хочу уменьшить сумму до 90. Я хочу уменьшить значения по соотношению, поэтому новый список будет [0, 9, 27, 36, 18, 0].

Однако, это становится проблематичным, когда числа превращаются в дроби. Когда вы округляете числа (с округлением, полом или потолком), вы можете получить сумму, равную 1 или 2. Кажется, я не могу найти элегантного решения. Все, что я получаю, состоит в том, чтобы пройти все значения один раз, а затем вернуться, чтобы восстановить смещение. Есть идеи?

Редактировать

Чтобы прояснить поведение, которое я хочу увидеть, способ его округления не имеет большого значения для меня, если сумма верна, а соотношения чисел примерно одинаковы. Меня не волнует, является ли общая ошибка наименьшей или большинство округляется в меньшую сторону.

Дополнительные требования состоят в том, чтобы числам оставалось только оставаться равными или становиться меньше, числа должны быть> = 0, а итоговый список чисел должен быть целыми числами.

Answer 1

Мы можем указать требования к функции с помощью clojure.spec.Если мы хотим, чтобы функция поддерживала целые числа с произвольной точностью, последовательности, которые суммируются с нулем, пустые последовательности и т. Д., Мы могли бы написать эту спецификацию функции:

(s/def ::natural-integer (s/and integer? (comp not neg?)))
(s/fdef dec-sum-int
  :args (s/and (s/cat :new-sum ::natural-integer
                      :nums (s/coll-of ::natural-integer))
               #(<= (:new-sum %) (apply +' (:nums %))))
  :ret  (s/coll-of ::natural-integer)
  :fn   (fn [{:keys [args ret]}]
          (and (= (count (:nums args)) (count ret))
               ;; each output <= corresponding input
               (every? true? (map <= ret (:nums args)))
               (or (empty? ret)
                   (= (:new-sum args) (apply + ret))))))

Затем st/check оригинальный ответ ниже длясм. примеры с ошибками или см. примеры вызовов с s/exercise-fn.

Вот версия, которая удовлетворяет спецификации для ваших обновленных требований.Большая сложность состоит в том, чтобы обеспечить каждый выход <= вход при корректировке на ошибку округления: </p>

(defn dec-sum-int [new-sum nums]
  (let [sum   (apply +' nums)
        ratio (if (zero? sum) 1 (/ new-sum sum))
        nums' (map #(bigint (*' % ratio)) nums)
        err   (- new-sum (apply + nums'))]
    (loop [nums  nums
           nums' nums'
           out   []
           err   err]
      (cond
        (zero? err)
        (into out nums')

        (seq nums')
        (let [[num & more] nums
              [num' & more'] nums']
          (if (pos? num)
            (let [num'' (min num (+ num' err))]
              (recur more more'
                     (conj out num'')
                     (- err (- num'' num'))))
            (recur more more' (conj out num') err)))

        :else out))))

(st/summarize-results (st/check `dec-sum-int))
{:sym playground.so/dec-sum-int}
=> {:total 1, :check-passed 1}

Исходный ответ

Вот функция для умножения каждого числа насбор по соотношению для достижения желаемой суммы:

(defn adjust-sum [new-sum nums]
  (let [sum (apply + nums)]
    (map #(* % (/ new-sum sum))
         nums)))

(adjust-sum 90 [0 10 30 40 20 0])
=> (0N 9N 27N 36N 18N 0N)
(map int *1)
=> (0 9 27 36 18 0)

Для вашего примера результаты естественно получаются в виде больших целых чисел.Это единственный приведенный пример, но эта проблема хорошо подходит для генеративного тестирования на основе свойств.Мы можем определить свойства, которые должны храниться для всех примеров, и использовать test.check для проверки функции на множестве случайных примеров, которые мы, возможно, и не предполагали:

(tc/quick-check 10000
  (prop/for-all [new-sum gen/int
                 nums (->> (gen/vector gen/int)
                           ;; current approach fails for inputs that sum to zero
                           (gen/such-that #(not (zero? (apply + %)))))]
    (= new-sum (apply + (adjust-sum new-sum nums)))))
=> {:result true, :num-tests 10000, :seed 1552170880184}

См. Обновления выше для обработки примеров с ошибкой округления.или предыдущие изменения для обработки отрицательных чисел.

Answer 2

Я не думаю, что есть способ решить эту проблему, не просматривая список во второй раз, чтобы исправить округление.Вот одно решение, использующее Метод наибольшего остатка :

(defn adj-seq
  [input ratio rounding]
  (let [;;
        ;; function to apply ratio to a number
        ;;
        mul-ratio    (partial * ratio)
        ;;
        ;; function to apply ratio and rounding to a number
        ;;
        mul-ratio-r  (comp rounding mul-ratio)
        ;;
        ;; sort oirignal input with largest remainder first
        ;; then applies ratio and rounding to each number
        ;;
        rounded-list (->> input
                          (sort-by #(- (mul-ratio-r %)
                                       (mul-ratio %)))
                          (map mul-ratio-r))
        ;;
        ;; sum of original numbers
        ;;
        sum-input    (reduce + input)
        ;;
        ;; calculate the delta between the expected sum and sum of all rounded numbers
        ;;
        delta        (- (mul-ratio-r sum-input) (reduce + rounded-list))]

    ;;
    ;; distribute delta to the rounded numbers in largest remainder order
    ;;
    (->> rounded-list
         (reductions (fn [[remain _] e]
                       ;; increment number by 1 if remaining delta is >1
                       (if (pos? remain)
                         [(dec remain) (inc e)]
                         ;; otherwise returns the rounded number as is
                         [0 e]))
                     ;; delta is the initial value to feed to the reducing function
                     [delta])
         ;;
         ;; ignore the first output from the reducing function - which is the original delta
         ;;
         rest
         ;;
         ;; get the adjusted number: ratio + rounding + delta-adj
         ;;
         (map last))))

И примерный прогон:

(def input [0 10 30 40 20 0])
(def ratio 0.83)
(def rounding int)

(reduce + input)
;; => 100
(* ratio *1)
;; => 83.0
(adj-seq input ratio rounding)
;; => (25 17 8 33 0 0)
(reduce + *1)
;; => 83

Answer 3

Это то, что вам нужно?

(defn scale-vector 
  "Given `s`, a sequence of numbers, and `t`, a target value for the sum of
  the sequence, return a sequence like `s` but with each number scaled 
  appropriately." 
  [s t]
  (let [ratio (/ (reduce + (filter number? s)) t)]
    (map #(if (number? %) (/ % ratio) %) s)))

(scale-vector [10 20 :foo 30 45.3 0 27/3] 21)
=> (1.837270341207349 3.674540682414698 :foo 5.511811023622047 8.32283464566929 0.0 1.6535433070866141)

(reduce + (filter number? (scale-vector [10 20 :foo 30 45.3 0 27/3] 21)))
=> 21.0

Что здесь происходит:

1. Мы предполагаем, что s - это последовательность чисел; но это не обязательно ошибка, если какой-то элемент не является числом. Фильтрация по числам позволяет изящно справляться с некоторыми нечисловыми элементами; Я решил сохранить нечисловые элементы, но вы также можете их удалить.
2. Я не сделал ничего особенного, чтобы исключить рациональные числа из вывода, и я не понимаю, зачем вам это нужно; но если вы хотите сделать это, вы можете использовать (map double [1 1/2 22/7]) => (1.0 0.5 3.142857142857143).
3. Но идиоматически, в Clojure число - это просто число. Любая функция, которая принимает числа, должна принимать числа. Рациональные числа - то, что вы называете «дробями» - это просто числа, как и любые другие числа. Не беспокойся о них.