[Haskell-cafe] Improving *> and >> for Data.Sequence
David Feuer
david.feuer at gmail.com
Sun Nov 23 05:07:56 UTC 2014
OK, sorry for the flood of posts, but I think I've found a way to make that
work. Specifically, I think I can write a three-Seq append that takes the
total size and uses it to be as lazy as possible in the second of the three
Seqs. I'm still working out the details, but I think it will work. It does
the (possibly avoidable) rebuilding, but I *think* it's at least
asymptotically optimal. Of course, if Ross Paterson can find something more
efficient, that'd be even better.
On Sat, Nov 22, 2014 at 10:10 PM, David Feuer <david.feuer at gmail.com> wrote:
> OK, so I've thought about this some more. I think the essential *concept*
> I want is close to this, but it won't quite work this way:
>
> fs <*> xs = equalJoin $ fmap (<$> xs) fs
>
> equalJoin :: Int -> Seq (Seq a) -> Seq a
> equalJoin n s
> | length s <= 2*n = simpleJoin s
> | otherwise = simpleJoin pref ><
> equalJoin (2*n) mid ><
> simpleJoin suff
> where (pref, s') = splitAt n s
> (mid, suff) = splitAt (length s - 2*n) s'
>
> simpleJoin :: Seq (Seq a) -> Seq a
> simpleJoin s
> | null s = empty
> | length s == 1 = index s 0
> | otherwise = simpleJoin front >< simpleJoin back
> where
> (front,back) = splitAt (length s `quot` 2) s
>
> I think the reason this doesn't work is that >< is too strict. I believe
> the only potential way around this is to dig into the FingerTree
> representation and build the thing top-down. I still don't understand how
> (if at all) this can be done.
>
>
> On Sat, Nov 22, 2014 at 12:57 PM, David Feuer <david.feuer at gmail.com>
> wrote:
>
>> The ideal goal, which has taken me forever to identify and which may well
>> be unattainable, is to get O(log(min{i,mn-i})) access to each element of
>> the result, while maintaining O(mn) time to force it entirely. Each of
>> these is possible separately, of course. To get them both, if it's
>> possible, we need to give up on the list-like approach and start splitting
>> Seqs instead of lists. As we descend, we want to pass a single thunk to
>> each element of each Digit to give it just enough to do its thing.
>> Representing the splits efficiently and/or memoizing them could be a bit of
>> a challenge.
>> On Fri, Nov 21, 2014 at 02:00:16PM -0500, David Feuer wrote:
>> > To be precise, I *think* using the fromList approach for <*> makes us
>> create O
>> > (n) thunks in order to extract the last element of the result. If we
>> build the
>> > result inward, I *think* we can avoid this, getting the last element of
>> the
>> > result in O(1) time and space. But my understanding of this data
>> structure
>> > remains primitive.
>>
>> This modification of the previous should do that.
>>
>> mult :: Seq (a -> b) -> Seq a -> Seq b
>> mult sfs sxs = fromTwoLists (length sfs * length sxs) ys rev_ys
>> where
>> fs = toList sfs
>> rev_fs = toRevList sfs
>> xs = toList sxs
>> rev_xs = toRevList sxs
>> ys = [f x | f <- fs, x <- xs]
>> rev_ys = [f x | f <- rev_fs, x <- rev_xs]
>>
>> -- toRevList xs = toList (reverse xs)
>> toRevList :: Seq a -> [a]
>> toRevList = foldl (flip (:)) []
>>
>> -- Build a tree lazy in the middle, from a list and its reverse.
>> --
>> -- fromTwoLists (length xs) xs (reverse xs) = fromList xs
>> --
>> -- Getting the kth element from either end involves forcing the lists
>> -- to length k.
>> fromTwoLists :: Int -> [a] -> [a] -> Seq a
>> fromTwoLists len_xs xs rev_xs =
>> Seq $ mkTree2 len_xs 1 (map Elem xs) (map Elem rev_xs)
>>
>> -- Construct a fingertree from the first n elements of xs.
>> -- The arguments must satisfy n <= length xs && rev_xs = reverse xs.
>> -- Each element of xs has the same size, provided as an argument.
>> mkTree2 :: Int -> Int -> [a] -> [a] -> FingerTree a
>> mkTree2 n size xs rev_xs
>> | n == 0 = Empty
>> | n == 1 = let [x1] = xs in Single x1
>> | n < 6 = let
>> nl = n `div` 2
>> l = Data.List.take nl xs
>> r = Data.List.take (n - nl) rev_xs
>> in Deep totalSize (mkDigit l) Empty (mkRevDigit r)
>> | otherwise = let
>> size' = 3*size
>> n' = (n-4) `div` 3
>> digits = n - n'*3
>> nl = digits `div` 2
>> (l, xs') = Data.List.splitAt nl xs
>> (r, rev_xs') = Data.List.splitAt (digits - nl) rev_xs
>> nodes = mkNodes size' xs'
>> rev_nodes = mkRevNodes size' rev_xs'
>> in Deep totalSize (mkDigit l) (mkTree2 n' size' nodes rev_nodes)
>> (mkRevDigit r)
>> where
>> totalSize = n*size
>>
>> mkDigit :: [a] -> Digit a
>> mkDigit [x1] = One x1
>> mkDigit [x1, x2] = Two x1 x2
>> mkDigit [x1, x2, x3] = Three x1 x2 x3
>> mkDigit [x1, x2, x3, x4] = Four x1 x2 x3 x4
>>
>> -- length xs <= 4 => mkRevDigit xs = mkDigit (reverse xs)
>> mkRevDigit :: [a] -> Digit a
>> mkRevDigit [x1] = One x1
>> mkRevDigit [x2, x1] = Two x1 x2
>> mkRevDigit [x3, x2, x1] = Three x1 x2 x3
>> mkRevDigit [x4, x3, x2, x1] = Four x1 x2 x3 x4
>>
>> mkNodes :: Int -> [a] -> [Node a]
>> mkNodes size (x1:x2:x3:xs) = Node3 size x1 x2 x3:mkNodes size xs
>>
>> -- length xs `mod` 3 == 0 =>
>> -- mkRevNodes size xs = reverse (mkNodes size (reverse xs))
>> mkRevNodes :: Int -> [a] -> [Node a]
>> mkRevNodes size (x3:x2:x1:xs) = Node3 size x1 x2 x3:mkRevNodes size xs
>> _______________________________________________
>> Haskell-Cafe mailing list
>> Haskell-Cafe at haskell.org
>> http://www.haskell.org/mailman/listinfo/haskell-cafe
>>
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141123/a229bee8/attachment.html>
More information about the Haskell-Cafe
mailing list