Clojure - 找到相同值的最长连胜及其在向量中的索引
Clojure - find longest streak of the same value and its index in a vector
在向量中，我想找到某个值的最长条纹和该条纹的起始索引。
示例：（最长连胜 1 [0 0 1 1 1 0 1 0]）应该 return {: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}))
请参阅this list of documention, especially 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}))
这就是我的建议：
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 错误处防止空序列：
(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])))
可以在没有明显循环的情况下完成：
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} 摘要最后。
在向量中，我想找到某个值的最长条纹和该条纹的起始索引。
示例：（最长连胜 1 [0 0 1 1 1 0 1 0]）应该 return {: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}))
请参阅this list of documention, especially 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}))
这就是我的建议：
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 错误处防止空序列：
(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])))
可以在没有明显循环的情况下完成：
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} 摘要最后。