Clojure - 在向量中找到相同值的最长条纹及其索引

Question

在一个向量中，我想找到某个值的最长条纹和该条纹的起始索引。

示例：(longest-streak-of 1 [0 0 1 1 1 0 1 0]) 应该返回 {:cnt 3 :at 2}。 我发现的两个解决方案对我来说似乎不是很流行 - 我还在学习，所以请耐心等待。 欢迎任何提供更优雅解决方案的答案。

这是我的第一次尝试：

(defn longest-streak-of
  "Returns map with :cnt (highest count of successive n's) and :at (place in arr)"
  [n arr]
  (loop [arr arr streak 0 oldstreak 0 arrcnt 0 place 0]
    (if (and (not-empty arr) (some #(= n %) arr))
      (if (= (first arr) n)
        (recur (rest arr) (+ streak 1) oldstreak (inc arrcnt) place)
        (recur (rest arr) 0 (if (> streak oldstreak)
                              streak oldstreak)
               (inc arrcnt) (if (> streak oldstreak)
                              (- arrcnt streak) place)))
      (if (> streak oldstreak) {:cnt streak :at (- arrcnt streak)}
          {:cnt oldstreak :at place}))))

第二种解决方案，它使用 clojure.string，但比上面的那个慢（我对这两个函数进行了计时，这需要两倍的时间）。我更喜欢这样的东西，希望不使用字符串库，因为我认为它更容易阅读和理解：

(ns lso.core
  (:require [clojure.string :as s])
  (:gen-class))

(defn lso2 [n arr]
  (let [maxn (apply max (map count (filter #(= (first %) n) (partition-by #(= n %) arr))))]
    {:cnt maxn :at (s/index-of (s/join "" arr) (s/join (repeat maxn (str n))))}))

提前感谢您的任何见解！

阅读艾伦的回答后的新版本：

(defn lso3
;; This seems to be the best solution yet 
  [n arr]
  (if (some #(= n %) arr)
    (let [parts (partition-by #(= n %) arr)
          maxn (apply max (map count (filter #(= (first %) n) parts)))]
      (loop [parts parts idx 0]
        (if-not (and (= maxn (count (first parts))) (= n (first (first parts))))
          (recur (rest parts) (+ idx (count (first parts))))
          {:cnt maxn :at idx})))
    {:cnt 0 :at 0}))

Answer 1

这就是我的建议：

user> (->> [0 0 1 1 1 0 1 0]
           (map-indexed vector)               ;; ([0 0] [1 0] [2 1] [3 1] [4 1] [5 0] [6 1] [7 0])
           (partition-by second)              ;; (([0 0] [1 0]) ([2 1] [3 1] [4 1]) ([5 0]) ([6 1]) ([7 0]))
           (filter (comp #{1} second first))  ;; (([2 1] [3 1] [4 1]) ([6 1]))
           (map (juxt ffirst count))          ;; ([2 3] [6 1])
           (apply max-key second)             ;; [2 3]
           (zipmap [:at :cnt]))               ;; {:at 2, :cnt 3}

;; {:at 2, :cnt 3}

或将其包装在一个函数中：

(defn longest-run [item data]
  (when (seq data)  ;; to prevent exception on apply for empty data
    (->> data
         (map-indexed vector)
         (partition-by second)
         (filter (comp #{item} second first))
         (map (juxt ffirst count))
         (apply max-key second)
         (zipmap [:at :cnt]))))

user> (longest-run 1 [1 1 1 2 2 1 2 2 2 2 2])
;;=> {:at 0, :cnt 3}

更新

这个可以防止apply处的空seq错误：

(defn longest-run [item data]
  (some->> data
           (map-indexed vector)
           (partition-by second)
           (filter (comp #{item} second first))
           (map (juxt ffirst count))
           seq
           (apply max-key second)
           (zipmap [:at :cnt])))

Answer 2

可以在没有明显循环的情况下完成：

user> (defn longest-streak-of [v]
        (->> (map vector v (range)) 
             (partition-by first) 
             (map (fn [r] {:at (second (first r)) :cnt (count r)})) 
             (apply max-key :cnt)))
#'user/longest-streak-of
user> (longest-streak-of [0 0 1 1 1 0 1 0])
{:at 2, :cnt 3}

第一步将每个成员与其位置配对。然后partition-by按值阻塞向量（忽略位置）；从而我们可以捕获起始位置和长度。

我想可以通过颠倒最后两个步骤来提高效率，即通过使用count 执行max-key 并仅在最后形成{:at, :cnt} 总结。

Answer 3

请参阅this list of documention，尤其是the Clojure CheatSheet。您正在寻找函数split-with。

---

更好的答案

我认为这个版本使用辅助函数来索引数组比我原来的答案更简单：

(ns tst.demo.core
  (:use tupelo.core tupelo.test)
  (:require
    [schema.core :as s]
    [tupelo.schema :as tsk]))

(s/defn streak-info :- [tsk/KeyMap]
  [coll :- tsk/List]
  (let [coll          (vec coll)
        N             (count coll)

        streak-start? (s/fn streak-start? :- s/Bool
                        [idx :- s/Num]
                        (assert (and (<= 0 idx) (< idx N)))
                        (if (zero? idx)
                          true
                          (not= (nth coll (dec idx)) (nth coll idx))))

        result        (reduce
                        (fn [accum idx]
                          (if-not (streak-start? idx)
                            accum
                            (let [coll-remaining (subvec coll idx)
                                  streak-val     (first coll-remaining)
                                  streak-vals    (take-while #(= streak-val %) coll-remaining)
                                  streak-len     (count streak-vals)
                                  accum-next     (append accum {:streak-idx idx
                                                                :streak-len streak-len
                                                                :streak-val streak-val})]
                              accum-next)))
                        []
                        (range N))]
    result))

单元测试显示 streak-info 正在运行：

(dotest
  (is= (streak-info [0 0 1 1 0 2 2 2 3])
    [{:streak-idx 0, :streak-len 2, :streak-val 0}
     {:streak-idx 2, :streak-len 2, :streak-val 1}
     {:streak-idx 4, :streak-len 1, :streak-val 0}
     {:streak-idx 5, :streak-len 3, :streak-val 2}
     {:streak-idx 8, :streak-len 1, :streak-val 3}])
  )

然后我们只需要丢弃所有没有所需值1 的条纹，然后通过max-key 找到最长的条纹。

(s/defn longest-ones-streak :- tsk/KeyMap
  [coll :- tsk/List]
  (let [streak-info-all  (streak-info coll)
        streak-info-ones (filter #(= 1 (grab :streak-val %)) streak-info-all)]
    (apply max-key :streak-len streak-info-ones)))

(dotest
  (is= (longest-ones-streak [0 0 1 1 0 2 2 2 3]) {:streak-idx 2, :streak-len 2, :streak-val 1})
  (is= (longest-ones-streak [0 0 1 1 0 1 1 1 3]) {:streak-idx 5, :streak-len 3, :streak-val 1})
  (is= (longest-ones-streak [0 0 1 1 0 1 1 3 3]) {:streak-idx 5, :streak-len 2, :streak-val 1})
  (is= (longest-ones-streak [0 0 1 1 1 0 1 1 3]) {:streak-idx 2, :streak-len 3, :streak-val 1}))

请注意，如果出现平局，max-key 使用“最后一个获胜”技术。

---

原答案

首先，删除所有前导 0 元素。然后，在遇到下一个0 时，使用split-with 对序列进行分段。计算找到的1 元素并与索引一起保存。

以上内容需要用loop/recur、reduce 或类似名称进行包装。

你说如何跟踪索引？最简单的方法是将值序列转换为对序列（len-2 向量），其中每对的第一项是索引。一个简单的方法是indexed 函数from the Tupelo library：

(defn indexed
  "Given one or more collections, returns a sequence of indexed tuples from the collections:
        (indexed xs ys zs) -> [ [0 x0 y0 z0]
                                [1 x1 y1 z1]
                                [2 x2 y2 z2]
                                ... ]
                                "
  [& colls]
  (apply zip-lazy (range) colls))

简化为

(defn indexed [vals]
  (mapv vector (range) vals))

所以，我们有一个例子：

(indexed [0 0 1 1 0]) =>
    [[0 0]
     [1 0]
     [2 1]
     [3 1]
     [4 0]]

---

带有单元测试的示例解决方案：

(ns tst.demo.core
  (:use tupelo.core tupelo.test)
  (:require
    [schema.core :as s]
    [tupelo.core :as t]
    [tupelo.schema :as tsk]))

(s/defn zero-val?
  [pair :- tsk/Pair]
  (let [[idx val] pair] ; destructure the pair into its 2 components
    (zero? val)))

(dotest
  (let [pairs (indexed [0 0 1 1 0])]
    (is= pairs
      [[0 0]
       [1 0]
       [2 1]
       [3 1]
       [4 0]])
    (is (zero-val? [5 0]))
    (isnt (zero-val? [5 1]))))

上面显示了通过辅助函数测试零。以下是我们如何查找和分析索引对序列中的第一个条纹：

(defn count-streak
  [pairs]
  (let [v1        (drop-while zero-val? pairs)
        [one-pairs remaining-pairs] (split-with #(not (zero-val? %)) v1)
        ones-cnt  (count one-pairs)
        first-pair (first one-pairs)
        idx-begin (first first-pair)]
    ; create a map like
    ;   {:remaining-pairs remaining-pairs
    ;    :ones-cnt        ones-cnt
    ;    :idx-begin       idx-begin}
    (t/vals->map remaining-pairs ones-cnt idx-begin)))

(dotest
  (is= (count-streak (indexed [0 0 1 1 0]))
    {:idx-begin       2
     :ones-cnt        2
     :remaining-pairs [[4 0]]}))

然后使用loop/recur 找到最长的连胜。

(defn max-streak
  [vals]
  (loop [idx-pairs   (indexed vals)
         best-streak {:best-len -1 :best-idx nil}]
    (if (empty? idx-pairs)
      (if (nil? (grab :best-idx best-streak))
        (throw (ex-info "No streak of 1's found" (vals->map best-streak idx-pairs)))
        best-streak)
      (let [curr-streak (count-streak idx-pairs)]
        (t/with-map-vals curr-streak [remaining-pairs ones-cnt idx-begin]
          (t/with-map-vals best-streak [best-len best-idx]
            (if (< best-len ones-cnt)
              (recur remaining-pairs {:best-len ones-cnt :best-idx idx-begin})
              (recur remaining-pairs best-streak))))))))

(dotest
  (throws? (max-streak [0 0 0]) )
  (is= (max-streak [0 0 1 1 0]) {:best-len 2, :best-idx 2})
  (is= (max-streak [0 0 1 1 0 1 0]) {:best-len 2, :best-idx 2})
  (is= (max-streak [0 1 0 1 1 0]) {:best-len 2, :best-idx 3})
  (is= (max-streak [0 1 1 0 1 1 1 0]) {:best-len 3, :best-idx 4}))