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

Question

在向量中，我想找出某一值的最长条纹和该条的起始指数。

示例：(最长条纹为1 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))))}))

提前感谢您的任何见解！

在阅读了Alan的答案之后，有了一个新版本：

(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通过值(忽略位置)阻塞向量；因此我们可以捕获起始位置和长度。

我认为，通过倒转最后两个步骤，即用max-key处理count和只在最后形成{:at, :cnt}摘要，可以提高一些效率。

Answer 3

请看这份文件清单，特别是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元素。然后，在遇到下一个split-with时使用0对序列进行分段。计算找到的1元素，并与索引一起保存。

上面的内容需要包装在loop/recur、reduce或类似的文件中。

你说如何跟踪索引？最简单的方法是将值序列转换为成对序列(len-2向量)，其中每对的第一项是索引。一个简单的方法是indexed函数从图佩洛图书馆。

(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}))