fork(1) download
copy 
  1. ----------------------------------------------------------------------------
  2. -- HNU CE 데이터베이스(2025년 2학기 02분반): FD 관련 프로그래밍 과제
  3. ----------------------------------------------------------------------------
  4. -- 이름: 이재혁
  5. -- 학번: 20210501
  6. ----------------------------------------------------------------------------
  7.  
  8. import Data.List
  9. -- representing sets withi lists
  10.  
  11. subset xs ys = null (xs\\ys)	-- subset test in terms of set subtraction
  12.  
  13. -- functional dependency A B C -> D E encoded as (["A","B","C"],["D","E"])
  14. type FD = ([Attr], [Attr])
  15. type Attr = String  -- attributes are represented as strings
  16.  
  17.  
  18. --  3.2.4절 Algorithm 3.7
  19. closure :: [FD] -> [Attr] -> [Attr]   
  20. closure fds xs = if xs/=xs1 then closure fds xs1 else sort xs
  21. 	where xs1 = foldr union xs [cs | (bs,cs) <- fds, bs `subset` xs]
  22.  
  23. -- fd가 기존의 fds로부터 유도 가능한지 검사 (closure 활용한 간단한 함수)
  24. is_derived_from :: FD -> [FD] -> Bool
  25. is_derived_from fd fds = all (`elem` closureSet) rhs
  26.   where
  27.     lhs = fst fd
  28.     rhs = snd fd
  29.     closureSet = closure fds lhs
  30.  
  31. -- 3.2.7절 관련 fds의 basis인지 검사
  32. is_basis_of :: [FD] -> [FD] -> Bool
  33. is_basis_of basis fds =
  34.     equivalent basis fds &&             
  35.     all nonredundant basis                
  36.   where
  37.  
  38.     nonredundant fd = not (is_derived_from fd (filter (/= fd) basis))
  39.  
  40.     equivalent a b =
  41.         all (`is_derived_from` a) b &&
  42.         all (`is_derived_from` b) a
  43.  
  44. --  3.2.7절 basis가 미니멀한지 검사
  45. is_minimal :: [FD] -> Bool
  46. is_minimal basis =
  47.     all singletonRHS basis &&        
  48.     all nonredundant basis &&        
  49.     all minimalLHS basis             
  50.   where
  51.     singletonRHS (_, rhs) = length rhs == 1
  52.  
  53.     nonredundant fd = not (is_derived_from fd (remove fd basis))
  54.  
  55.     minimalLHS (lhs, rhs) =
  56.         all (\a ->
  57.             let lhs' = lhs \\ [a]
  58.             in if null lhs' 
  59.                 then True      
  60.                 else not (is_derived_from (lhs', rhs) basis)
  61.         ) lhs
  62.  
  63.     remove x = filter (/= x)
  64.  
  65. -- 3.2.8절 Algorithm 3.12
  66. project_FDs :: [Attr] -> [FD] -> [Attr] -> [FD]
  67. project_FDs as fds as1 = 
  68.   let
  69.     subsets = filter (not . null) (subsequences as1)
  70.     projected = nub [ (x, [a])
  71.                     | x <- subsets
  72.                     , let xplus = closure fds x
  73.                     , a <- (xplus \\ x) `intersect` as1
  74.                     ]
  75.  
  76.     minimizeLHS fd@(lhs,rhs) = 
  77.       let smaller = [ (lhs \\ [a], rhs) | a <- lhs, length lhs > 1,is_derived_from (lhs \\ [a], rhs) projected ]
  78.       in case smaller of
  79.            (fd':_) -> minimizeLHS fd' 
  80.            []      -> fd
  81.     minimalT = filter (\fd -> not (is_derived_from fd (filter (/= fd) projected))) 
  82.                (map minimizeLHS projected)
  83.   in nub minimalT
  84. -- the main function for running test examples
  85. main = do
  86. 	--
  87. 	putStrLn "== my Example for is_minimal test =========================="
  88. 	let basis = [ (["A"], ["B"]), (["B"], ["C"]) ]
  89. 	putStrLn $ "B = " ++ showFDs basis
  90. 	putStrLn $ "B is minimal : " ++ show (is_minimal basis)
  91. 	putStrLn ""
  92.  
  93. 	let basis = [ (["A", "D"], ["C", "W"]), (["B"], ["C"]) ]
  94. 	putStrLn $ "B = " ++ showFDs basis
  95. 	putStrLn $ "B is minimal : " ++ show (is_minimal basis)
  96. 	putStrLn ""
  97. 	--
  98. 	putStrLn "== my Example for project_FDs test ========================="
  99.  
  100. 	let l_attrs= ["A", "B", "C", "D", "E", "F"]                
  101. 	let s_fds = [ (["A"], ["B"]) ,(["C"], ["D"]), (["E"], ["E"])] 
  102. 	let l1_attrs = ["A", "B", "C"]                   
  103.  
  104. 	putStrLn $ "L = " ++ showAttrSet l_attrs
  105. 	putStrLn $ "S = " ++ showFDs s_fds
  106. 	putStrLn $ "L1 = " ++ showAttrSet l1_attrs
  107.  
  108. 	let s1_fds = project_FDs l_attrs s_fds l1_attrs
  109. 	putStrLn $ "S1 = " ++ showFDs s1_fds
  110. 	putStrLn ""
  111.  
  112.  
  113. 	let l_attrs2 = ["A","B","C","D","E","F","G"]
  114. 	let s_fds2 = [ (["A"], ["C"]), (["D"], ["E"]), (["E","F"], ["G"]) ]
  115. 	let l1_attrs2 = ["A","D","E"]
  116.  
  117. 	putStrLn $ "L = " ++ showAttrSet l_attrs2
  118. 	putStrLn $ "S = " ++ showFDs s_fds2
  119. 	putStrLn $ "L1 = " ++ showAttrSet l1_attrs2
  120.  
  121. 	let s2_fds = project_FDs l_attrs2 s_fds2 l1_attrs2
  122. 	putStrLn $ "S1 = " ++ showFDs s2_fds
  123. 	putStrLn ""
  124.  
  125. 	--
  126.  
  127. -- helper functions for pretty printing
  128. showFD :: FD -> String
  129. showFD (as,bs) = concat $ intersperse " " (as ++ "->" : bs)
  130.  
  131. showFDs :: [FD] -> String
  132. showFDs fds = "{" ++ concat (intersperse ", " $ map showFD fds) ++ "}"
  133.  
  134. showAttrSet :: [Attr] -> String
  135. showAttrSet as = "{" ++ concat (intersperse "," as) ++ "}"
  136.  
Success #stdin #stdout 0.01s 5288KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
== my Example for is_minimal test ==========================
B = {A -> B, B -> C}
B is minimal : True

B = {A D -> C W, B -> C}
B is minimal : False

== my Example for project_FDs test =========================
L = {A,B,C,D,E,F}
S = {A -> B, C -> D, E -> E}
L1 = {A,B,C}
S1 = {A -> B}

L = {A,B,C,D,E,F,G}
S = {A -> C, D -> E, E F -> G}
L1 = {A,D,E}
S1 = {D -> E}
https://ideone.com/fC1IkP
language:
Haskell (ghc 8.4.4)
created:
13 days ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!