diff --git a/Data/ByteString/Nums/Careless/Float.hs b/Data/ByteString/Nums/Careless/Float.hs --- a/Data/ByteString/Nums/Careless/Float.hs +++ b/Data/ByteString/Nums/Careless/Float.hs @@ -1,6 +1,7 @@ {-# LANGUAGE MultiParamTypeClasses + , TypeSynonymInstances #-} @@ -8,8 +9,10 @@ import Data.Char -import Prelude hiding (splitAt) -import Data.ByteString.Char8 hiding (length, inits, elem, last) +import Prelude hiding (break, length, null, drop, tail, head) +import Data.ByteString hiding (head, break, pack) +import Data.ByteString.Char8 hiding (inits, elem, last, foldl') +import qualified Data.ByteString.Lazy.Internal as Lazy import qualified Data.ByteString.Lazy.Char8 as Lazy @@ -19,9 +22,9 @@ -{-| Types that can be read from floating point strings. The fractional part is - taken to be the last group of digits behind a decimal point or comma. - Characters are not decimal digits are simply skipped. +{-| Types that can be read from floating point strings. A floating point + string is taken to be a string of digits with up to one comma or period + mixed in with the digits. -} class (Intable b f, Fractional f) => Floatable b f where float :: b -> f @@ -41,22 +44,47 @@ float = lazy_float -strict_float bytes = case findIndices (`elem` ".,") bytes of - [ ] -> int bytes - idx -> hi' + (int lo * (0.1 ^ length digits) * s) - where - (hi, lo) = splitAt (last idx) bytes - hi' = int hi - s = signum hi' - digits = findIndices isDigit lo -lazy_float bytes = case Lazy.findIndices (`elem` ".,") bytes of - [ ] -> int bytes - idx -> hi' + (int lo * (0.1 ^ length digits) * s) - where - (hi, lo) = Lazy.splitAt (last idx) bytes - hi' = int hi - s = signum hi' - digits = Lazy.findIndices isDigit lo + +strict_float bytes + | null bytes = 0 + | head bytes == '-' = foldn 0 (tail integer) + nfrac + | head bytes == '+' = foldp 0 (tail integer) + pfrac + | otherwise = foldp 0 integer + pfrac + where + foldn = foldl' negative + foldp = foldl' positive + (integer, fractional) = break point bytes + fractional' = tail fractional + p = 0.1 ^ length fractional' + nfrac + | null fractional = 0 + | otherwise = foldn 0 fractional' * p + pfrac + | null fractional = 0 + | otherwise = foldp 0 fractional' * p + + +lazy_float bytes + | Lazy.null bytes = 0 + | Lazy.head bytes == '-' = foldn 0 (Lazy.tail integer) + nfrac + | Lazy.head bytes == '+' = foldp 0 (Lazy.tail integer) + pfrac + | otherwise = foldp 0 integer + pfrac + where + foldn = Lazy.foldlChunks (foldl' negative) + foldp = Lazy.foldlChunks (foldl' positive) + (integer, fractional) = Lazy.break point bytes + fractional' = Lazy.tail fractional + p = 0.1 ^ Lazy.length fractional' + nfrac + | Lazy.null fractional = 0 + | otherwise = foldn 0 fractional' * p + pfrac + | Lazy.null fractional = 0 + | otherwise = foldp 0 fractional' * p + + +point c = c == '.' || c == ',' + diff --git a/Data/ByteString/Nums/Careless/Hex.hs b/Data/ByteString/Nums/Careless/Hex.hs --- a/Data/ByteString/Nums/Careless/Hex.hs +++ b/Data/ByteString/Nums/Careless/Hex.hs @@ -1,6 +1,7 @@ {-# LANGUAGE MultiParamTypeClasses + , TypeSynonymInstances #-} @@ -21,7 +22,8 @@ {-| Types that can be read from hexadecimal strings. Characters that are not - hexadecimal digits are skipped over. + hexadecimal digits are skipped over. One pleasant consequence of this is + that a leading @0x@ is simply ignored. -} class (Num n) => Hexable b n where hex :: b -> n @@ -88,29 +90,13 @@ hexalize :: (Num n) => n -> Word8 -> n -{- -{-# SPECIALIZE INLINE hexalize :: Word8 -> Word8 -> Word8 #-} -{-# SPECIALIZE INLINE hexalize :: Word16 -> Word8 -> Word16 #-} -{-# SPECIALIZE INLINE hexalize :: Word32 -> Word8 -> Word32 #-} -{-# SPECIALIZE INLINE hexalize :: Word64 -> Word8 -> Word64 #-} -{-# SPECIALIZE INLINE hexalize :: Word -> Word8 -> Word #-} -{-# SPECIALIZE INLINE hexalize :: Int8 -> Word8 -> Int8 #-} -{-# SPECIALIZE INLINE hexalize :: Int16 -> Word8 -> Int16 #-} -{-# SPECIALIZE INLINE hexalize :: Int32 -> Word8 -> Int32 #-} -{-# SPECIALIZE INLINE hexalize :: Int64 -> Word8 -> Int64 #-} -{-# SPECIALIZE INLINE hexalize :: Int -> Word8 -> Int #-} -{-# SPECIALIZE INLINE hexalize :: Float -> Word8 -> Float #-} -{-# SPECIALIZE INLINE hexalize :: Double -> Word8 -> Double #-} -{-# SPECIALIZE INLINE hexalize :: Rational -> Word8 -> Rational #-} -{-# SPECIALIZE INLINE hexalize :: Integer -> Word8 -> Integer #-} - -} hexalize acc byte - | between byte 'a' 'f' = place_up (byte + 0x0a - c2w 'a') - | between byte 'A' 'F' = place_up (byte + 0x0a - c2w 'A') - | between byte '0' '9' = place_up (byte - c2w '0') + | between 'a' 'f' = place_up (byte + 0x0a - c2w 'a') + | between 'A' 'F' = place_up (byte + 0x0a - c2w 'A') + | between '0' '9' = place_up (byte - c2w '0') | otherwise = acc where - between b a z = b >= c2w a && byte <= c2w z + between a z = byte >= c2w a && byte <= c2w z place_up b = (0x10 * acc) + fromIntegral b strict_hex bytes = foldl' hexalize 0 bytes diff --git a/Data/ByteString/Nums/Careless/Int.hs b/Data/ByteString/Nums/Careless/Int.hs --- a/Data/ByteString/Nums/Careless/Int.hs +++ b/Data/ByteString/Nums/Careless/Int.hs @@ -1,6 +1,7 @@ {-# LANGUAGE MultiParamTypeClasses + , TypeSynonymInstances #-} @@ -20,139 +21,99 @@ -{-| Types that can be read from integer strings. Characters that are not - decimal digits are simply skipped. +{-| Types that can be read from integer strings. Parses only decimal digits. + Signed types can be read from strings that begin with a plus or minus; + unsigned types are read from strings consisting solely of decimal digits. -} class (Num n) => Intable b n where int :: b -> n instance Intable ByteString Word8 where - int = strict_int + int = strict_unsigned instance Intable ByteString Word16 where - int = strict_int + int = strict_unsigned instance Intable ByteString Word32 where - int = strict_int + int = strict_unsigned instance Intable ByteString Word64 where - int = strict_int + int = strict_unsigned instance Intable ByteString Word where - int = strict_int + int = strict_unsigned instance Intable ByteString Int8 where - int = strict_int + int = strict_signed instance Intable ByteString Int16 where - int = strict_int + int = strict_signed instance Intable ByteString Int32 where - int = strict_int + int = strict_signed instance Intable ByteString Int64 where - int = strict_int + int = strict_signed instance Intable ByteString Int where - int = strict_int + int = strict_signed instance Intable ByteString Float where - int = strict_int + int = strict_signed instance Intable ByteString Double where - int = strict_int + int = strict_signed instance Intable ByteString Rational where - int = strict_int + int = strict_signed instance Intable ByteString Integer where - int = strict_int + int = strict_signed instance Intable Lazy.ByteString Word8 where - int = lazy_int + int = lazy_unsigned instance Intable Lazy.ByteString Word16 where - int = lazy_int + int = lazy_unsigned instance Intable Lazy.ByteString Word32 where - int = lazy_int + int = lazy_unsigned instance Intable Lazy.ByteString Word64 where - int = lazy_int + int = lazy_unsigned instance Intable Lazy.ByteString Word where - int = lazy_int + int = lazy_unsigned instance Intable Lazy.ByteString Int8 where - int = lazy_int + int = lazy_signed instance Intable Lazy.ByteString Int16 where - int = lazy_int + int = lazy_signed instance Intable Lazy.ByteString Int32 where - int = lazy_int + int = lazy_signed instance Intable Lazy.ByteString Int64 where - int = lazy_int + int = lazy_signed instance Intable Lazy.ByteString Int where - int = lazy_int + int = lazy_signed instance Intable Lazy.ByteString Float where - int = lazy_int + int = lazy_signed instance Intable Lazy.ByteString Double where - int = lazy_int + int = lazy_signed instance Intable Lazy.ByteString Rational where - int = lazy_int + int = lazy_signed instance Intable Lazy.ByteString Integer where - int = lazy_int + int = lazy_signed -digitize :: (Num n) => (n -> n -> n) -> n -> Word8 -> n -{- -{-# SPECIALIZE INLINE -digitize :: (Word8 -> Word8 -> Word8) -> Word8 -> Word8 -> Word8 - #-} -{-# SPECIALIZE INLINE -digitize :: (Word16 -> Word16 -> Word16) -> Word16 -> Word8 -> Word16 - #-} -{-# SPECIALIZE INLINE -digitize :: (Word32 -> Word32 -> Word32) -> Word32 -> Word8 -> Word32 - #-} -{-# SPECIALIZE INLINE -digitize :: (Word64 -> Word64 -> Word64) -> Word64 -> Word8 -> Word64 - #-} -{-# SPECIALIZE INLINE -digitize :: (Word -> Word -> Word) -> Word -> Word8 -> Word - #-} -{-# SPECIALIZE INLINE -digitize :: (Word8 -> Word8 -> Word8) -> Word8 -> Word8 -> Word8 - #-} -{-# SPECIALIZE INLINE -digitize :: (Int16 -> Int16 -> Int16) -> Int16 -> Word8 -> Int16 - #-} -{-# SPECIALIZE INLINE -digitize :: (Int32 -> Int32 -> Int32) -> Int32 -> Word8 -> Int32 - #-} -{-# SPECIALIZE INLINE -digitize :: (Int64 -> Int64 -> Int64) -> Int64 -> Word8 -> Int64 - #-} -{-# SPECIALIZE INLINE -digitize :: (Int -> Int -> Int) -> Int -> Word8 -> Int - #-} -{-# SPECIALIZE INLINE -digitize :: (Float -> Float -> Float) -> Float -> Word8 -> Float - #-} -{-# SPECIALIZE INLINE -digitize :: (Double -> Double -> Double) -> Double -> Word8 -> Double - #-} -{-# SPECIALIZE INLINE -digitize :: (Rational -> Rational -> Rational) -> Rational -> Word8 -> Rational - #-} -{-# SPECIALIZE INLINE -digitize :: (Integer -> Integer -> Integer) -> Integer -> Word8 -> Integer - #-} - -} -digitize op acc byte - | between byte '0' '9' = (acc * 10) `op` fromIntegral (byte - c2w '0') - | otherwise = acc - where - between b a z = b >= c2w a && byte <= c2w z +lazy_unsigned :: (Num n) => Lazy.ByteString -> n +lazy_unsigned = Lazy.foldlChunks (foldl' positive) 0 -strict_int bytes = foldl' (digitize op) 0 piece +lazy_signed bytes + | Lazy.null bytes = 0 + | Lazy.head bytes == '-' = fold negative 0 (Lazy.tail bytes) + | Lazy.head bytes == '+' = fold positive 0 (Lazy.tail bytes) + | otherwise = fold positive 0 bytes where - (op, piece) - | null bytes = ((+), empty) - | head bytes == '-' = ((-), tail bytes) - | head bytes == '+' = ((+), tail bytes) - | otherwise = ((+), bytes) + fold = Lazy.foldlChunks . foldl' -lazy_int bytes = Lazy.foldlChunks (foldl' (digitize op)) 0 piece - where - (op, piece) - | Lazy.null bytes = ((+), Lazy.empty) - | Lazy.head bytes == '-' = ((-), Lazy.tail bytes) - | Lazy.head bytes == '+' = ((+), Lazy.tail bytes) - | otherwise = ((+), bytes) + +strict_unsigned :: (Num n) => ByteString -> n +strict_unsigned = foldl' positive 0 + +strict_signed bytes + | null bytes = 0 + | head bytes == '-' = foldl' negative 0 (tail bytes) + | head bytes == '+' = foldl' positive 0 (tail bytes) + | otherwise = foldl' positive 0 bytes + + +positive acc byte = (acc * 10) + fromIntegral (byte - c2w '0') + +negative acc byte = (acc * 10) - fromIntegral (byte - c2w '0') diff --git a/SPOJEugeneKirpichov.hs b/SPOJEugeneKirpichov.hs new file mode 100644 --- /dev/null +++ b/SPOJEugeneKirpichov.hs @@ -0,0 +1,45 @@ + + +module Main where + +import qualified Data.ByteString.Lazy as B +import Data.ByteString.Nums.Careless -- from bytestring-nums package + +bint :: B.ByteString -> Int +bint = int + +main = do + line : rest <- B.split 10 `fmap` B.getContents + let [n, k] = map int . B.split 32 $ line + putStrLn . show . length . tail . filter ((==0).(`mod`k).bint) $ rest + + + +{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +---------- Forwarded message ---------- +From: Eugene Kirpichov +Date: 2009/08/30 +Subject: Re: [Haskell-cafe] Slow IO? +To: Steve +Cc: haskell-cafe@haskell.org + + +module Main where + +import qualified Data.ByteString.Lazy as B +import Data.ByteString.Nums.Careless -- from bytestring-nums package + +bint :: B.ByteString -> Int +bint = int + +main = do + line : rest <- B.split 10 `fmap` B.getContents + let [n, k] = map int . B.split 32 $ line + putStrLn . show . length . tail . filter ((==0).(`mod`k).bint) $ rest + +This does a 100MB file in 2.7s (probably because the file is cached by +the filesystem). + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -} + diff --git a/bytestring-nums.cabal b/bytestring-nums.cabal --- a/bytestring-nums.cabal +++ b/bytestring-nums.cabal @@ -1,5 +1,5 @@ name : bytestring-nums -version : 0.2.1 +version : 0.3.0 category : Text license : BSD3 license-file : LICENSE @@ -27,4 +27,18 @@ Data.ByteString.Nums.Careless.Float extensions : MultiParamTypeClasses TypeSynonymInstances + BangPatterns + ghc-options : -O2 -Wall -funbox-strict-fields + + +executable spoj-eugene + main-is : SPOJEugeneKirpichov.hs + extensions : MultiParamTypeClasses + TypeSynonymInstances + BangPatterns + ghc-options : -O2 -Wall -funbox-strict-fields + + + +