Prelude function suggestions

Henning Thielemann iakd0 at clusterf.urz.uni-halle.de
Thu Jul 29 12:29:52 EDT 2004


On Thu, 29 Jul 2004, ariep wrote:

>
> > {- | Compositional power of a function,
> >      i.e. apply the function n times to a value. -}
> > nest :: Int -> (a -> a) -> a -> a
> > nest 0 f x = x
> > nest n f x = f (nest (n-1) f x)
> 
> nest n f x = iterate f x !! n
> 
> That might render 'nest' somewhat superfluous.

What about:

 nest n f = foldl (.) id (replicate n f)

:-)

I'm aware of such transcriptions, but most commonly I use the partial
application (nest n f) which can't be provided by them.  If 'nest' (or
maybe renamed to 'compPower') will be added, anyway, I think it should go
where (.) is defined. 

> > {- | Split the list at the occurrences of a separator into sub-list.
> >      This is a generalization of 'words'. -}
> > chop :: (a -> Bool) -> [a] -> [[a]]
> > chop p s =
> >    let (l, s') = break p s
> >    in  l : case s' of
> >            [] -> []
> >            (_:rest) -> chop p rest
> 
> I like 'chop'. It belongs in Data.List, I'd say.

Nice that you like it. :-) Will the text processing functions like 'words'
and 'lines' go to a module separate from Data.List in future?

> > {- | Returns 'Just' if the precondition is fulfilled. -}
> > toMaybe :: Bool -> a -> Maybe a
> > toMaybe False _ = Nothing
> > toMaybe True  x = Just x
> 
> Could you give an example to show what makes 'toMaybe' a particularly
> useful function?

Say, you have some stop condition that you want to use in connection with
unfoldr: 

unfoldr (\n -> toMaybe (n<10) (n,n+1)) 0


Or say you want to implement a function

f :: Set (Maybe a) -> Maybe (Set a)

where the result is Nothing if any element of the Set is Nothing, and Just
the set containing the Just values otherwise: 

f s = toMaybe (not (Nothing `elementOf` s)) (mapSet fromJust s)




More information about the Libraries mailing list