<div dir="ltr"><div>Viktor is right. Here's a small hint towards one way of solving it: start by replacing every number smaller than B by -1, and every number larger than B by 1 (and B itself by 0).</div><div><br></div><div>-Brent<br></div></div><br><div class="gmail_quote"><div dir="ltr" class="gmail_attr">On Wed, Sep 23, 2020 at 2:17 AM Dominik Bollmann <<a href="mailto:dominikbollmann@gmail.com">dominikbollmann@gmail.com</a>> wrote:<br></div><blockquote class="gmail_quote" style="margin:0px 0px 0px 0.8ex;border-left:1px solid rgb(204,204,204);padding-left:1ex"><br>
Hi Haskell-Cafe,<br>
<br>
I've been trying to solve the Open Kattis Problem called Srednji<br>
recently, unfortunately without success.<br>
<br>
Given a sequence A and a number B within that sequence this problem asks<br>
to find all odd sub-sequences of A that, when sorted, have B as their<br>
median in the middle. That is, from A we may remove some prefix and/or<br>
suffix and if the resulting sub-sequence -- when sorted -- contains B in<br>
the middle, then this sub-sequence is a solution. The problem asks to<br>
find the number of all solutions. Check out<br>
<a href="https://open.kattis.com/problems/srednji" rel="noreferrer" target="_blank">https://open.kattis.com/problems/srednji</a> for the details.<br>
<br>
My Haskell solution below tries to find the number of odd sub-sequences<br>
by first locating the median and then repeatedly moving left and right<br>
from that median to find larger and larger sub-sequence candidates. Each<br>
found candidate is checked to have B in the middle when sorted in order<br>
to become a solution. Moreover, I also extend each such candidate<br>
further to the left (and to the right, respectively) to determine<br>
whether these leftward or rightward extensions are solutions, too.<br>
<br>
I think with this approach I systematically enumerate all solutions.<br>
Unfortunately, though, this approach is too slow and times out on the<br>
11th hidden test cases.<br>
<br>
I'd therefore be thankful for hints about different approaches to<br>
solving this problem more efficiently.<br>
<br>
<br>
Thanks!<br>
<br>
Dominik.<br>
<br>
====================================================================<br>
<br>
My current, slow Haskell code is this:<br>
<br>
import Data.Maybe<br>
import Data.Sequence (Seq, (<|), (|>))<br>
import qualified Data.Sequence as Seq<br>
import qualified Data.Vector.Unboxed as Vec<br>
<br>
data SubSeq = SubSeq<br>
{ getBalance :: {-# UNPACK #-} !Int<br>
, getSubSeq :: Seq Int<br>
, from :: {-# UNPACK #-} !Int<br>
, to :: {-# UNPACK #-} !Int<br>
}<br>
<br>
balancedSubSeqs :: [Int] -> Int -> [SubSeq]<br>
balancedSubSeqs seq med = do<br>
candidate <- leftRight [val0]<br>
let lefts = leftLeft candidate []<br>
rights = rightRight candidate []<br>
candidate ?: lefts ++ rights<br>
where<br>
medidx = fromJust (Vec.findIndex (== med) arr)<br>
val0 = SubSeq 0 (Seq.singleton med) medidx medidx<br>
arr = Vec.fromList seq<br>
<br>
leftRight cands@(SubSeq balance seq i j : _)<br>
| i-1 < 0 || j+1 >= Vec.length arr = cands<br>
| otherwise =<br>
let v1 = arr Vec.! (i-1)<br>
v2 = arr Vec.! (j+1)<br>
balance' = newBalance balance v1 v2<br>
seq' = (v1 <| seq) |> v2<br>
in leftRight (SubSeq balance' seq' (i-1) (j+1) : cands)<br>
<br>
leftLeft cand@(SubSeq balance seq i j) sols<br>
| i-2 < 0 = sols<br>
| otherwise =<br>
let v1 = arr Vec.! (i-2)<br>
v2 = arr Vec.! (i-1)<br>
balance' = newBalance balance v1 v2<br>
seq' = v1 <| v2 <| seq<br>
newCand = SubSeq balance' seq' (i-2) j<br>
in leftLeft newCand (newCand ?: sols)<br>
<br>
rightRight cand@(SubSeq balance seq i j) sols<br>
| j+2 >= Vec.length arr = sols<br>
| otherwise =<br>
let v1 = arr Vec.! (j+1)<br>
v2 = arr Vec.! (j+2)<br>
balance' = newBalance balance v1 v2<br>
seq' = seq |> v1 |> v2<br>
newCand = SubSeq balance' seq' i (j+2)<br>
in rightRight newCand (newCand ?: sols)<br>
<br>
newBalance old n1 n2<br>
| n1 < med, n2 < med = old - 2<br>
| n1 > med, n2 > med = old + 2<br>
| otherwise = old<br>
<br>
infixr 5 ?:<br>
--(?:) :: SubSeq -> [SubSeq] -> [SubSeq]<br>
x@(SubSeq b _ _ _) ?: xs<br>
| b == 0 = x : xs<br>
| otherwise = xs<br>
<br>
main :: IO ()<br>
main = do<br>
[len, median] <- fmap read . words <$> getLine<br>
seq <- fmap read . words <$> getLine<br>
let solutions = balancedSubSeqs seq median<br>
print (length solutions)<br>
_______________________________________________<br>
Haskell-Cafe mailing list<br>
To (un)subscribe, modify options or view archives go to:<br>
<a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe</a><br>
Only members subscribed via the mailman list are allowed to post.</blockquote></div>