[Haskell-cafe] Data.Ord and Heaps (Was: Why functional programming
matters)
apfelmus at quantentunnel.de
apfelmus at quantentunnel.de
Fri Feb 1 06:13:04 EST 2008
Stephan Friedrichs wrote:
> apfelmus wrote:
>> [...]
>> Feedback: I think the HeapPolicy thing is too non-standard. The =20
>> canonical way would be to use a MinHeap and let the Ord instance =20
>> handle everything. A MaxHeap can then be obtained via a different =20
>> Ord instance
>> newtype Ord a =3D> Reverse a =3D Reverse { unReverse :: a }
>> instance Ord a =3D> Ord (Reverse a) where
>> compare =3D comparing unReverse
>> This newtype should be in Data.Ord, of course. Being
>
> This solution should be used for all collections depending on Ord =20
> instances, including Data.Map, Data.Set and others. As long as I =20
> only include it in my tiny heap package, it is as 'non-standard' as =20=
> my approach, isn't it?
Yes. I mean "non-standard" in the software-reuse sense, i.e. Ord is =20
for user-defined orderings and should be the only such mechanism in =20
order to enable reuse. In fact, Data.Heap clearly shows that Data.Ord =20=
is currently missing functionality.
>> Simply setting
>> type MaxHeap a =3D MinHeap (Reverse a)
>> is inferior to a "native" MaxHeap since we'd have to pack/unpack =20
>> the Reverse all the time. But a type class for heaps - which =20
>> should be present anyway - can solve that problem:
>> class Heap h where
>> [...]
>> instance Heap MinHeap where ...
>> newtype MaxHeap a =3D M (MinHeap (Reverse a))
>> instance Heap MaxHeap where ...
>
> I've actually thought about this. Realising MinHeap and MaxHeap is =20
> no problem, but I decided against it, because implementing a custom =20=
> order becomes quite complicated: You have to declare an
>
> newtype MyHeap a =3D ...
>
> instance Heap MyHeap where
> -- about 10 functions
>
> instead of just
>
> data PriorityPolicy
>
> instance HeapPolicy PP MyPriorityType where
> heapCompare =3D const (comparing priority)
Note that the Heap class contains only three primitive operations =20
(empty, insert, viewHead), all the others have default =20
implementations in terms of those three. There is even an =20
underappreciated unfold among them :)
toAscList =3D unfoldr viewHead
The structure becomes especially clear by noting that any Heap is =20
defined by just two primitives
inject :: Ord a =3D> Maybe (a, Heap a) -> Heap a
view :: Ord a =3D> Heap a -> Maybe (a, Heap a)
We have inject =3D maybe empty (uncurry insert) . This is just like =20=
lists, except that view . inject =AD id since view returns the =20
smallest element.
However, just that we managed to reduce the number of primitive =20
operations doesn't mean that the policy approach isn't preferable. It =20=
needs 0 primitive operations, after all. But as foreshadowed in my =20
reply, it's possible to do policies within Ord. Don't stop thinking =20
about your good idea just because you can start coding :)
Here's one way to do it:
module Data.Ord where
...
class (Ord p a) =3D> OrdPolicy p a where -- the policy p is a =20=
type constructor
to :: a -> p a
from :: p a -> a
instance OrdPolicy Identity a where ...
newtype Reverse a =3D Reverse a
instance Ord a =3D> Reverse a where
compare =3D flip $ comparing from
instance OrdPolicy Reverse a where
to =3D Reverse; from (Reverse x) =3D x
module Data.Heap where
...
newtype Heap p a =3D Heap (MinHeap (p a))
type MaxHeap a =3D Heap Reverse a
class Ord a =3D> Heap h a | h -> a where
empty :: h
insert :: a -> h -> h
viewHead :: h -> Maybe (a, h)
instance OrdPolicy p a =3D> Heap (Heap p a) a where
...
What I don't like about this is that the policy is not polymorphic in =20=
the element types, forcing the Heap class to be multi-parameter. I'd =20
really like to write
class (forall a . Ord p a) =3D> OrdPolicy p where
but I guess that's (currently) not possible. The original "phantom =20
policy" approach can't quite do this either:
module Data.Ord where
...
newtype OrdBy p a =3D OrdBy { unOrdBy :: a }
data Reverse
instance Ord a =3D> Ord (OrdBy Reverse a) where
compare =3D flip $ comparing unOrdBy
module Data.Heap where
...
newtype Heap p a =3D Heap (MinHeap (OrdBy p a))
type MaxHeap a =3D Heap Reverse a
class Heap h where
empty :: Ord a =3D> h a
insert :: Ord a =3D> a -> h a -> h a
viewHead :: Ord a =3D> h a -> Maybe (a, h a)
instance (Ord (OrdBy p a)) =3D> Heap (Heap p) where -- forall a?
...
However, a distinct advantage of using OrdBy for all ordering =20
policies is that the from and to functions are no longer =20
necessary. All ordering policies use the same type OrdBy which =20
automatically guarantees that from and to are inverse to each =20
other. This would be an informal requirement otherwise, so I think =20
that phantom policies are clearly superior to type constructor =20
policies. Fortunately, this is orthogonal to making Heap a multi-=20
parameter type class and ensuring that OrdBy p a instances are =20
polymorphic in a .
>> In conclusion: the ordering policy stuff should not be part of =20
>> Data.Heap, this is a job for Data.Ord.
> As mentioned above: This sounds really useful. How about you =20
> propose this to the base-package maintainers? :)
What, me? :D
Regards,
apfelmus
More information about the Haskell-Cafe
mailing list