fork download 
  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.  
  32.  
  33. --  3.2.7절 관련 fds의 basis인지 검사
  34. is_basis_of :: [FD] -> [FD] -> Bool
  35. is_basis_of basis fds =
  36.     equivalent basis fds &&             
  37.     all singletonRHS basis &&           
  38.     all nonredundant basis &&       
  39.     all minimalLHS basis                 
  40.   where
  41.  
  42.     singletonRHS (_, rhs) = length rhs == 1
  43.     nonredundant fd = not ((is_derived_from fd (remove fd basis)))
  44.  
  45.     minimalLHS (lhs, rhs) =
  46.         all (\a -> not (is_derived_from (lhs \\ [a], rhs) basis)) lhs
  47.  
  48.     remove x = filter (/= x)
  49.     equivalent a b =
  50.         all (`is_derived_from` a) b &&
  51.         all (`is_derived_from` b) a
  52.  
  53.  
  54. --  3.2.7절 basis가 미니멀한지 검사
  55. is_minimal :: [FD] -> Bool             
  56. is_minimal basis = undefined
  57.  
  58. -- 3.2.8절 Algorithm 3.12
  59. project_FDs :: [Attr] -> [FD] -> [Attr] -> [FD]
  60. project_FDs as fds as1 = undefined
  61.  
  62.  
  63. -- the main function for running test examples
  64. main = do
  65. 	putStrLn "== Example 3.8 for closure test ============================="
  66. 	let fds = [ (["A","B"],["C"]),		
  67. 				(["B","C"],["A","D"]),  
  68. 				(["D"],["E"]),			
  69. 				(["C","F"],["B"]) ]	
  70. 	let xs = ["A","B"]
  71. 	putStrLn $ "S = " ++ showFDs fds
  72. 	putStrLn $ showAttrSet xs ++ "+ = " ++ showAttrSet (closure fds xs)
  73. 	putStrLn ""
  74.  
  75. 	putStrLn "== my Example closure test ============================="
  76. 	let fds_1 = [ (["A"],["D"]),		
  77. 				(["B","C"],["A","D"]),  
  78. 				(["F", "G"],["H"]),		
  79. 				(["C","F"],["B"]) ]		
  80. 	let xs_1 = ["A","D"]
  81. 	putStrLn $ "S = " ++ showFDs fds_1
  82. 	putStrLn $ showAttrSet xs_1 ++ "+ = " ++ showAttrSet (closure fds xs_1)
  83. 	putStrLn ""
  84. 	--
  85.  
  86. 	putStrLn "== my Example for is_derived_from test ====================="
  87.  
  88. 	let fds2 = [ (["A"], ["C"]) 
  89.                , (["C"], ["D"])
  90.                , (["C","F"], ["G"]) ]  
  91. 	let fd_test1 = (["A"], ["D"]) 
  92. 	let fd_test2 = (["A"], ["G"])     
  93. 	putStrLn $ "S = " ++ showFDs fds2
  94. 	putStrLn $ "A -> D is derived from S : " ++ show (is_derived_from fd_test1 fds2)  
  95. 	putStrLn $ "A -> G is derived from S : " ++ show (is_derived_from fd_test2 fds2)   
  96. 	putStrLn ""
  97.  
  98.  
  99. 	let fds2_2 = [ (["A"], ["D"]) 
  100.                , (["D"], ["G"]) 
  101.                , (["C"], ["F"]) ]  
  102. 	let fd_test1_1 = (["A"], ["F"]) 
  103. 	let fd_test2_2 = (["D"], ["G"])     
  104. 	putStrLn $ "S = " ++ showFDs fds2_2
  105. 	putStrLn $ "A -> F is derived from S : " ++ show (is_derived_from fd_test1_1 fds2_2)  
  106. 	putStrLn $ "D -> G is derived from S : " ++ show (is_derived_from fd_test2_2 fds2_2)   
  107. 	putStrLn ""
  108.  
  109.  
  110. 	--
  111. 	putStrLn "== my Example for is_basis_of test ========================="
  112.  
  113.  
  114. 	let s_fds2 = [ (["A"], ["C"]), (["C"], ["D"]), (["D"], ["G"]) ]		
  115. 	let b_basis2 = [ (["A","B"], ["E"]), (["G"], ["A"]) ]				
  116. 	putStrLn $ "S = " ++ showFDs s_fds2
  117. 	putStrLn $ "B = " ++ showFDs b_basis2
  118. 	putStrLn $ "B is basis of S : " ++ show (is_basis_of b_basis2 s_fds2)
  119. 	putStrLn ""
  120.  
  121. 	let s_fds3 = [ (["A", "B"], ["C"]), (["C"], ["D"]), (["D"], ["G"]) ]	 
  122. 	let b_basis3 = [ (["A","B"], ["C"]), (["C"], ["D"]), (["D"], ["G"]) ]			
  123. 	putStrLn $ "S = " ++ showFDs s_fds3
  124. 	putStrLn $ "B = " ++ showFDs b_basis3
  125. 	putStrLn $ "B is basis of S : " ++ show (is_basis_of b_basis3 s_fds3)
  126. 	putStrLn ""
  127. 	--
  128.  
  129.  
  130. -- helper functions for pretty printing
  131. showFD :: FD -> String
  132. showFD (as,bs) = concat $ intersperse " " (as ++ "->" : bs)
  133.  
  134. showFDs :: [FD] -> String
  135. showFDs fds = "{" ++ concat (intersperse ", " $ map showFD fds) ++ "}"
  136.  
  137. showAttrSet :: [Attr] -> String
  138. showAttrSet as = "{" ++ concat (intersperse "," as) ++ "}"
  139.  
Success #stdin #stdout 0s 5288KB
comments (?)
stdin
stdout 
== Example 3.8 for closure test =============================
S = {A B -> C, B C -> A D, D -> E, C F -> B}
{A,B}+ = {A,B,C,D,E}

== my Example closure test =============================
S = {A -> D, B C -> A D, F G -> H, C F -> B}
{A,D}+ = {A,D,E}

== my Example for is_derived_from test =====================
S = {A -> C, C -> D, C F -> G}
A -> D is derived from S : True
A -> G is derived from S : False

S = {A -> D, D -> G, C -> F}
A -> F is derived from S : False
D -> G is derived from S : True

== my Example for is_basis_of test =========================
S = {A -> C, C -> D, D -> G}
B = {A B -> E, G -> A}
B is basis of S : False

S = {A B -> C, C -> D, D -> G}
B = {A B -> C, C -> D, D -> G}
B is basis of S : True
https://ideone.com/7lt8vF
language:
Haskell (ghc 8.4.4)
created:
2 hours 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!