Priklad 3, usporadani

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 "

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