Skip to content

Instantly share code, notes, and snippets.

@jiridanek

jiridanek/matice.hs

Created October 17, 2010 13:06
Show Gist options
  • Save jiridanek/630836 to your computer and use it in GitHub Desktop.
Save jiridanek/630836 to your computer and use it in GitHub Desktop.
Download ZIP
Priklad 3, usporadani
Raw
matice.hs
import Data.List
-- ukolem je matice 4x4
rozmer = 4
-- ze vsech matic vyfiltruji ty, co popisuji relaci a z nich ty, kde 3 a 2 nejsou srovnatelné
uplny_vysledek = vysledek $ relace $ matice rozmer
-- matice, kde 3 a 2 nejsou v relaci
vysledek mat' = filter fce mat'
where
fce m = ((sloupec 3) . (radek 2)) m == False && ((sloupec 2) . (radek 3)) m == False
-- relace usporadani je taková matice, která je reflexivni, tranzitivni, ...
relace mat' = filter fce mat'
where
-- to prokazdy je muj pokus o cyklus foreach na všechny prvky v matici ;-)
fce m = reflexivni m && prokazdy rozmer tranzitivni m && prokazdy rozmer antisymetricka m
main = do
let v = uplny_vysledek
putStrLn ("Celkem matic: " ++ show ( length v))
let retezce = map debugMatice v
putStr $ vypis v
return ()
-- vytvori n-prvkový vektor a udělá z něj sqrt(n)-prvkovou čtvercovou matici
matice n = zmaticuj n $ sequence $ ple (n*n)
--
zmaticuj :: Int -> [[Bool]] -> [[[Bool]]]
zmaticuj n m = map (chunk n) m
--rozdělí seznam na pole n-prvkových seznamů
chunk :: Int -> [a] -> [[a]]
chunk n [] = []
chunk n xs = ys : chunk n zs
where (ys,zs) = splitAt n xs
-- vygeneruje vsechny moznosti jak udělat n-prvkový vektor
vektor :: Integer -> [[Bool]]
vektor 1 = [[True], [False]]
vektor n = map fce (vektor (n-1)) ++ map (++[False]) (vektor (n-1))
where
fce = (++[True])
-- to stejné, jen kratšeji
ple :: Int -> [[Bool]]
ple 1 = [[True,False]]
ple n = [True,False] : (ple (n-1))
--
reflexivni [[True]] = True
reflexivni [[False]] = False
reflexivni (b:xb) = head b && reflexivni (map tail xb)
tranzitivni :: [[Bool]] -> (Int, Int) -> Bool
tranzitivni matice (i, j)
| i == j = True
| a == True = all (==True) b
| otherwise = True
where
a = ((sloupec j) . (radek i)) matice
g = radek j matice
b = map fce [1..rozmer]
where fce r
| sloupec r g == True = ((sloupec r) . (radek i)) matice
| otherwise = True
antisymetricka :: [[Bool]] -> (Int, Int) -> Bool
antisymetricka matice (i, j)
| i == j = True
| a == True && b == True = False
| otherwise = True
where
a = ((sloupec j) . (radek i)) matice
b = ((sloupec i) . (radek j)) matice
-- vybrat radek matice a sloupec. Použije se to ((sloupec 2) . (radek 3)) matice
radek 1 mat = head mat
radek m mat = radek (m-1) (tail mat)
sloupec = radek
-- pro všechny i,j od jedničky do n to zavolá funkci a ta funkce musi po kazdy vratit True.
prokazdy :: Int -> ([[Bool]] -> (Int, Int) -> Bool) -> [[Bool]] -> Bool
prokazdy n funkce matice = all (==True) $ map (funkce matice) [(i,j) | i <- [1..n], j <- [1..n]]
ocisluj retezec cislo = show cislo ++ ")\n" ++ retezec
vypis s = unlines (zipWith ocisluj vysle ([1..(length vysle)]))
where
vysle = map debugMatice s
debugMatice :: [[Bool]] -> String
debugMatice matice = foldl radky "" matice
where
-- radky :: [Bool] -> [String] -> [String]
radky acc radek = acc ++ (foldl prvky "" radek) ++ "\n"
where
prvky :: String -> Bool -> String
prvky acc prvek
| prvek == True = acc ++ "1 "
| prvek == False = acc ++ "0 "
Raw
vysledek.txt
Celkem matic: 87
1)
1 1 1 1
0 1 0 1
0 0 1 1
0 0 0 1
2)
1 1 1 1
0 1 0 1
0 0 1 0
0 0 0 1
3)
1 1 1 1
0 1 0 0
0 0 1 1
0 0 0 1
4)
1 1 1 1
0 1 0 0
0 0 1 0
0 1 1 1
5)
1 1 1 1
0 1 0 0
0 0 1 0
0 1 0 1
6)
1 1 1 1
0 1 0 0
0 0 1 0
0 0 1 1
7)
1 1 1 1
0 1 0 0
0 0 1 0
0 0 0 1
8)
1 1 1 0
0 1 0 0
0 0 1 0
1 1 1 1
9)
1 1 1 0
0 1 0 0
0 0 1 0
0 1 1 1
10)
1 1 1 0
0 1 0 0
0 0 1 0
0 1 0 1
11)
1 1 1 0
0 1 0 0
0 0 1 0
0 0 1 1
12)
1 1 1 0
0 1 0 0
0 0 1 0
0 0 0 1
13)
1 1 0 1
0 1 0 1
0 0 1 1
0 0 0 1
14)
1 1 0 1
0 1 0 1
0 0 1 0
0 0 0 1
15)
1 1 0 1
0 1 0 0
0 0 1 1
0 0 0 1
16)
1 1 0 1
0 1 0 0
0 0 1 0
0 1 0 1
17)
1 1 0 1
0 1 0 0
0 0 1 0
0 0 0 1
18)
1 1 0 0
0 1 0 0
0 0 1 1
0 0 0 1
19)
1 1 0 0
0 1 0 0
0 0 1 0
1 1 1 1
20)
1 1 0 0
0 1 0 0
0 0 1 0
1 1 0 1
21)
1 1 0 0
0 1 0 0
0 0 1 0
0 1 1 1
22)
1 1 0 0
0 1 0 0
0 0 1 0
0 1 0 1
23)
1 1 0 0
0 1 0 0
0 0 1 0
0 0 1 1
24)
1 1 0 0
0 1 0 0
0 0 1 0
0 0 0 1
25)
1 0 1 1
0 1 0 1
0 0 1 1
0 0 0 1
26)
1 0 1 1
0 1 0 1
0 0 1 0
0 0 0 1
27)
1 0 1 1
0 1 0 0
0 0 1 1
0 0 0 1
28)
1 0 1 1
0 1 0 0
0 0 1 0
0 0 1 1
29)
1 0 1 1
0 1 0 0
0 0 1 0
0 0 0 1
30)
1 0 1 0
0 1 0 1
0 0 1 0
0 0 0 1
31)
1 0 1 0
0 1 0 0
0 0 1 0
1 1 1 1
32)
1 0 1 0
0 1 0 0
0 0 1 0
1 0 1 1
33)
1 0 1 0
0 1 0 0
0 0 1 0
0 1 1 1
34)
1 0 1 0
0 1 0 0
0 0 1 0
0 1 0 1
35)
1 0 1 0
0 1 0 0
0 0 1 0
0 0 1 1
36)
1 0 1 0
0 1 0 0
0 0 1 0
0 0 0 1
37)
1 0 0 1
1 1 0 1
1 0 1 1
0 0 0 1
38)
1 0 0 1
1 1 0 1
0 0 1 1
0 0 0 1
39)
1 0 0 1
1 1 0 1
0 0 1 0
0 0 0 1
40)
1 0 0 1
0 1 0 1
1 0 1 1
0 0 0 1
41)
1 0 0 1
0 1 0 1
0 0 1 1
0 0 0 1
42)
1 0 0 1
0 1 0 1
0 0 1 0
0 0 0 1
43)
1 0 0 1
0 1 0 0
1 0 1 1
0 0 0 1
44)
1 0 0 1
0 1 0 0
0 0 1 1
0 0 0 1
45)
1 0 0 1
0 1 0 0
0 0 1 0
0 0 0 1
46)
1 0 0 0
1 1 0 1
1 0 1 1
1 0 0 1
47)
1 0 0 0
1 1 0 1
1 0 1 1
0 0 0 1
48)
1 0 0 0
1 1 0 1
1 0 1 0
1 0 0 1
49)
1 0 0 0
1 1 0 1
1 0 1 0
0 0 0 1
50)
1 0 0 0
1 1 0 1
0 0 1 1
0 0 0 1
51)
1 0 0 0
1 1 0 1
0 0 1 0
1 0 0 1
52)
1 0 0 0
1 1 0 1
0 0 1 0
0 0 0 1
53)
1 0 0 0
1 1 0 0
1 0 1 1
1 0 0 1
54)
1 0 0 0
1 1 0 0
1 0 1 1
0 0 0 1
55)
1 0 0 0
1 1 0 0
1 0 1 0
1 1 1 1
56)
1 0 0 0
1 1 0 0
1 0 1 0
1 1 0 1
57)
1 0 0 0
1 1 0 0
1 0 1 0
1 0 1 1
58)
1 0 0 0
1 1 0 0
1 0 1 0
1 0 0 1
59)
1 0 0 0
1 1 0 0
1 0 1 0
0 0 0 1
60)
1 0 0 0
1 1 0 0
0 0 1 1
0 0 0 1
61)
1 0 0 0
1 1 0 0
0 0 1 0
1 1 1 1
62)
1 0 0 0
1 1 0 0
0 0 1 0
1 1 0 1
63)
1 0 0 0
1 1 0 0
0 0 1 0
1 0 1 1
64)
1 0 0 0
1 1 0 0
0 0 1 0
1 0 0 1
65)
1 0 0 0
1 1 0 0
0 0 1 0
0 0 1 1
66)
1 0 0 0
1 1 0 0
0 0 1 0
0 0 0 1
67)
1 0 0 0
0 1 0 1
1 0 1 1
0 0 0 1
68)
1 0 0 0
0 1 0 1
1 0 1 0
0 0 0 1
69)
1 0 0 0
0 1 0 1
0 0 1 1
0 0 0 1
70)
1 0 0 0
0 1 0 1
0 0 1 0
0 0 0 1
71)
1 0 0 0
0 1 0 0
1 0 1 1
1 0 0 1
72)
1 0 0 0
0 1 0 0
1 0 1 1
0 0 0 1
73)
1 0 0 0
0 1 0 0
1 0 1 0
1 1 1 1
74)
1 0 0 0
0 1 0 0
1 0 1 0
1 1 0 1
75)
1 0 0 0
0 1 0 0
1 0 1 0
1 0 1 1
76)
1 0 0 0
0 1 0 0
1 0 1 0
1 0 0 1
77)
1 0 0 0
0 1 0 0
1 0 1 0
0 1 0 1
78)
1 0 0 0
0 1 0 0
1 0 1 0
0 0 0 1
79)
1 0 0 0
0 1 0 0
0 0 1 1
0 0 0 1
80)
1 0 0 0
0 1 0 0
0 0 1 0
1 1 1 1
81)
1 0 0 0
0 1 0 0
0 0 1 0
1 1 0 1
82)
1 0 0 0
0 1 0 0
0 0 1 0
1 0 1 1
83)
1 0 0 0
0 1 0 0
0 0 1 0
1 0 0 1
84)
1 0 0 0
0 1 0 0
0 0 1 0
0 1 1 1
85)
1 0 0 0
0 1 0 0
0 0 1 0
0 1 0 1
86)
1 0 0 0
0 1 0 0
0 0 1 0
0 0 1 1
87)
1 0 0 0
0 1 0 0
0 0 1 0
0 0 0 1
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment