Re: [Haskell-cafe] ANN: unfoldable-0.4.0

2012-04-29 Thread wren ng thornton

On 4/28/12 12:10 PM, Sjoerd Visscher wrote:

But I don't think an unfoldable class for * types is that interesting. Any type 
that would be an instance could also be in instance of Bounded and Enum:


In a technical sense, yes, but not necessarily in a semantic sense. 
Usually Bounded and Enum are expected to respect the natural ordering on 
the type; and, given Eq, they induce an ordering on the type (albeit an 
inefficient one). But there are plenty of cases where you don't have a 
natural ordering, or where it would be more efficient to enumerate 
values in an unnatural order if the goal is just to get them all. 
Unfortunately, we don't have a good way of distinguishing between 
natural vs ad-hoc enumerations/orderings, so this sort of thing gets 
handled poorly on case-by-case bases.


Though I agree that Biunfoldable is a lot more interesting than Unfoldable0.

--
Live well,
~wren

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


Re: [Haskell-cafe] ANN: unfoldable-0.4.0

2012-04-28 Thread Sjoerd Visscher

On Apr 28, 2012, at 2:40 AM, wren ng thornton wrote:

 On 4/26/12 3:52 PM, Roman Cheplyaka wrote:
 * Tillmann Rendelren...@informatik.uni-marburg.de  [2012-04-26 
 21:34:21+0200]
 Hi,
 
 Sjoerd Visscher wrote:
 Just as there's a Foldable class, there should also be an Unfoldable 
 class. This package provides one:
 
   class Unfoldable t where
 unfold :: Unfolder f =   f a -   f (t a)
 
 Just to be sure: That's not a generalization of Data.List.unfoldr, or
 is it somehow?
 
 It seems to be -- see
 https://github.com/sjoerdvisscher/unfoldable/blob/master/src/Data/Unfoldable.hs#L84
 
 (although that is much more complicated than Data.List.unfoldr)
 
 I must admit I'm a bit weirded out by the (Bounded a, Enum a) restriction on 
 the Either, tuple, and Constant instances. Why not just use Unfoldable a, or 
 have a class specifically devoted to unfolding * types?


I don't like the (Bounded a, Enum a) restrictions very much either. That was 
basically a quick hack in the first version and I haven't given it much thought 
after that.

The most generic solution would be Biunfoldable I think.

class Biunfoldable t where
  biunfold :: Unfolder f = f a - f b - f (t a b)

instance Biunfoldable (,) where
  biunfold fa fb = choose [(,) $ fa * fb]
instance Biunfoldable Either where
  biunfold fa fb = choose [Left $ fa, Right $ fb]
instance Biunfoldable Constant where
  biunfold fa _ = choose [Constant $ fa]

But I don't think an unfoldable class for * types is that interesting. Any type 
that would be an instance could also be in instance of Bounded and Enum:

class Unfoldable0 a where
  unfold0 :: Unfolder f = f a

minBoundDef :: Unfoldable0 a = a
minBoundDef = fromJust unfold0

maxBoundDef :: Unfoldable0 a = a
maxBoundDef = fromJust (getDualA unfold0)

toEnumDef :: Unfoldable0 a = Int - a
toEnumDef i = unfold0 !! i

fromEnumDef :: (Unfoldable0 a, Eq a) = a - Int
fromEnumDef a = fromJust (elemIndex a unfold0)

so having boundedEnum is good enough I think.
--
Sjoerd Visscher
https://github.com/sjoerdvisscher/blog






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


Re: [Haskell-cafe] ANN: unfoldable-0.4.0

2012-04-27 Thread wren ng thornton

On 4/26/12 3:52 PM, Roman Cheplyaka wrote:

* Tillmann Rendelren...@informatik.uni-marburg.de  [2012-04-26 21:34:21+0200]

Hi,

Sjoerd Visscher wrote:

Just as there's a Foldable class, there should also be an Unfoldable class. 
This package provides one:

   class Unfoldable t where
 unfold :: Unfolder f =   f a -   f (t a)


Just to be sure: That's not a generalization of Data.List.unfoldr, or
is it somehow?


It seems to be -- see
https://github.com/sjoerdvisscher/unfoldable/blob/master/src/Data/Unfoldable.hs#L84

(although that is much more complicated than Data.List.unfoldr)


I must admit I'm a bit weirded out by the (Bounded a, Enum a) 
restriction on the Either, tuple, and Constant instances. Why not just 
use Unfoldable a, or have a class specifically devoted to unfolding * types?


--
Live well,
~wren

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


Re: [Haskell-cafe] ANN: unfoldable-0.4.0

2012-04-26 Thread Roman Cheplyaka
This is also quite similar to what we have in SmallCheck:
https://github.com/feuerbach/smallcheck/blob/master/Test/SmallCheck/Series.hs

Not sure how to exploit this, though.

* Sjoerd Visscher sjo...@w3future.com [2012-04-26 00:32:28+0200]
 I am pleased to announce the 5th version of the unfoldable package. (This is 
 the first announcement, you didn't miss anything.)
 http://hackage.haskell.org/package/unfoldable-0.4.0
 
 Just as there's a Foldable class, there should also be an Unfoldable class. 
 This package provides one:
 
   class Unfoldable t where
 unfold :: Unfolder f = f a - f (t a)
 
 Writing instances of Unfoldable is similar to writing Traversable instances. 
 For example, given a data type
 
   data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a)
 
 a suitable instance would be
 
   instance Unfoldable Tree where
 unfold fa = choose
   [ pure Empty
   , Leaf $ fa
   , Node $ unfold fa * fa * unfold fa
   ]
 
 The choose function comes from the Unfolder class:
 
   class Applicative f = Unfolder f where
 choose :: [f x] - f x
 
 (If f is an Alternative instance, choose is simply Data.Foldable.asum.)
 
 Different unfolders provide different ways of generating values, for example:
  - Random values
  - Enumeration of all values (depth-first or breadth-first)
  - Convert from a list
  - An implementation of QuickCheck's arbitrary should also be possible (still 
 working on that)
 
 Some examples can be found in the examples directory in the github repo:
 https://github.com/sjoerdvisscher/unfoldable
 
 Ideas and comments are welcome!
 
 greetings,
 Sjoerd

-- 
Roman I. Cheplyaka :: http://ro-che.info/

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


Re: [Haskell-cafe] ANN: unfoldable-0.4.0

2012-04-26 Thread Tillmann Rendel

Hi,

Sjoerd Visscher wrote:

Just as there's a Foldable class, there should also be an Unfoldable class. 
This package provides one:

   class Unfoldable t where
 unfold :: Unfolder f =  f a -  f (t a)


Just to be sure: That's not a generalization of Data.List.unfoldr, or is 
it somehow?



Different unfolders provide different ways of generating values, for example:
  - Random values
  - Enumeration of all values (depth-first or breadth-first)
  - Convert from a list
  - An implementation of QuickCheck's arbitrary should also be possible (still 
working on that)


Can this be extended to provide a single API that allows testing à la 
SmallCheck, LazySmallCheck and/or QuickCheck without duplicating 
properties or instances?


  Tillmann

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


Re: [Haskell-cafe] ANN: unfoldable-0.4.0

2012-04-26 Thread Roman Cheplyaka
* Tillmann Rendel ren...@informatik.uni-marburg.de [2012-04-26 21:34:21+0200]
 Hi,
 
 Sjoerd Visscher wrote:
 Just as there's a Foldable class, there should also be an Unfoldable class. 
 This package provides one:
 
class Unfoldable t where
  unfold :: Unfolder f =  f a -  f (t a)
 
 Just to be sure: That's not a generalization of Data.List.unfoldr, or
 is it somehow?

It seems to be -- see
https://github.com/sjoerdvisscher/unfoldable/blob/master/src/Data/Unfoldable.hs#L84

(although that is much more complicated than Data.List.unfoldr)

-- 
Roman I. Cheplyaka :: http://ro-che.info/

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


Re: [Haskell-cafe] ANN: unfoldable-0.4.0

2012-04-26 Thread Sjoerd Visscher

On Apr 26, 2012, at 9:34 PM, Tillmann Rendel wrote:
 
   class Unfoldable t where
 unfold :: Unfolder f =  f a -  f (t a)
 
 Just to be sure: That's not a generalization of Data.List.unfoldr, or is it 
 somehow?

Yes, it is. unfoldr is quite specifically tailored to lists, so it doesn't work 
well generically. I did include it in the package, but it does a breadth-first 
search for the first value that has exactly enough positions to store the 
elements ('a's), and there might not be one.

 
 Different unfolders provide different ways of generating values, for example:
  - Random values
  - Enumeration of all values (depth-first or breadth-first)
  - Convert from a list
  - An implementation of QuickCheck's arbitrary should also be possible 
 (still working on that)
 
 Can this be extended to provide a single API that allows testing à la 
 SmallCheck, LazySmallCheck and/or QuickCheck without duplicating properties 
 or instances?


Well, the idea is to unify all ways of unfolding (i.e. all ways of generating 
values). So those parts of the checkers could use the same API, but there's a 
lot more to checking than that.

By the way, I uploaded 0.5.0 a few hours ago, which contains a generic 
arbitrary implementation.

greetings,
--
Sjoerd Visscher
https://github.com/sjoerdvisscher/blog






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


[Haskell-cafe] ANN: unfoldable-0.4.0

2012-04-25 Thread Sjoerd Visscher
I am pleased to announce the 5th version of the unfoldable package. (This is 
the first announcement, you didn't miss anything.)
http://hackage.haskell.org/package/unfoldable-0.4.0

Just as there's a Foldable class, there should also be an Unfoldable class. 
This package provides one:

  class Unfoldable t where
unfold :: Unfolder f = f a - f (t a)

Writing instances of Unfoldable is similar to writing Traversable instances. 
For example, given a data type

  data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a)

a suitable instance would be

  instance Unfoldable Tree where
unfold fa = choose
  [ pure Empty
  , Leaf $ fa
  , Node $ unfold fa * fa * unfold fa
  ]

The choose function comes from the Unfolder class:

  class Applicative f = Unfolder f where
choose :: [f x] - f x

(If f is an Alternative instance, choose is simply Data.Foldable.asum.)

Different unfolders provide different ways of generating values, for example:
 - Random values
 - Enumeration of all values (depth-first or breadth-first)
 - Convert from a list
 - An implementation of QuickCheck's arbitrary should also be possible (still 
working on that)

Some examples can be found in the examples directory in the github repo:
https://github.com/sjoerdvisscher/unfoldable

Ideas and comments are welcome!

greetings,
Sjoerd
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe