Hi folks Any comments and/or criticisms no matter how trivial on the following please: wordSize :: [Int] -> Int wordSize xs = head (dropWhile (<(length xs)) $ iterate (*2) 8) intToBinWord :: Int -> [Int] intToBinWord n = reverse (take elements (xs ++ repeat 0)) where xs = reverse (intToBin n) elements = wordSize xs Thanks, Paul
how about this, for wordSize? I used quickcheck to verify that my
wordSize2 is the same as yours.
Actually, it's not! if you allow negative integers in the list, it's not
at any rate. ("falsifiable after 50 tries")
I haven't thought through what this means... if your function isn't quite
right, or mine, or it doesn't really matter.
Also I would be curious to see this quickchecked but not allowing negative
integers in the list if someone can show me how to do that.
Also, I commented out intToBinWord because intToBin isn't in prelude nor
in any library I could track down and I'm not sure what it was supposed to
do.
thomas.
import Data.List
import Data.Maybe
import Test.QuickCheck
wordSize :: [Int] -> Int
wordSize xs = head (dropWhile (<(length xs)) $ iterate (*2) 8)
wordSize2 :: [Int] -> Int
wordSize2 xs = fromJust $ find (>(length xs)) $ iterate (*2) 8
main = quickCheck $ \xs -> wordSize2 ( xs :: [Int]) == wordSize xs
{-
intToBinWord :: Int -> [Int]
intToBinWord n = reverse (take elements (xs ++ repeat 0))
where
xs = reverse (intToBin n)
elements = wordSize xs
-}
PR Stanley
Here is my suggestion: separation of concerns. Your functions are doing multiple things at once (and there are inefficiencies in your code that are not easy to see because it does do several things at once). You want the smallest word that an int will fit in. Sounds like you'll need a useful helper function: roundUpToPowerOf2 :: Int -> Int roundUpToPowerOf2 n = f 1 where f x = if x >= n then x else f (x*2) Prelude> [(n,roundUpToPowerOf2 n) | n <- [1..10]] [(1,1),(2,2),(3,4),(4,4),(5,8),(6,8),(7,8),(8,8),(9,16),(10,16)] Now wordSize is easy: wordSize :: [a] -> Int wordSize = roundUpToPowerOf2 . length Prelude> wordSize [1..5] 3 The second task appears to be just zero padding a list ns on the left to get to a length of wordSize ns. For this you can avoid the double reversing of ns, again by separating concerns: We know how long the list is, and how long we want it to be. The difference is how many zeroes to add: numZeroesToAdd :: Int -> Int numZeroesToAdd n = roundUpToPowerOf2 n - n We don't want to make an intermediate list of zeroes and append, since that could be wasteful. Just keep adding a zero to the head of our list until it gets big enough. Our list is not copied (i.e. it is shared with the tail of the result) this way, saving making a copy during reverse. But it's good to keep things general until we need to be specific. We want to do something to something over and over a known number of times. For this to be well-typed, f has to take a type to itself. f :: a -> a (In math-speak, this is an endofunction, or a function in a) applyNtimes :: (a -> a) -> Int -> a -> a This sounds like it should be in the library somewhere, but hoogle didn't find it, and it is easy enough to roll our own. It just counts down to zero, composing an f. applyNtimes f 3 = f . f . f . id Note that instead of applying f to something repeatedly, we drop the something and just compose f directly (in math-speak, we move from a group to its algebra), because what's interesting about applyNtimes is f, not what it's applied to. The "something" would just clutter things up. We start with the identity function: applyNtimes f n | n > 0 = f . applyNtimes f (n-1) | otherwise = id For list padding, our f is just (e:), cons'ing an e to the front of the list (again we keep it generalized to any e, since this logic doesn't depend on what e is, only that it has the right type. Not hardcoding an unnecessary detail is important for separation of concerns. padToPowerOf2 :: a -> [a] -> [a] padToPowerOf2 e xs = applyNtimes (e:) numZeroes xs where numZeroes = numZeroesToAdd (length xs) Now we are ready for intToBinWord: intToBinWord :: Int -> [Int] intToBinWord n = padToPowerOf2 0 (intToBin n) ------- Just for fun, we could rewrite this in point-free notation (but if this isn't fun, don't worry, it doesn't really improve anything!) intToBinWord n = padToPowerOf2 0 . intToBin $ n or more simply intToBinWord = padToPowerOf2 0 . intToBin ------- You didn't include a definition for intToBin, so I'll just make one up: intToBin :: Int -> [Int] intToBin n = take n (repeat 9) Now we see the fruits of our labor: *Go> intToBinWord 4 [9,9,9,9] *Go> intToBinWord 5 [0,0,0,9,9,9,9,9] *Go> intToBinWord 8 [9,9,9,9,9,9,9,9] *Go> intToBinWord 9 [0,0,0,0,0,0,0,9,9,9,9,9,9,9,9,9] The main thing I'm trying to convince you of is that each function should pull its own weight, with no extra baggage, and always with an eye out for useful helper functions (like applyNtimes) that you can add to your bag of tricks. Each function is small and easily debuggable, and you can much more easily gauge the optimality of each factored step rather than a bloated function. Dan Weston PR Stanley wrote:
Hi folks Any comments and/or criticisms no matter how trivial on the following please:
wordSize :: [Int] -> Int wordSize xs = head (dropWhile (<(length xs)) $ iterate (*2) 8)
intToBinWord :: Int -> [Int] intToBinWord n = reverse (take elements (xs ++ repeat 0)) where xs = reverse (intToBin n) elements = wordSize xs
Thanks, Paul
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Isaac Dupree wrote:
Dan Weston wrote:
applyNtimes :: (a -> a) -> Int -> a -> a
This sounds like it should be in the library somewhere
agree, I've used it a few times (mostly for testing things) - modulo argument order and Int vs. Integer vs. (Num a => a)
What do you think about calling it iterateN instead? Maxime
I like that name, and will henceforth use it myself until someone sees fit to add it to the Prelude! Maxime Henrion wrote:
Isaac Dupree wrote:
Dan Weston wrote:
applyNtimes :: (a -> a) -> Int -> a -> a
This sounds like it should be in the library somewhere agree, I've used it a few times (mostly for testing things) - modulo argument order and Int vs. Integer vs. (Num a => a)
What do you think about calling it iterateN instead?
Maxime _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Dan Weston wrote:
I like that name, and will henceforth use it myself until someone sees fit to add it to the Prelude!
Oh, and I guess we'd also need: genericIterateN :: (a -> a) -> Integer -> a -> a Which also got me thinking, wouldn't it make more sense to have the count as the first parameter? iterateN :: Int -> (a -> a) -> a -> a genericIterateN :: Integer -> (a -> a) -> a -> a Cheers, Maxime
Maxime Henrion wrote:
Dan Weston wrote:
I like that name, and will henceforth use it myself until someone sees fit to add it to the Prelude!
Oh, and I guess we'd also need:
genericIterateN :: (a -> a) -> Integer -> a -> a
Which also got me thinking, wouldn't it make more sense to have the count as the first parameter?
iterateN :: Int -> (a -> a) -> a -> a genericIterateN :: Integer -> (a -> a) -> a -> a
Woops, obviously I meant: genericIterateN :: Integral a => a -> (b -> b) -> b -> b Cheers, Maxime
Yes. Partially applied, (iterateN n) is a kind of iterate function, but (iterateN f) would be some kind of "function converting an integer into a function", which is much less useful. I would think that the number of iterations would usually depend on the function iterated, not the other way around. Maxime Henrion wrote:
Dan Weston wrote:
I like that name, and will henceforth use it myself until someone sees fit to add it to the Prelude!
Oh, and I guess we'd also need:
genericIterateN :: (a -> a) -> Integer -> a -> a
Which also got me thinking, wouldn't it make more sense to have the count as the first parameter?
iterateN :: Int -> (a -> a) -> a -> a genericIterateN :: Integer -> (a -> a) -> a -> a
Cheers, Maxime
On Fri, 2007-10-12 at 16:20 -0700, Dan Weston wrote:
I like that name, and will henceforth use it myself until someone sees fit to add it to the Prelude!
Maxime Henrion wrote:
Isaac Dupree wrote:
Dan Weston wrote:
applyNtimes :: (a -> a) -> Int -> a -> a
This sounds like it should be in the library somewhere agree, I've used it a few times (mostly for testing things) - modulo argument order and Int vs. Integer vs. (Num a => a)
What do you think about calling it iterateN instead?
The type of foldr: foldr :: (a -> b -> b) -> b -> [a] -> b Church encoding [a] [a] = forall b.(a -> b -> b) -> b -> b Permuting arguments, foldr is one way of an isomorphism between [a] and it's Church encoding, i.e. \c n -> foldr c n list is the Church encoded version of list. Church encoding of Nat Nat = forall a.(a -> a) -> a -> a iterateN is foldNat up to permutations of arguments and ignoring negative values
Dan: Sorry, I forgot to Reply to All.
On 12/10/2007, Dan Weston
We don't want to make an intermediate list of zeroes and append, since that could be wasteful. Just keep adding a zero to the head of our list until it gets big enough. Our list is not copied (i.e. it is shared with the tail of the result) this way, saving making a copy during reverse.
It's actually much less efficient to create a big function that prepends a list of zeroes than just to create that list of zeroes and prepend it. You will be much better of just using (replicate n e ++) than (applyNtimes (e:) n). Contrived benchmark: Prelude> sum . map length $ [replicate i 0 ++ [1..10] | i <- [1..2000]] 2021000 (0.19 secs, 114581032 bytes) Prelude> sum . map length $ [applyNtimes (0:) i [1..10] | i <- [1..2000]] 2021000 (2.51 secs, 242780204 bytes)
participants (8)
-
Aaron Denney -
Dan Weston -
Derek Elkins -
Isaac Dupree -
Maxime Henrion -
PR Stanley -
Rodrigo Queiro -
Thomas Hartman