[Haskell-beginners] expressing constraints 101
Dimitri DeFigueiredo
defigueiredo at ucdavis.edu
Wed Aug 13 19:16:08 UTC 2014
Thanks guys. It seems like type families are the way to go, but I am
surprised that there is no way to express this in standard Haskell.
On a follow up note, will GADTs bring this into the main language? I
seem to remember a talk by Simon PJ on how to build data structures
whose representation depend on the types of their elements by using
GADTs. Thinking about it now, it seems that's what I want here. If the
elements are Ord-ered I can implement Set with a Tree, on the other
hand, if they are only Eq and Hashable, I can use a hash table to
implement Set.
Dimitri
Em 13/08/14 01:23, akash g escreveu:
> Hi Dimitri,
>
> Did a bit of research and found type families to be a good fit for
> this
> (http://www.haskell.org/ghc/docs/latest/html/users_guide/type-families.html).
> Type families lets us define the contraints (and a lot of other
> things) when creating an instance. I still do not know if this is the
> ideal solution, but it is still a lot better than the previous
> solution that I posted.
>
> {-# LANGUAGE ConstraintKinds #-}
> {-# LANGUAGE TypeFamilies #-}
> import GHC.Exts
>
> class Set s where
> type C s a :: Constraint -- Here, the explicit type that we would
> have given is turned into a type synonym of the kind Constraint, from
> GHC.Exts.
> empty :: s a
> insert :: (C s a) => a -> s a -> s a
> member :: (C s a) => a -> s a -> Bool
>
>
> data Tree a = Empty | MkTree (Tree a) a (Tree a)
>
> treeEmpty :: Tree a
> treeEmpty = Empty
>
> treeInsert :: Ord a => a -> Tree a -> Tree a
> treeInsert = undefined
>
> treeMember :: Ord a => a -> Tree a -> Bool
> treeMember = undefined
>
> instance Set Tree where
> type C Tree a = Ord a -- Here, we are setting the type constraint to
> Ord a, where a is again a type variable.
> empty = treeEmpty
> member = treeMember
> insert = treeInsert
>
>
> - Akash G
>
>
>
>
>
> On Wed, Aug 13, 2014 at 11:41 AM, Dimitri DeFigueiredo
> <defigueiredo at ucdavis.edu <mailto:defigueiredo at ucdavis.edu>> wrote:
>
> Hi G Akash,
>
> Is that the only solution? I thought about that. The problem with
> it is that it changes the Set type class. I want the Set type
> class to be able to contain elements of any type, not just members
> of Ord.
>
> I think the type class represents a "Set" interface that is
> general. It is the implementation using trees that is only
> available for Ordered types. And there may be other
> implementations that don't need this constraint. So, if possible,
> I don't want to change the Set type class. Isn't there another way
> to fix it?
>
>
> Thanks,
>
>
> Dimitri
>
>
> Em 12/08/14 23:18, akash g escreveu:
>> Hi Dimitri,
>>
>> You can express the constraints as below
>>
>> class Set s where
>> empty :: s a -- returns an empty set of type Set
>> of a
>> insert :: (Ord a) => a -> s a -> s a -- returns set with new
>> element inserted
>> member :: (Ord a) => a -> s a -> Bool -- True if element is a
>> member of the Set
>>
>> This is because when you define tree as an instance of the
>> typeclass 'Set', you don't match the constraints on the functions
>> that the functions that it wants you to implement That is, when
>> you do:
>>
>>
>> treeInsert :: Ord a => a -> Tree a -> Tree a
>> treeInsert = undefined
>>
>> instance Set Tree where
>> empty = treeEmpty
>> insert = treeInsert
>> member = treeMember
>>
>> The type signature doesn't match when you do insert=treeInsert or
>> member=treeMember, since you have
>>
>> class Set s where
>> insert :: a -> s a -> s a
>>
>> Hope this helps
>>
>> - G Akash
>>
>>
>>
>> On Wed, Aug 13, 2014 at 8:44 AM, Dimitri DeFigueiredo
>> <defigueiredo at ucdavis.edu <mailto:defigueiredo at ucdavis.edu>> wrote:
>>
>> Hi All,
>>
>> I am working through an exercise in Chris Okasaki's book
>> (#2.2). In the book, he is trying to implement a minimal
>> interface for a Set. I wrote that simple interface in Haskell as:
>>
>> class Set s where
>> empty :: s a -- returns an empty set of
>> type Set of a
>> insert :: a -> s a -> s a -- returns set with new
>> element inserted
>> member :: a -> s a -> Bool -- True if element is a
>> member of the Set
>>
>> To implement that interface with the appropriately O(log n)
>> insert and member functions he suggests the use of a Binary
>> Search Tree, which I translated to Haskell as:
>>
>> data Tree a = Empty | MkTree (Tree a) a (Tree a)
>>
>> But for the tree to work, we also need the "a"s to be totally
>> ordered. I.e. (Ord a) is a constraint. So, it makes sense to
>> write:
>>
>> treeEmpty :: Tree a
>> treeEmpty = Empty
>>
>> treeInsert :: Ord a => a -> Tree a -> Tree a
>> treeInsert = undefined
>>
>> treeMember :: Ord a => a -> Tree a -> Bool
>> treeMember = undefined
>>
>> Now, I would like to bind this implementation using Trees of
>> an ordered type "a" to the set type class. So, I would like
>> to write something like:
>>
>> instance Set Tree where
>> empty = treeEmpty
>> insert = treeInsert
>> member = treeMember
>>
>> But that doesn't work. Using GHC 7.6.3, I get a:
>>
>> No instance for (Ord a) arising from a use of `treeInsert'
>> Possible fix:
>> add (Ord a) to the context of
>> the type signature for insert :: a -> Tree a -> Tree a
>> In the expression: treeInsert a
>> In an equation for `insert': insert a = treeInsert a
>> In the instance declaration for `Set Tree'
>>
>> Which makes sense, but I'm not sure how to express this
>> constraint.
>> So, what is the proper way to do this?
>> Where have I gone wrong?
>>
>>
>> Thanks!
>>
>> Dimitri
>>
>>
>>
>>
>>
>>
>> _______________________________________________
>> Beginners mailing list
>> Beginners at haskell.org <mailto:Beginners at haskell.org>
>> http://www.haskell.org/mailman/listinfo/beginners
>>
>>
>>
>>
>> _______________________________________________
>> Beginners mailing list
>> Beginners at haskell.org <mailto:Beginners at haskell.org>
>> http://www.haskell.org/mailman/listinfo/beginners
>
>
> _______________________________________________
> Beginners mailing list
> Beginners at haskell.org <mailto:Beginners at haskell.org>
> http://www.haskell.org/mailman/listinfo/beginners
>
>
>
>
> _______________________________________________
> Beginners mailing list
> Beginners at haskell.org
> http://www.haskell.org/mailman/listinfo/beginners
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/beginners/attachments/20140813/4adb3324/attachment-0001.html>
More information about the Beginners
mailing list