The architectural pattern should be simple. Most people is thinking on the MVC architectural pattern as the most proper architectural for any application. But really the MVC pattern was designed with very old basis and mostly with the idea of generalizing the user interface of desktop applications. Currently, Web Applications are build on top of many technologies, not RDBMS engines only, so you should start using the proper architectural pattern, where technology diversity should follow the maximum cohesion principle, rather than coupling application components.

We have as key principle of design «minimum coupling, maximum cohesion», but I would like to add «proper generalization». So, finally we should have «minimum coupling, maximum cohesion & proper generalization» as design basis. If we observe, generalizations are older than software, we can stage that the term comes from Maths, where a generalization is a concept that can be applied to multiple problems and solve them using that concept. Cohesion is the principle of independent components that can work together, and coupling is a design which cannot separate its components. One of the best and classical examples of maximum cohesion on its design is Unix, where there are many small tools that can work together without coupling its functionalities.

A good generalization comes with from a good model, and any good generalization usually is able to solve multiple problems at once. Object Oriented programming provides a rich interface for abstractions, where the generalization is one of the most powerful ones, but in words of real generalization, I can proudly say that Monads are one of the best abstractions and mostly generalization that I ever seen.

• Haskell Programmer: Hey Java programmer, you know how just about everything is represented by a class?
• Java Programmer: Yea…
• HP: Even stuff no business being a class
• JP: Well, it is our fundamental abstraction for anything larger than a function. It may be clumsy, but it can be used to implement any other design pattern we need.
• HP: Well Monads serve the same role for us.
• JP: Nulls?
• HP: Maybe Monad
• JP: I/O?
• HP: IO Monad
• JP: Exceptions and error handling?
• HP: We have several ways, but mostly Maybe Monad
• JP: List comprehension?
• HP: Again, Monads
• JP: Mutable data structures?
• HP: That would be the State Monad_[2]

With the proper generalization you can make your design to be consistent, robust and reliable. But you must leave the generalization concept just as hierarchy problem. It should be stated globally as computational problem rather than design problem only. A generalization as computation can be applied to multiple problems, where applying computational generalizations we can find mapping functions that can be globally used. This can be reached combining the IPO model and Object Oriented models properly, working together.

Software design is not easy. An UML class model is not enough, where it can only display structures, probably with a sequence models and communication models you can reach a good IPO design, but not without the proper knowledge about the implementation. So, any analyst who does not knows how to program, is just wasting your money and time, with the obvious further reimplementation and redesign of the software product.

And you should start adding the proper generalizations as computations to your design, working together with your hierarchical generalizations, so they can bring you the proper quality along the time.

[2] This is an excerpt from a discussion on a programming forum.

© dmw for coder . cl, 2012. | Permalink | No comment | Add to del.icio.us
Post tags:

Attribution-NonCommercial-ShareAlike 3.0 Unported (CC BY-NC-SA 3.0)

As you know I am currently solving the Project Euler problem set, just as toy project, to practice some Haskell code with some not so complex problems. And yesterday I have implemented the solution for the problem 104, which is trying to find first pandigital digits from 1 to 9 on the last and first digits of a Fibonacci number. So, the Fibonacci should have more than 9 digits to solve this problem. You can see the code of the solution on this link.

If you observe the code, you will see that it is respecting the Haskell tail call convention, where you must use closures to ensure that the compiled code will be using guarded recursions. Otherwise the functions will become standard recursive functions, rather being compiled as guarded recursions — which are similar to tail calls.

-- | Calculates the Fibonacci Term N
fib :: Int                      -- ^ Term to calculate.
       -> Integer               -- ^ Fibonacci Term as Result.
fib n = snd . foldl' fib' (1, 0) . dropWhile not $
        [testBit n k | k < - let s = bitSize n in [s - 1, s - 2 .. 0]]
  where
    fib' (f, g) p
      | p         = (f * (f + 2 * g), ss)
      | otherwise = (ss, g * (2 * f - g))
      where ss = f * f + g * g

Also it defines two functions to check if the number meets the pandigital requirement, where isValidDig is not called immediately from the checkRange recursive function, instead of calling that function, it calls the isValidPan function, where it is called with the constant expression [1..9], avoiding consecutive List instantiation, and using `seq` to avoid lazy evaluations and further stack overloading.

-- | Checks if the given number x have valid last n digits
-- and last n digits
isValidDig :: Integer           -- ^ Number to Check.
              -> [Integer]      -- ^ Sequence to Check.
              -> Bool           -- ^ Is valid or not.
isValidDig x xs
  | length (digits 10 x) < length xs = False
  | otherwise = let ds = digits 10 x
                    l = length xs
                    s = sort xs
                    r = sort $ take l ds
                    t = sort $ take l $ reverse ds
                in r == s && t == s

-- | Checks sequentially if the given range covers the
-- problem of pandigital sequence of digits using the reqDigs
-- sequence.
isValidPan :: Int               -- ^ Number to check.
              -> Bool           -- ^ True when is valid.
isValidPan x = r `seq` isValidDig r [1..9]
               where r = fib x

This allows the usage of a small stack space once it is called, due to strict evaluation, where all List instances are not kept in memory, and similar structures are only evaluated once, without keeping that memory in use, and being released once those non recursive functions are finished. Finally we can use isValidPan on a guard, without the risk of overloading the stack.

-- | Checks sequentially if the given range covers the
-- problem of pandigital problem.
checkRange :: Int                   -- ^ Starting number.
              -> Int                -- ^ End number
              -> Int                -- ^ Returning Number (-1 on failure).
checkRange m n = sCheckRange m n m
  where sCheckRange x y z
          | z >= y = -1
          | isValidPan z = z
          | otherwise = let r = z + 1
                        in r `seq` sCheckRange x y r

The closure used on the checkRange function makes the compiler to start using the tail call as it is required by this kind of functions where you must keep very well controlled the evaluation of the program expressions. Any mistake on the evaluation of the program will lead you to use more memory that it is really required, leading to slowness and delayed evaluations where your code could crash with stack overflows.

Problem 104 Example Memory Usage

As you see on the cost centre chart above, the program is using almost a constant amount of memory along its execution, evaluating Fibonacci terms from 1000 to 9000, in 12 seconds approximately. So, the keys of a good memory usage in Haskell is to use evaluation expressions and guarded recursions properly.

Another example is the problem #255 in the Project Euler. This code is using Haskell tail calls to ensure the optimal memory allocation. For example the function used to calculate the rounded square root using the Heron Operation as follows.

-- | Applies the Heron Operation recursively until it returns
-- the round square root and the number of iterations as tuple.
heronOpRec :: Integer                 -- ^ Heron Operation to Apply
           -> (Integer, Integer)      -- ^ Pair (RSR, Iterations)
heronOpRec a = heronOp a a (digitBase $ numDigits a) 0
  where heronOp o n m a
          | o == 0 = (0, 0)
          | o == 1 = (1, 1)
          | o == 2 = (1, 1)
          | o == 3 = (2, 1)
          | n == m = (m, a)
          | otherwise = let x = fromIntegral m
                            y = fromIntegral o / x
                            s = round ((x + y) / 2)
                            t = a + 1
                        in heronOp o m s t

And the application of this kind of recursive calls can be seen in the following chart.

Problem 255 Example Memory Usage

If you compare both charts and see how both problem solutions are programmed, you will see that they keep a very low limit on memory usage. The problem #255 is using numbers purely, and where problem #104 solution is using lists to hold the digits of the number to be checked as pandigital, that is why it has some peaks on the isValidDig function, but once the program exits that function that memory is deallocated by the garbage collector.

© dmw for coder . cl, 2012. | Permalink | One comment | Add to del.icio.us
Post tags:

Attribution-NonCommercial-ShareAlike 3.0 Unported (CC BY-NC-SA 3.0)

Is nice to work with Haskell, you may know that you can work with a very wide variety of technologies in Haskell. Also, the Glasgow Haskell Compiler or GHC, is able to compile machine byte code, creating native executables for its runtime. Since all Project Euler problems are very nice to solve, I have created a github repository with my solutions, to share them, probably you can use them to examine some Haskell code and see if you want to learn it.

The problem 102 is related to triangles and point positions, and it can be seen in this link. The main goal of the problem is to indicate the number of triangles which are containing the origin or point , where I have used the Cross Product to solve this problem.

First I have defined plane points and triangles as data types in Haskell, deriving the Num type class instance on the LPt data type which represents a point in a two dimensional space.

data LPt = LPt (Int, Int)
         deriving (Eq, Show, Ord)

data LTrg = LTrg {
  tA        :: LPt
  , tB      :: LPt
  , tC      :: LPt
  } deriving (Eq, Show, Ord)

instance Num LPt where
  x + y = LPt (fstp x + fstp y, sndp x + sndp y)

  x - y = LPt (fstp x - fstp y, sndp x - sndp y)

  x * y = LPt (fstp x * fstp y, sndp x * sndp y)

  abs x = LPt (abs (fstp x), abs (sndp x))

  fromInteger x = LPt (fromInteger x, fromInteger x)

  signum x | fstp x < 0 && sndp x < 0 = -1
  signum x | fstp x > 0 && sndp x > 0 = 1
  signum x = 0

crossPt :: LPt -> LPt -> LPt
crossPt x y = LPt (0, fstp x * sndp y - sndp x * fstp y)

Then is easy to reach the solution. Where I have plain text file parsing triangle points using the following functions.

mkTriangle :: String -> LTrg
mkTriangle s = LTrg { tA = head g, tB = g !! 1, tC = last g }
               where g = fmap (\x -> LPt (head x, last x) )
                         $ splitEvery 2 ln
                     ln = fmap (read . strip) $ splitOn "," s

mkTriangles :: String -> Int -> Int -> [LTrg]
mkTriangles s l h = drop l
                    $ take h
                    $ fmap mkTriangle
                    $ filter (\ x -> length x > 0 )
                    $ fmap strip
                    $ lines s

So, my solution do not creates all triangles on the file, rather than creating all triangles, it just takes a given segment of the file, and renders their position in the OpenGL windows.

trgColor :: LTrg -> IO ()
trgColor xs | trgContained zeroPt xs = colorCyan
trgColor xs = colorGreen

displayTriangle :: LTrg -> IO ()
displayTriangle xs = do _ <- renderPrimitive Polygon $ do
                          trgColor xs
                          mapM ptToGlPt [tA xs, tB xs, tC xs]
                        flush

displayTriangles :: [LTrg] -> F.Font -> IO ()
displayTriangles xs f = do clear [ ColorBuffer, DepthBuffer ]
                           mapM_ displayTriangle xs
                           trgTextCont xs f
                           flush

Where the call to the trgContained in the guard at the trgColor function is what indicates if the triangle contains or not the point or zeroPt. So, you can see two sample results as follows.

Project Euler: Problem 102 Visualization Sample 1

./problem102 triangles.txt 70 90

Project Euler: Problem 102 Visualization Sample 2

./problem102 triangles.txt 23 48

© dmw for coder . cl, 2012. | Permalink | No comment | Add to del.icio.us
Post tags:

Attribution-NonCommercial-ShareAlike 3.0 Unported (CC BY-NC-SA 3.0)

If we see my solution, there is a function pair to solve the problem where heronOp is the main recursive function to solve the iterations, avoiding state. On Haskell, thanks to its main functional abstraction called Monad, you can implement state machines and similar tasks using the State Monad, but states are not really required to solve anything in Haskell.

module Main (main) where

import Data.Digits (digits)
import System.Environment (getArgs)

digitBase :: Int -> Int
digitBase n | odd n = round ((2 * 10) ** ((fromIntegral n - 1) / 2))
digitBase n = round ((7 * 10) ** ((fromIntegral n - 2) / 2))

heronOp :: Int -> Int -> Int -> Int
heronOp o n m | n == m = m
heronOp o n m = heronOp o m (round ((x + y) / 2))
                where x = fromIntegral m
                      y = fromIntegral o / x

main :: IO ()
main = do [x] <- getArgs
          print
            $ heronOp (read x) (read x)
            $ digitBase $ length $ digits (read x) 10

There is — among other interesting approaches — a paper where the authors are writing about writing operating systems entirely in Haskell [«A principled approach to operating system construction in Haskell»], despite it is a functional language, it has solved the stack usage problems along recursive calls using tail calls, so you do not need to worry about recursion in almost all code, you just need to make your recursive calls lazy enough to ensure a good stack usage.

© dmw for coder . cl, 2012. | Permalink | No comment | Add to del.icio.us
Post tags:

Attribution-NonCommercial-ShareAlike 3.0 Unported (CC BY-NC-SA 3.0)

Take any natural number n. If n is even, divide it by 2 to get n / 2. If n is odd, multiply it by 3 and add 1 to obtain 3n + 1. Repeat the process (which has been called “Half Or Triple Plus One”, or HOTPO[4]) indefinitely. The conjecture is that no matter what number you start with, you will always eventually reach 1. The property has also been called oneness.

It was proposed as problem as part of the Project Euler and by Eduardo Díaz on his blog, I have implemented my solution in Haskell, because I want to enhance my skills with this language, to reach the most professional coding on it.

My first solution is as follows, is using recursion and if statements. Where if statements should be avoided, also the colmax function can be reduced and eliminated.

module Main (main) where

import System.Environment

collatz :: Int -> [Int] -> [Int]
collatz 1 xs = xs ++ [1]
collatz n xs = if even n
                  then collatz (n `div` 2) $ xs ++ [n]
               else collatz (n * 3 + 1) $ xs ++ [n]

colmax :: [Int] -> Int -> Int -> Int
colmax [] _ m = m
colmax (x:xs) n m = let r = length $ collatz x []
                        in if r > n
                              then colmax xs r x
                           else colmax xs n m

main :: IO ()
main = do [x] <- getArgs
          print $ colmax [1..(read x)] 0 0

My second solution uses the Haskell features to avoid if statements and some reductions to allow more concise code, mainly due to the lazyness of used functions.

module Main (main) where

import System.Environment
import Data.List
import Data.Ord
import Data.Function

collatz :: Int -> [Int] -> [Int]
collatz n xs | n == 1 = xs ++ [1]
             | even n = collatz (n `div` 2) $ xs ++ [n]
             | otherwise = collatz (n * 3 + 1) $ xs ++ [n]

main :: IO ()
main = do [x] <- getArgs
          print $ fst $ maximumBy (comparing length `on` snd)
            $ fmap (\ x -> (x, collatz x []) ) [1..(read x)]

This code looks really well, and seems to be more clear to understand, mainly due to the inline pointfree lambda expression comparing length `on` snd. So, the code is easy to understand and clear enough. Without if statements and using guards rather than if.

© dmw for coder . cl, 2012. | Permalink | One comment | Add to del.icio.us
Post tags:

Attribution-NonCommercial-ShareAlike 3.0 Unported (CC BY-NC-SA 3.0)

I have replaced the main file processing loop — the one that is collecting data from log lines — forcing lazy evaluations and non-strict bindings where they are required. The resulting code after the optimization is as follows.

foldLogLines :: LogRevStatsMap
                -> LogRevOptions
                -> [String]
                -> LogRevStatsMap
foldLogLines ms _ [] = ms
foldLogLines ms o ~ls = fll ms ls
                        where fll rs [] = rs
                              fll rs (x : ~xs) = let
                                lm = parseLogLine x
                                ns = lm `seq` o `seq` procLogMachine o rs lm
                                in seq ns $ fll ns xs

Again I am using seq for non-strict bindings but now I made the lines argument pattern entirely lazy, including the constructs inside the closure which brings even more laziness to the folding functions. The original optimization was just an implementation of a left folding functions, now it works using the same left folding function using a closure which uses lazy reads of the given list of strings — or log lines. As you remember the first chart obtained was using about ~33MB of memory, as follows.

ApacheLogRev with Initial Optimization

With the second optimization, the resulting memory usage has been reduced to ~13MB. Despite the readFile and lines functions are lazy, we must implement function with the same lazy behaviour, and we must use non-strict bindings only where we need immediate access to the data. Also, you should know that let and where statements have non-strict bindings for their variables, so they are placed immediately on the heap, unless you declare them lazy explicitly. The resulting profiling chart of the second optimization is as follows.

ApacheLogRev with Lazy Reading

Finally I have concluded that we must not underestimate the power of lazy evaluations and Haskell patterns. Once they are used properly, you gain very good performance and optimal memory usage. Enjoy Haskell as programming language.

© dmw for coder . cl, 2012. | Permalink | No comment | Add to del.icio.us
Post tags:

Attribution-NonCommercial-ShareAlike 3.0 Unported (CC BY-NC-SA 3.0)

Parsec allows you to create a parser dynamically on runtime, rather than compiling a parser specification and grammar specification on compile time as being done with flex and bison. As combinatorial construct, seems that can write a dynamic compiler generated in run time, instead of having a compiler built as static component which cannot be modified in run time — with some exception that are not covered by flex and bison, like any C++ compiler, which is capable to understand a small subset of syntax sugar enabled features like templates and operators.

I have created a DSL called Log Reviser Specification or LSR as short name which allows you to create log processing statements defining variables, processing functions and specify a reports based on the collected data. You can see the LSR parser on the github repository and a sample LSR file on the same repository.

The problem of memory leaks — which is present on all languages, without exception — had come to my mind once the program was not able to parse a huge file without crashing. The fact that every language can be subject of memory leaks, is so real as the fact that you cannot abuse of recursion in procedural and object oriented languages. So, I have started profiling the application. With the initial revision, I got LogLine data type being instantiated many times without deallocation, with many instances which were kept in memory due to the lazy evaluation behaviour which is natural in Haskell. Tracing its memory usage, I got the following chart.

ApacheLogRev with Memory Leaks

The program execution was keeping a peak of LogLine instances on memory without being released due to Haskell lazy evaluation. So, now I am using seq and deepseq to reduce the amount lazy evaluations made in Haskell.

instance NFData LogLine where
  rnf a = a `seq` ()

parseLogLine :: String -> Maybe LogLine
parseLogLine s = let
  r = parse logLine "[Invalid]" s
  in case r of
          Left  _   -> Nothing
          Right itm -> itm `deepseq` Just itm

foldLogLines :: [LogRevStatsAction]
                -> LogRevOptions
                -> [String]
                -> [LogRevStatsAction]
foldLogLines [] _ [] = []
foldLogLines ms _ [] = ms
foldLogLines ms o (x : xs) = let
  lm :: Maybe LogLine
  ns :: [LogRevStatsAction]
  lm = x `seq` parseLogLine x
  ns = lm `seq` o `seq` procLogMachine o ms lm
  in foldLogLines ns o xs

I have replaced the initial folding function — where it was using fmap and hGetLine — with the lazy evaluation function hGetContents for file descriptor reading and strict function for result processing foldLogLines. So, for file reading currently I am using lazy reads, but strict evaluation for line processing, allowing large file processing with very good results, thanks to the left folded strict evaluation of the lazy file reading. So we can appreciate the difference in the following chart.

ApacheLogRev without Memory Leaks

So, the garbage collector is really being used without keeping references on memory and instances linked to past results thanks to the tail call implementation in GHC, where we get an initial peak of memory usage which is being reduced along the execution. Also, if you have reached the Java OutOfMemoryError, .NET OutOfMemoryException, «PHP Allowed Memory Size Exhausted Fatal Error», and similar ones in your favorite language, and your solution is to increase the memory limits, your are doing it wrong. The fact that you have memory leaks in your code and you must correct the memory leaks rather than increasing the memory limits, just is telling me that you do not have any idea about memory management. Despite many languages now are using garbage collectors.

© dmw for coder . cl, 2012. | Permalink | No comment | Add to del.icio.us
Post tags:

Attribution-NonCommercial-ShareAlike 3.0 Unported (CC BY-NC-SA 3.0)

(defun dmw-haskell-pointfree-region ()
  "Executes the Haskell pointfree too on the marked region."
  (interactive)
  (let ((pfcmd (format "pointfree %s"
                       (shell-quote-argument (buffer-substring-no-properties
                                              (region-beginning)
                                              (region-end))))))
    (message (format "%s" (shell-command-to-string pfcmd)))))

(defun dmw-haskell-pointfree-replace ()
  "Replaces the marked region with the Haskell pointfree evaluation."
  (interactive)
  (let ((pfcmd (format "pointfree %s"
                       (shell-quote-argument (buffer-substring-no-properties
                                              (region-beginning)
                                              (region-end))))))
    (shell-command-on-region (region-beginning) (region-end) pfcmd t)))

(defun dmw-haskell-hlint-buffer ()
  "Runs hlint on the currently edited file."
  (interactive)
  (set (make-local-variable 'compile-command)
       (let ((file (file-name-nondirectory buffer-file-name)))
         (format "hlint %s" file)))
  (message compile-command)
  (compile compile-command))

(defun dmw-haskell-mode-hook ()
  "Haskell Mode Hook."
  (setq haskell-program-name "/usr/bin/ghci"
        indent-tabs-mode nil)
  (turn-on-haskell-doc-mode)
  (turn-on-haskell-indentation)
  (turn-on-haskell-decl-scan)
  (capitalized-words-mode t)
  (define-key haskell-mode-map "C-cC-p" 'dmw-haskell-pointfree-region)
  (define-key haskell-mode-map "C-cC-r" 'dmw-haskell-pointfree-replace)
  (define-key haskell-mode-map "C-cC-c" 'dmw-haskell-hlint-buffer)
  (message ">>> done dmw-haskell-mode-hook..."))

So, some nice thing about this mode-hook, is the fact that it can search for documentation on each function using C-c M-/ and find definitions using C-c M-.. With two custom commands which can allow you to use Pointfree — which can be installed using cabal — and Hlint — which can be found usually under your operating system without problems and can be installed using cabal too. So, to use Hlint with this hook, you can start it with C-c C-c or C-c C-v, and you can see if there is a point free style replacement for the selected expression — using Emacs region selection — with the binding C-c C-p, and if you like the point free style replacement, you can replace the selected region with the point free style expression using the binding C-c C-r.

I will try to add more nice stuff to my Haskell hook, probably something like searching modules and ordering imports, because would be nice to have similar stuff running under Emacs, to allow more easy to handle Haskell edition under Emacs. Enjoy!

© dmw for coder . cl, 2012. | Permalink | No comment | Add to del.icio.us
Post tags:

Attribution-NonCommercial-ShareAlike 3.0 Unported (CC BY-NC-SA 3.0)

Your challenge today is to write a program that can find the amount of anagrams within a .txt file. For example, “snap” would be an anagram of “pans”, and “skate” would be an anagram of “stake”.

module Main where

import Data.Char
import Data.List
import Data.Maybe
import Data.String.Utils
import System.Environment

liftLine :: String -> [Int]
liftLine l = fmap ord $ strip l

matchWord :: [Int] -> [Int] -> Maybe [Int]
matchWord w1 w2 = if sort w1 == sort w2
                     then Just w2
                     else Nothing

findMatches :: [Int] -> [[Int]] -> [String]
findMatches x xs = fmap (fmap chr . fromJust)
                   $ filter (/= Nothing)
                   $ fmap (matchWord x) xs

main :: IO ()
main = do [n, w] <- getArgs
          f <- readFile n
          let words = fmap liftLine $ lines f
              wmatch = liftLine w
              in mapM_ putStrLn $ findMatches wmatch words

Where the code above can be compiled using ghc --make prog.hs -o prog or can be executed using runghc prog.hs text-file word. With the text file bellow:

snap
pans
skate
stake
takes
kates
tekas
ketas

Its output is as follows:

13:02 [dmw@www:0 exercises]$ ./challenge20120213 challenge20120213.txt kates
skate
stake
takes
kates
tekas
ketas

Enjoy…

© dmw for coder . cl, 2012. | Permalink | 6 comments | Add to del.icio.us
Post tags:

Attribution-NonCommercial-ShareAlike 3.0 Unported (CC BY-NC-SA 3.0)

Today, your challenge is to create a program that will take a series of numbers (5, 3, 15), and find how those numbers can add, subtract, multiply, or divide in various ways to relate to each other. This string of numbers should result in 5 * 3 = 15, or 15 /3 = 5, or 15/5 = 3. When you are done, test your numbers with the following strings:

• 4, 2, 8
• 6, 2, 12
• 6, 2, 3
• 9, 12, 108
• 4, 16, 64

For extra credit, have the program list all possible combinations.
for even more extra credit, allow the program to deal with strings of greater than three numbers. For example, an input of (3, 5, 5, 3) would be 3 * 5 = 15, 15/5 = 3. When you are finished, test them with the following strings.

• 2, 4, 6, 3
• 1, 1, 2, 3
• 4, 4, 3, 4
• 8, 4, 3, 6
• 9, 3, 1, 7

Here is the full solution in Haskell, just to practice a little. Compile it using ghc --make prog.hs -o prog or run it using runghc prog.hs input.txt

module Main where

import Data.String.Utils
import Data.List
import Data.Maybe
import Math.Combinat.Sets
import System.Environment
import Text.Printf

data OperationResult = OperationResult {
     oper              :: Int -> [Int] -> Bool
     , msg             :: String
}

availableOperations :: [OperationResult]
availableOperations =
                    [
                    OperationResult { oper = testMatchMul,
                                      msg = "mul" },
                    OperationResult { oper = testMatchDiv,
                                      msg = "div" },
                    OperationResult { oper = testMatchSum,
                                      msg = "add" },
                    OperationResult { oper = testMatchSub,
                                      msg = "sub" }
                    ]

liftLine :: String -> [Int]
liftLine l = sort $ fmap ( read . strip ) $ split "," l

matchMessage :: String -> [Int] -> Int -> String
matchMessage s xs n = printf "%s does %s with %s"
                      s ( show n ) ( show xs )

testMatchMul :: Int -> [Int] -> Bool
testMatchMul n xs = n == foldr (*) 1 xs

testMatchDiv :: Int -> [Int] -> Bool
testMatchDiv n xs = dm == n && dr == 0
                    where (dm,dr) = divMod ( head xs ) ( last xs )

testMatchSum :: Int -> [Int] -> Bool
testMatchSum n xs = n == foldr (+) 0 xs

testMatchSub :: Int -> [Int] -> Bool
testMatchSub n xs = n == foldr (-) 0 xs

applyOperation :: [Int] -> Int -> OperationResult -> Maybe String
applyOperation xs x y = if oper y x xs
                           then Just $ matchMessage ( msg y ) xs x
                           else Nothing

matchOperation :: [OperationResult] -> [Int] -> Int -> [Maybe String]
matchOperation ops xs x = fmap (applyOperation xs x) ops

findMatch :: [Int] -> [Int] -> [String]
findMatch rs xs = fmap fromJust
                  $ filter ( /= Nothing )
                  $ join []
                  $ fmap (matchOperation availableOperations rs) xs

createCombinations :: [[Int]] -> [[Int]]
createCombinations xs = join [] $ fmap (choose 2) xs

procResults :: [String] -> IO ()
procResults = foldr ((>>) . putStrLn) (putStrLn "End!")

main :: IO ()
main = do [i] <- getArgs
          f <- readFile i
          let rows = fmap liftLine $ lines f
              comb = createCombinations rows
              oset = join [] $ nub $ join []
                     $ fmap ( x -> fmap (findMatch x) rows ) comb
              in procResults oset
                 >> print comb

Where having a sample input file with three numbers per line as follows:

4, 2, 8
6, 2, 12
6, 2, 3
9, 12, 108
4, 16, 64

Should be processed as follows:

08:21 [dmw@www:1 exercises]$ ghc --make challenge20120212.hs -o challenge20120212
[1 of 1] Compiling Main             ( challenge20120212.hs, challenge20120212.o )
Linking challenge20120212 ...
08:21 [dmw@www:1 exercises]$ ./challenge20120212 ./challenge20120212.txt
mul does 8 with [2,4]
add does 6 with [2,4]
mul does 16 with [2,8]
add does 12 with [4,8]
add does 8 with [2,6]
mul does 12 with [2,6]
mul does 6 with [2,3]
add does 9 with [3,6]
mul does 108 with [9,12]
mul does 64 with [4,16]
End!
[[2,4],[2,8],[4,8],[2,6],[2,12],[6,12],[2,3],[2,6],[3,6],[9,12],[9,108],[12,108],[4,16],[4,64],[16,64]]

Also, this program can process files with lines containing up to 4 numbers, no matter how many of them are present on the file, it will try all combinations thanks to the Math.Combinat.Sets module which is used to create the proper permutations with each line which are converted to Int lists with the liftLine function. Probably this is a kind of very basic MapReduce and non distributed implementation where you have various sets of unique permutations — or antisymmetric power of each list — and operations to check whether are executed.

© dmw for coder . cl, 2012. | Permalink | 6 comments | Add to del.icio.us
Post tags:

Attribution-NonCommercial-ShareAlike 3.0 Unported (CC BY-NC-SA 3.0)