如何解决Clojure-在向量中找到相同值的最长条纹及其索引
在向量中,我想找到某个值的最长条形和该条形的起始索引。
示例:(最长条纹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}))
解决方法
这是我会建议的:
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}
摘要结束。
请参阅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-val 1}
{:streak-idx 4,:streak-len 1,:streak-val 0}
{:streak-idx 5,:streak-len 3,:streak-val 2}
{:streak-idx 8,: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-val 1})
(is= (longest-ones-streak [0 0 1 1 0 1 1 1 3]) {:streak-idx 5,:streak-val 1})
(is= (longest-ones-streak [0 0 1 1 0 1 1 3 3]) {:streak-idx 5,:streak-val 1})
(is= (longest-ones-streak [0 0 1 1 1 0 1 1 3]) {:streak-idx 2,:streak-val 1}))
请注意,如果出现平局,max-key
使用“最后一个获胜”技术。
原始答案
要开始,请删除所有前导0
元素。然后,在遇到下一个split-with
时,使用0
分割序列。计算找到的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}))
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。