Home > Technology > Chain delegates (in Haskell)

Chain delegates (in Haskell)

Xiaoheng Ji sends in his implementation of my Chain Delegates sample in Haskell. You can get Visual Studio-integrated Haskell here.

I just had to go and learn about the language and it looks like a powerful research vehicle – purely functional and uses lazy evaluation and pattern matching. I still can’t quite comprehend the implications of the last feature, but it sure looks interesting. They say that writing infinite-precision calculator is a snap in Haskell.

—————————————————————————————–
{-|
 Haskell implementation of chain delegates
 Based on Eugene Tolmachev’s idea and C# implementation
 by Henry Ji a.k.a. Xiaoheng Ji
-}
—————————————————————————————–

module Main where
————————————–
– TYPE DEFINITION PART
————————————–
– both for item and template
data Unit = UnitString (Maybe String) | UnitInt (Maybe Int)
type Item = [Unit]
type Items = [Item]
————————————–
– FUNCTION DEFINITION PART
————————————–
– mainfunction takes items and templates as paramenter and returns the items that satisfy the predicates
mainfunction :: Items -> Items -> Items
mainfunction (item1:items) templates = if (fn item1 templates) then (item1 : (mainfunction items templates)) else mainfunction items templates
mainfunction [] templates = []

– fn take one item and templates to determine whether this item satisfies one of the predicates
fn :: Item -> Items -> Bool
fn item (template1:templates) = (predicate item template1) || fn item templates
fn item [] = False

– predicate compares an item and a template to determine whether this time matches this template
predicate :: Item -> Item -> Bool
predicate (unit1:item1) (unit2:item2) = predicateHelper unit1 unit2 && predicate item1 item2
predicate [] [] = True
predicate _ _ = False

predicateHelper :: Unit -> Unit -> Bool
predicateHelper (UnitString (Just s1))  (UnitString (Just s2)) = contains s2 s1
predicateHelper (UnitInt (Just i1))  (UnitInt (Just i2)) = (i1 == i2)
predicateHelper _ (UnitString Nothing) = True
predicateHelper _ (UnitInt Nothing) = True
predicateHelper _ _ = False

contains :: String -> String -> Bool
contains [] _ = True 
contains xs [] = False
contains xs ys = and ( zipWith (==) xs ys ) || contains xs ( tail ys ) 
————————————–
– DATA DEFINITION PART 1
————————————–
item11 = [UnitInt (Just 1), UnitInt (Just 2), UnitString (Just "note1"), UnitString (Just "text1")]
item12 = [UnitInt (Just 2), UnitInt (Just 1), UnitString (Just "note2"), UnitString (Just "text2")]
item13 = [UnitInt (Just 3), UnitInt (Just 2), UnitString (Just "note3"), UnitString (Just "")]
item14 = [UnitInt (Just 4), UnitInt (Just 2), UnitString (Just "note4"), UnitString (Just "text4")]
items1 = [item11, item12, item13, item14]

template11 = [UnitInt (Just 1), UnitInt Nothing, UnitString Nothing, UnitString Nothing]
template12 = [UnitInt Nothing, UnitInt Nothing, UnitString (Just "note2"), UnitString Nothing]
template13 = [UnitInt Nothing, UnitInt (Just 2), UnitString Nothing, UnitString (Just "text")]
templates1 = [template11, template12, template13]
————————————–
– DATA DEFINITION PART 2
————————————–
item21 = [UnitInt (Just 1), UnitInt (Just 2), UnitString (Just "note1"), UnitString (Just "text1"), UnitInt (Just 1), UnitInt (Just 2), UnitString (Just "note1"), UnitString (Just "text1")]
item22 = [UnitInt (Just 2), UnitInt (Just 1), UnitString (Just "note2"), UnitString (Just "text2"), UnitInt (Just 2), UnitInt (Just 1), UnitString (Just "note2"), UnitString (Just "text2")]
item23 = [UnitInt (Just 3), UnitInt (Just 2), UnitString (Just "note3"), UnitString (Just ""), UnitInt (Just 3), UnitInt (Just 2), UnitString (Just "note3"), UnitString (Just "")]
item24 = [UnitInt (Just 4), UnitInt (Just 2), UnitString (Just "note4"), UnitString (Just "text4"), UnitInt (Just 4), UnitInt (Just 2), UnitString (Just "note4"), UnitString (Just "text4")]
item25 = [UnitInt (Just 1), UnitInt (Just 2), UnitString (Just "note1"), UnitString (Just "text1"), UnitInt (Just 1), UnitInt (Just 2), UnitString (Just "note1"), UnitString (Just "text1")]
item26 = [UnitInt (Just 2), UnitInt (Just 1), UnitString (Just "note2"), UnitString (Just "text2"), UnitInt (Just 2), UnitInt (Just 1), UnitString (Just "note2"), UnitString (Just "text2")]
item27 = [UnitInt (Just 3), UnitInt (Just 2), UnitString (Just "note3"), UnitString (Just ""), UnitInt (Just 3), UnitInt (Just 2), UnitString (Just "note3"), UnitString (Just "")]
item28 = [UnitInt (Just 4), UnitInt (Just 2), UnitString (Just "note4"), UnitString (Just "text4"), UnitInt (Just 4), UnitInt (Just 2), UnitString (Just "note4"), UnitString (Just "text4")]
items2 = [item21, item22, item23, item24, item25, item26, item27, item28]

template21 = [UnitInt (Just 1), UnitInt Nothing, UnitString Nothing, UnitString Nothing, UnitInt (Just 1), UnitInt Nothing, UnitString Nothing, UnitString Nothing]
template22 = [UnitInt Nothing, UnitInt Nothing, UnitString (Just "note2"), UnitString Nothing, UnitInt Nothing, UnitInt Nothing, UnitString (Just "note2"), UnitString Nothing]
template23 = [UnitInt Nothing, UnitInt (Just 2), UnitString Nothing, UnitString (Just "text"), UnitInt Nothing, UnitInt (Just 2), UnitString Nothing, UnitString (Just "text")]
templates2 = [template21, template22, template23]
————————————–
– RESULT GENERATION PART
————————————–
result1 = mainfunction items1 templates1
result2 = mainfunction items2 templates2
————————————–
– SHOW FUNCTION PART
————————————–
showItems :: Items -> String
showItems (item:items) = showItem item ++ "\n" ++ showItems items
showItems [] = ""

showItem :: Item -> String
showItem (unit1:units)= showItemHead unit1 ++ " : " ++ showItemContent units

showItemHead :: Unit -> String
showItemHead (UnitInt (Just i)) = show i
showItemHead (UnitInt Nothing) = show "null"

showItemContent :: [Unit] -> String
showItemContent [UnitInt (Just i)] = show i
showItemContent [UnitInt Nothing] = show "null"
showItemContent ((UnitInt (Just i)):units) = show i ++ ", " ++ showItemContent units
showItemContent ((UnitInt Nothing):units) = show "null" ++ ", " ++ showItemContent units
showItemContent [UnitString (Just s)] = show s
showItemContent [UnitString Nothing] = show "null"
showItemContent ((UnitString (Just s)):units) = show s ++ ", " ++ showItemContent units
showItemContent ((UnitString Nothing):units) = "null" ++ ", " ++ showItemContent units
————————————–
– MAIN FUNCTION PART
————————————–
main = do
 putStrLn "================== Test Data 1 =================="
 putStrLn $ "Item " ++ showItem item11
 putStrLn $ "Item " ++ showItem item12
 putStrLn $ "Item " ++ showItem item13
 putStrLn $ "Item " ++ showItem item14
 putStrLn ""
 putStrLn $ "Template " ++ showItem template11
 putStrLn $ "Template " ++ showItem template12
 putStrLn $ "Template " ++ showItem template13
 putStrLn ""
 putStrLn "==================  result ================== "
 putStrLn $ showItems result1
 
 putStrLn "================== Test Data 2 =================="
 putStrLn $ "Item " ++ showItem item21
 putStrLn $ "Item " ++ showItem item22
 putStrLn $ "Item " ++ showItem item23
 putStrLn $ "Item " ++ showItem item24
 putStrLn $ "Item " ++ showItem item25
 putStrLn $ "Item " ++ showItem item26
 putStrLn $ "Item " ++ showItem item27
 putStrLn $ "Item " ++ showItem item28 
 putStrLn ""
 putStrLn $ "Template " ++ showItem template21
 putStrLn $ "Template " ++ showItem template22
 putStrLn $ "Template " ++ showItem template23
 putStrLn ""
 putStrLn "==================  result =================="
 putStrLn $ showItems result2

TestDataAndResults

About these ads
Categories: Technology Tags:
  1. No comments yet.
  1. No trackbacks yet.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

Follow

Get every new post delivered to your Inbox.

%d bloggers like this: