[Haskell-cafe] Converting non-primitive(?) recursive function to use scanl (or foldl maybe?)

Thomas Horstmeyer horstmey at Mathematik.Uni-Marburg.de
Mon Dec 15 13:57:20 UTC 2014


I would solve this using unfoldr from Data.List.


f :: Maybe (String, String, String, [String]) -> Maybe (String, String)
f = fmap (\(_,_, rest, xs) -> (concat xs, rest))


-- *Main> unfoldr (f . matchRegexAll re) str
-- ["fish1","cow3","boat4"]


HTH
Thomas


Am 15.12.2014 um 06:18 schrieb Cody Goodman:
> I've had some trouble wrapping my brain around how to use a scan to
> build this list:
>
> code below, but here's an lpaste link: http://lpaste.net/116494
>
> {-# LANGUAGE OverloadedStrings #-}
> import           Control.Monad
> import           Data.Maybe
> import           Text.Regex
>
> type RegexRes = Maybe (String, String, String, [String])
>
> re = mkRegex "\\((\\w+)\\):([[:digit:]]+)"
>
> getParenNum :: String -> [String]
> getParenNum s = case matchRegexAll re s of
>                   Nothing -> []
>                   Just (_,_,after,[word,num]) -> (word ++ num):getParenNum after
>
> getParenNumOnce' :: String -> String
> getParenNumOnce' s = case matchRegexAll re s of
>                   Nothing -> []
>                   Just (_,_,after,[word,num]) -> (word ++ num)
>
> -- trying to accumulate the results of regexMatching repeatedly over a string
> f1 str = (\ (_, _, xs, acc) -> Just (xs, acc)) <=< (matchRegexAll re) $ str
>
> f2 str = fromMaybe "" $ (\ (_, _, after, [word,num]) -> Just after)
> <=< (matchRegexAll re) $ str
>
> -- f3 :: RegexRes -> RegexRes
> -- f3 :: RegexRes -> String
> f3 match = fromMaybe [] $ (\(_,_,after,[word,num]) -> Just (word ++
> num)) =<< match
>
> f4 str = scanl (const f3) "" [(matchRegexAll re str)]
>
> f5 acc str = fromMaybe [] $ (\ (_, _, after, [word,num]) -> Just (acc
> ++ [word ++ num])) <=< (matchRegexAll re) $ str
> -- λ> scanl f5 [] ["(fish):1 sausage (cow):3 tree (boat):4"]
> -- [[],["fish1"]]
>
> str = "(fish):1 sausage (cow):3 tree (boat):4"
>
> -- λ>  foldl (const . f3 . (matchRegexAll re)) "(fish):1 sausage
> (cow):3 tree (boat):4" ["(fish):1 sausage (cow):3 tree (boat):4"]
> -- "fish1"
> -- λ> -- want ["fish1","cow3","boat4"]
> -- λ> -- I feel like I should be using something in place of const
> that smartly chooses whether to pass String or... idk
>
> main = undefined
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>


More information about the Haskell-Cafe mailing list