Nice try Twan but your example fails on infinite lists. I cleaned up your example so that it compiles: import qualified Data.Map as Map splitStreamsMap :: Ord a => [(a,b)] -> Map.Map a [b] splitStreamsMap = foldl add Map.empty where add m (a,b) = Map.insertWith (++) a [b] m splitStreams :: Ord a => [(a,b)] -> [(a,[b])] splitStreams = Map.toList . splitStreamsMap It fails to return a value on this test: take 2 $ snd $ head $ splitStreams (map (\x -> (0 ,x)) [1..]) / Magnus On Thu, 14 Sep 2006, Twan van Laarhoven wrote:

Magnus Jonsson wrote:

...

Dear Haskell Cafe,

When programming the other day I ran into this problem. What I want to do is a function that would work like this:

splitStreams::Ord a=>[(a,b)]->[(a,[b])]

...

splitStreams [(3,x),(1,y),(3,z),(2,w)]

[(3,[x,z]),(1,[y]),(2,[w])]

A O(n log(n)) algorithm is easy if you use Data.Map:

...

import qualified Data.Map as Map

splitStreamsMap :: Ord a => [(a,b)] -> Map.Map a [b] splitStreamsMap = foldl add Map.empty where add (a,b) m = Map.insertWith (++) a [b]

splitStreams = Map.fromList . splitStreamsMap

Twan

On Thu, 14 Sep 2006, Ketil Malde wrote:

Magnus Jonsson writes:

...

splitStreams::Ord a=>[(a,b)]->[(a,[b])]

...

...

splitStreams [(3,x),(1,y),(3,z),(2,w)] [(3,[x,z]),(1,[y]),(2,[w])]

[...]

...

But is there any way to write it such that each element is touched only once? Or at least an O(n*log(m)) algorithm?

I guess it should be possible to use a quicksort-like algorithm, splitting the stream into three streams with keys less than, equal, and greater than the first element, and recurse on the less/equal streams?

-k

That is probably the best we can do. I think in a hypothetical concurrent Haskell with futures/promises, the split stream problem could be solved. But if it can be solved in regular Haskell, I would be pleasantly surprised. / Magnus

Hello, I think it is possible to do it in O(n) (if you change the representation of the output stream). Note that the solution is quite similar toTwan van Laarhoven, and it should be trivial use "Map" instead of "Rel". Here is my take on it: The type of the output stream:

type Rel a b = a -> [b]

Here are cons and nil:

cons :: Eq a => (a,b) -> Rel a b -> Rel a b cons (x,y) l z | x == z = y : l x | otherwise = l z

nil :: Rel a b nil _ = []

and a lookUp function:

lookUp :: Rel a b -> a -> [b] lookUp = id

Finally the splitStreams algorithm:

splitStreams :: Eq a => [(a,b)] -> Rel a b splitStreams = foldr cons nil

Here is a test with finite lists:

fin = splitStreams [(3,'x'),(1,'y'),(3,'z'),(2,'w')]

and here are the console tests: *General7> lookUp fin 1 "y" *General7> lookUp fin 2 "w" *General7> lookUp fin 3 "xz" Now with infinite lists:

inf = splitStreams (map (\x -> (0, x)) [1..])

and here a case where it terminates with infinite lists: *General7> take 10 (lookUp inf 0) [1,2,3,4,5,6,7,8,9,10] Cheers, Bruno Oliveira

Hello Magnus, You are right. Silly me. I was thinking of Rel as a kind of Hashtable. In this case, I think it should be possible to have O(n), since "cons" would only need constant time. Cheers, Bruno On Thu, 14 Sep 2006 13:11:05 -0400 (EDT), Magnus Jonsson wrote:

Thanks Bruno.

However I think this is still O(n*m). As far as I understand your code it is a longwinded way to say "[b | (a,b) <- input, b == myChannelOfInterest]". This is fine if you are only interested in one channel, and for that case I agree it's O(n), but if you are interested in many different channels, it will take O(n*m). Here's why I think your code is equivalent to using a filter/list-comprehension:

...

...

cons :: Eq a => (a,b) -> Rel a b -> Rel a b cons (x,y) l z | x == z = y : l x | otherwise = l z

z is the channel that the user is interested in. x is the channel of the current message in the list. y is the message content. l is a function for searching the rest of the list.

For each element of the list you create a function that compares the requested channel to a (in (a,b)). If it's the same, you return that element followed by a continued search down the list. If you don't find it, you forward the request to the next function down the list. That's exactly the same as what the filter function does.

It is possible I made a mistake somewhere and if I did, let me know.

/ Magnus

On Thu, 14 Sep 2006, Bruno Oliveira wrote:

...

Hello,

I think it is possible to do it in O(n) (if you change the representation of the output stream).

Note that the solution is quite similar toTwan van Laarhoven, and it should be trivial use "Map" instead of "Rel".

Here is my take on it:

The type of the output stream:

...

type Rel a b = a -> [b]

Here are cons and nil:

...

nil :: Rel a b nil _ = []

and a lookUp function:

...

lookUp :: Rel a b -> a -> [b] lookUp = id

Finally the splitStreams algorithm:

...

splitStreams :: Eq a => [(a,b)] -> Rel a b splitStreams = foldr cons nil

Here is a test with finite lists:

...

fin = splitStreams [(3,'x'),(1,'y'),(3,'z'),(2,'w')]

and here are the console tests:

*General7> lookUp fin 1 "y" *General7> lookUp fin 2 "w" *General7> lookUp fin 3 "xz"

Now with infinite lists:

...

inf = splitStreams (map (\x -> (0, x)) [1..])

and here a case where it terminates with infinite lists:

*General7> take 10 (lookUp inf 0) [1,2,3,4,5,6,7,8,9,10]

Cheers,

Bruno Oliveira

_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

On Thu, 14 Sep 2006, Henning Thielemann wrote:

Interestingly we use such a routine in Haskore for splitting a sequence of notes into sequences of notes of equal instruments. It's implemented rather the same way like your version.

It's 'slice' in http://darcs.haskell.org/haskore/src/Haskore/Basic/TimeOrderedList.lhs but it is a bit more complicated because it has to manage time information.

Now even more interestingly, my program also deals with musiec! :) I'm generating microtonal midi files. I use it for very much the same purpose as you do (although my program is not yet finished). - Magnus

On Thu, 14 Sep 2006, Henning Thielemann wrote:

On Thu, 14 Sep 2006, Magnus Jonsson wrote:

...

Now even more interestingly, my program also deals with music! :) I'm generating microtonal midi files. I use it for very much the same purpose as you do (although my program is not yet finished).

Is it something we could and should add to Haskore?

If Haskore could support microtones that would make this world a slightly better world for me. Here are the basic things you need to support microtonal music: - Pitch representations would have to be able to express any pitch. - One appealing approach is to represent a pitch directly as it's frequency. - Probably the most useful representation though is a base pitch, say one of C,D,E,F,G,A,B, followed by a list of accidentals that modify the pitch. The user should be able to define his own base pitches and accidentals, in terms of cents or frequency ratios or something similar. - Generating microtonal midi files requires that you add pitch-bend messages before all notes. That restricts each midi channel to only being able to play one note at a time. This is a big deficiency in the midi protocol imo. / Magnus

I wrote:

[1] Balancing can be done with the information in the blueprint, and mapping back is easily done by doing the transformation on the tree in reverse.

I should add that this possibility was the main reason for dealing with blueprints at all. As Ross Paterson's solution shows, it's possible to get simpler code without balancing the tree. regards, Bertram

Magnus Jonsson wrote:

Thanks Bertran for your solution. I have difficulty understanding it so I can't comment on it right now but I'll try to have a look at it. Do you know of any article that explains this technique, starting from very simple examples?

Not really. It's a result of thinking about lazy evaluation, and especially lazy patterns (and let bindings) for some time. A wiki article that helped me a lot to understand these is http://www.haskell.org/hawiki/TyingTheKnot I'd like to point out the trustList function there which uses the idea of encoding the structure of a term and its actual values in different arguments, i.e. a blueprint. HTH, Bertram

On Thu, Sep 14, 2006 at 07:51:59PM +0200, Bertram Felgenhauer wrote:

It's a result of thinking about lazy evaluation, and especially lazy patterns (and let bindings) for some time. A wiki article that helped me a lot to understand these is

http://www.haskell.org/hawiki/TyingTheKnot

I'd like to point out the trustList function there which uses the idea of encoding the structure of a term and its actual values in different arguments, i.e. a blueprint.

One view of your device is as separating the shape (blueprint) from the contents, e.g. one can split a finite map type data Map k a = Node !Int k a (Map k a) (Map k a) | Leaf into a pair of types data MapShape k = SNode !Int k (MapShape k) (MapShape k) | SLeaf data MapData a = DNode a (MapData a) (MapData a) | DLeaf (We don't even need DLeaf, as it's never examined.) We need functions fill :: a -> MapShape k -> MapData a update :: Ord k => k -> (a -> a) -> MapShape k -> MapData a -> MapData a insert :: Ord k => k -> MapShape k -> (MapShape k, MapData a -> (a, MapData a)) In a dependently typed language we could parameterize MapData with shapes to give more precise types: fill :: a -> forall s :: MapShape k. MapData s a update :: Ord k => k -> (a -> a) -> forall s :: MapShape k. MapData s a -> MapData s a insert :: Ord k => k -> forall s :: MapShape k. (exists s' :: MapShape k, MapData s' a -> (a, MapData s a)) hinting that the function returned by insert reverses the effect of the insertion. It's not possible to code this with GADTs, because existentials are incompatible with irrefutable patterns, at least in GHC. Anyway, splitSeq then becomes splitSeq :: Ord a => [(a,b)] -> [(a,[b])] splitSeq = fst . splitSeq' SLeaf splitSeq' :: Ord a => MapShape a -> [(a,b)] -> ([(a,[b])], MapData [b]) splitSeq' bp [] = ([], fill [] bp) splitSeq' bp ((a,b):xs) | member a bp = let (l, m) = splitSeq' bp xs in (l, update a (b:) bp m) | otherwise = let (bp', extract) = insert a bp (l, m') = splitSeq' bp' xs (bs, m) = extract m' in ((a, b:bs) : l, m) Again, no knot-tying is required. To prove that (even for partial and infinite lists ps) splitSeq ps = [(a, seconds a ps) | a <- nub ps] where seconds :: Eq a => a -> [(a,b)] -> [b] seconds a ps = [b | (a', b) <- ps, a' == a] we need another function get :: Ord k => k -> MapShape k -> MapData a -> a and the properties member k s => get k s (fill v s) = v member k s => get k s (update k f s m) = f (get k s m) member k s /\ member x s /\ x /= k => get x s (update k f s m) = get x s m not (member k s) /\ insert k s = (s', extract) => member x s' = member x s || x == k not (member k s) /\ insert k s = (s', extract) => fst (extract m) = get k s' m not (member k s) /\ insert k s = (s', extract) /\ member x s => get x s (snd (extract m)) = get x s' m Then we can establish, by induction on the input list, (1) fst (splitSeq' s ps) = [(a, seconds a ps) | a <- nub ps, not (member a s)] (2) member x s => get x s (snd (splitSeq' s ps)) = seconds x ps This is enough to sustain the induction and obtain the desired property, but it's a bit inelegant not to have an exact characterization of the second component. It seems essential to observe the map data only though get.

On Mon, Sep 18, 2006 at 12:23:11AM +0100, Ross Paterson wrote:

To prove that (even for partial and infinite lists ps)

splitSeq ps = [(a, seconds a ps) | a <- nub ps]

[...] we can establish, by induction on the input list,

(1) fst (splitSeq' s ps) = [(a, seconds a ps) | a <- nub ps, not (member a s)] (2) member x s => get x s (snd (splitSeq' s ps)) = seconds x ps

Oops, nub ps should be nub (map fst ps) in each case.

apfelmus@quantentunnel.de wrote:

type BiMap a b = (Map.Map a b, Map.Map b a)

Actually BiMap is not needed at all, it suffices to have

splitStreams :: Ord a => [(a,b)] -> [(a,[b])] splitStreams xs = takeWhile (not . null . snd) $ toList $ splitStreams' Map.empty xs

splitStreams' :: Ord a => Map.Map a Position -> [(a,b)] -> Imp (a,[b]) splitStreams' map [] = fmap (const (undefined,[])) $ fromList [1..] splitStreams' map ((a,b):xs) = update fun pos $ splitStreams' map' xs where fun ~(_,bs) = (a,b:bs) sz = Map.size map pos = Map.findWithDefault (sz+1) a map map' = (if Map.member a map then id else Map.insert a (sz+1)) map

Regards, apfelmus

Ross Paterson wrote:

On Thu, Sep 14, 2006 at 05:22:05PM +0200, Bertram Felgenhauer wrote:

...

[much subtle code] We can now build the splitStream function, using the following helper function:

...

splitSeq' :: Ord a => Map a () -> [(a,b)] -> ([(a,[b])], Map a [b])

This works for infinite lists if there is no balancing, but if insert does balancing, the top of the map will not be available until the last key is seen, so splitSeq' could only be used for finite chunks. Then you'll need a way to put the partial answers together.

Just to prove the point, here's the same code with balancing:

...

...

SNIP HERE (end marked with <<<) >>>

module SplitSeq (splitSeq) where import Prelude hiding (lookup, map) -- our map data Map k a = Node !Int k a (Map k a) (Map k a) | Leaf deriving Show size :: Map k a -> Int size Leaf = 0 size (Node s _ _ _ _) = s member :: Ord k => k -> Map k a -> Bool member _ Leaf = False member k (Node _ k' _ l r) = case compare k k' of LT -> member k l EQ -> True GT -> member k r -- insert key into blueprint and extract the corresponding value from -- the second argument, threading it backward through all operations insert :: Ord k => k -> Map k () -> Map k a -> (Map k (), a, Map k a) insert k Leaf ~(Node _ _ a _ _) = (Node 1 k () Leaf Leaf, a, Leaf) insert k (Node s k' _ l r) node = case compare k k' of LT -> let (m, a, l'') = insert k l l' (m', a', l', r') = balance k' m r node in (m', a, Node s k' a' l'' r') EQ -> error "inserting existing element" GT -> let (m, a, r'') = insert k r r' (m', a', l', r') = balance k' l m node in (m', a, Node s k' a' l' r'') -- balance and co are taken from Data.Map and adapted balance k l r node | size l + size r <= 1 = let Node _ _ a l' r' = node in (mkNode k () l r, a, l', r') | size r >= 5 * size l = rotateL k l r node | size l >= 5 * size r = rotateR k l r node | otherwise = let Node _ _ a l' r' = node in (mkNode k () l r, a, l', r') rotateL k l r@(Node _ _ _ l' r') node | size l' < 2*size r' = singleL k l r node | otherwise = doubleL k l r node rotateR k l@(Node _ _ _ l' r') r node | size r' < 2*size l' = singleR k l r node | otherwise = doubleR k l r node singleL k l (Node s k' _ m r) ~(Node _ _ a ~(Node _ _ a' l' m') r') = (mkNode k' () (mkNode k () l m) r, a', l', Node s k' a m' r') singleR k (Node s k' _ l m) r ~(Node _ _ a l' ~(Node _ _ a' m' r')) = (mkNode k' () l (mkNode k () m r), a', Node s k' a l' m', r') doubleL k l (Node s k' _ (Node s' k'' _ ml mr) r) ~(Node _ _ a ~(Node _ _ a' l' ml') ~(Node _ _ a'' mr' r')) = (mkNode k'' () (mkNode k () l ml) (mkNode k' () mr r), a', l', Node s k' a'' (Node s' k'' a ml' mr') r') doubleR k (Node s k' _ l (Node s' k'' _ ml mr)) r ~(Node _ _ a ~(Node _ _ a' l' ml') ~(Node _ _ a'' mr' r')) = (mkNode k'' () (mkNode k' () l ml) (mkNode k () mr r), a'', Node s k' a' l' (Node s' k'' a ml' mr'), r') -- make a new node with the correct size mkNode k x l r = Node (size l + size r + 1) k x l r -- update the element associated with the given key update :: Ord k => k -> (a -> a) -> Map k x -> Map k a -> Map k a update k f (Node s k' _ l r) ~(Node _ _ a' l' r') = case compare k k' of LT -> Node s k' a' (update k f l l') r' EQ -> Node s k' (f a') l' r' GT -> Node s k' a' l' (update k f r r') -- standard map function, no blueprints here map :: (a -> b) -> Map k a -> Map k b map _ Leaf = Leaf map f (Node s k a l r) = Node s k (f a) (map f l) (map f r) -- finally, define splitSeq splitSeq :: Ord a => [(a,b)] -> [(a,[b])] splitSeq = fst . splitSeq' Leaf splitSeq' :: Ord a => Map a () -> [(a,b)] -> ([(a,[b])], Map a [b]) splitSeq' bp [] = ([], map (const []) bp) splitSeq' bp ((a,b):xs) = case member a bp of True -> let (l, m) = splitSeq' bp xs in (l, update a (b:) bp m) False -> let (bp', a', m) = insert a bp m' (l, m') = splitSeq' bp' xs in ((a, b : a') : l, m) <<< The balancing code is adopted from Data.Map. I added threading back the result map (from splitSeq) to the balancing operations. This results in the promised O(n*log m) time. The cost associated with a lazy pattern (it creates a closure for each bound variable, IIRC) is quite high but constant, so each call to insert takes O(log m) time, including future forces of the lazy patterns. Likewise, member and update are also O(log m). Example test: Prelude SplitSeq> print $ take 11 $ snd $ splitSeq ([(n `mod` 10000, 'a') | n <- [1..100000]] ++ [(n, 'b') | n <- [0..]]) !! 9534 "aaaaaaaaaab" (1.07 secs, 137026252 bytes) The nonbalancing version would take ages. regards, Bertram

Ross Paterson wrote:

How embarrassing. Still, your code is quite subtle. As penance, here's my explanation, separating the main idea from the knot-tying.

The ingredients are a map type with an insertion function [...] insert :: Ord k => k -> a -> Map k a -> Map k a

with a partial inverse

uninsert :: Ord k => k -> Map k () -> Map k a -> (a, Map k a)

[...] Applying a tupling transformation to insert+uninsert gives your version.

It's interesting that these composed transformations don't seem to cost too much.

That the composed transformations are indeed cheap is not necessarily disturbing. Let's call Bertram's original insert version "insertdelete" from now on. When analyzing the magic behind, you do ross_analysis :: ((bp,map') -> (bp',map)) -> (bp->bp', (bp,map') -> map) ross_analysis insertdelete = (insert, uninsert) Of course a tupling transformation will reverse this tupletiple :: (bp->bp', (bp,map') -> map) -> ((bp,map') -> (bp',map)) tupletiple (insert,uninsert) = insertdelete But as @djinn will tell you, "ross_analysis cannot be realized" :) So the original version possesses additional computational power, it can reverse everything it's doing with bp on the map'. uninsert does not have information about the single steps that have been done, it only knows what should come out. From that, it would have to reconstruct quickly what happened, if it wants to be fast. Regards, apfelmus

Ross Paterson wrote:

On Sun, Sep 17, 2006 at 01:08:04PM +0200, apfelmus@quantentunnel.de wrote:

...

Ross Paterson wrote:

...

It's interesting that these composed transformations don't seem to cost too much. That the composed transformations are indeed cheap is not necessarily disturbing.

I meant the composition of the transformations of the tree (update or reverse insert) that Bertram does for each list element. They're cheap because they're bounded by the depth of the tree, and even cheaper if you're probing some other part of the tree.

Me too :) I tried to point out that separating uninsert from in insert increases time complexity. In general uninsert :: Ord k => k -> Map k () -> Map k a -> (a, Map k a) fst $ uninsert _ bp m == differenceWith (curry snd) bp m with needs O(size of blueprint) time. This is to be compared with O(log (size of blueprint)) for the combined insertdelete. That there (likely) must be such a difference can already be seen from the types of insertdelete and (insert,uninsert) ! But you already pointed out that something like insertdelete :: Ord k => k -> Map shape k -> (exists shape' . (Map shape' k, Map shape' a -> (a, Map shape a)) is the best type for insertdelete. Here, it is clear that insertdelete likely can do a fast uninsert. Btw, why are there no irrefutable patterns for GADTs? I mean, such a sin should be shame for a non-strict language... Regards, apfelmus

Hi folks apfelmus@quantentunnel.de wrote:

Btw, why are there no irrefutable patterns for GADTs? I mean, such a sin should be shame for a non-strict language...

Just imagine

data Eq a b where Refl :: Eq a a

coerce :: Eq a b -> a -> b coerce ~Refl a = b

coerce undefined True :: String Bang you're dead. Or rather... Twiddle you're dead. Moral: in a non-total language, if you're using indexing to act as evidence for something, you need to be strict about checking the evidence before you act on it, or you will be vulnerable to the blandishments of the most appalling liars. As Randy Pollack used to say to us when we were children, the best thing about working in a strongly normalizing language is not having to normalize things. All the best Conor This message has been checked for viruses but the contents of an attachment may still contain software viruses, which could damage your computer system: you are advised to perform your own checks. Email communications with the University of Nottingham may be monitored as permitted by UK legislation.

Robert Dockins wrote:

On Sep 19, 2006, at 8:52 AM, Conor McBride wrote:

...

Hi folks

apfelmus@quantentunnel.de wrote:

...

Btw, why are there no irrefutable patterns for GADTs? I mean, such a sin should be shame for a non-strict language...

Just imagine

...

data Eq a b where Refl :: Eq a a

...

coerce :: Eq a b -> a -> b coerce ~Refl a = b

I think you mean:

...

coerce ~Refl x = x

Indeed I do. My original program was much safer! Thanks Conor This message has been checked for viruses but the contents of an attachment may still contain software viruses, which could damage your computer system: you are advised to perform your own checks. Email communications with the University of Nottingham may be monitored as permitted by UK legislation.

On Tue, Sep 19, 2006 at 08:06:07PM +0200, apfelmus@quantentunnel.de wrote:

For our optimization problem, it's only a matter of constructors on the right hand side. They should pop out before do not look on any arguments, so it's safe to cry "so you just know, i'm a Just".

It seems the appropriate encoding would be for the shape to be an inductive datatype and the contents (as well as the lists) to be coinductive, as access to the contents is gated through the shape.

| Does anything go wrong with irrefutable patterns for existential types? Try giving the translation into System F. Simon

On Thu, Sep 28, 2006 at 03:22:25PM +0100, Simon Peyton-Jones wrote:

| Does anything go wrong with irrefutable patterns for existential types?

Try giving the translation into System F.

I'm a bit puzzled about this. A declaration data Foo = forall a. MkFoo a (a -> Bool) is equivalent to newtype Foo = forall a. Foo (Foo' a) data Foo' a = MkFoo a (a -> Bool) except that you also don't allow existentials with newtypes, for similarly unclear reasons. If you did allow them, you'd certainly allow this equivalent of the original irrefutable match: ... case x of Foo y -> let MkFoo val fn = y in fn val So, is there some real issue with existentials and non-termination?

On Fri, Sep 29, 2006 at 11:19:26AM +0100, Simon Peyton-Jones wrote:

I must be missing your point. Newtype is just type isomorphism; a new name for an existing type. But there is not existing type "exists x. T(x)". So it's not surprising that newtype doesn't support existentials.

And yet newtype does support recursion.

I've lost track of this thread.

The story so far: apfelmus: why are there no irrefutable patterns for GADTs? Conor: because you could use them to write unsafeCoerce Ross: how about irrefutable patterns (or newtypes) for existential types? Simon: Try giving the translation into System F + (existential) data types Copying a notion of datatype from Haskell to Core and then asking for a translation to that seems to be begging the question. If your target really was System F, you could use the standard encoding of existentials as nested foralls, but there's the problem that Haskell function spaces differ from System F ones, System F is strongly normalizing, etc.