Haskell - male ulozky

Napsal: David

Sada malych uloh z haskellu i s resenim. Hodi se k priprave na zkousku z neproceduralniho programovani.

------------------------------ Male ulohy Haskell ------------------------------

-- 1. RIDKE MATICE -------------------------------------------------------------

{-
Ridka matice je reprezentovana jako trojice (m,n,s), kde m je pocet radek,
n je pocet sloupcu a s je seznam trojic (i,j,a_ij) (kde i je cislo radky,
j je cislo sloupce a a_ij je nenulova hodnota) usporadany vzestupne podle
i a uvnitr radek podle j.

Naprogramujte funkce, ktere v teto reprezentaci realizuji

(a) transpozici matic
(b) nasobeni matic
(c) umocnovani matic (dobrovolne)
-}

-- datova struktura

-- (i,j,a_ij)
type RMVals = (Int,Int,Int)

-- (m,n,s)
type RM = (Int,Int,[RMVals])

-- sortovani trojic

sort3 :: [RMVals] -> [RMVals]
sort3 [] = []
sort3 (x:xs) = sort3 [a | a <- xs, a<- xs, a>=x]

-- transpozice

-- transpozice hodnot
transV :: [RMVals] -> [RMVals]
transV [] = []
transV ((a,b,c):xs) = (b,a,c):(transV xs)

-- transpozice matice

trans :: RM -> RM
trans (m,n,s) = (n,m,sort3 (transV s))

-- nasobeni matic


del0 :: [RMVals] -> [RMVals]    -- vynechani nulovych prvku
del0 [] = []
del0 ((a,b,c):xs) | c==0 = del0 xs
                 | otherwise = (a,b,c):(del0 xs)

-- z matice, ktera muze obsahovat vicekrat jeden prvek udela normalni
-- souctem hodnot techto duplicitnich prvku
-- tedy secte hodnoty stejnych prvku za sebou
simpM :: [RMVals] -> [RMVals]
simpM [] = []
simpM [x] = [x]
simpM ((xa,xb,xc):(ya,yb,yc):xys)
       | xa==ya && xb==yb = simpM ((xa,xb,xc+yc):(xys))
       | otherwise = (xa,xb,xc):(simpM ((ya,yb,yc):xys))


-- vynasobi matice s tim, ze format matice muze obsahovat nulove prvky
mulM :: [RMVals] -> [RMVals] -> [RMVals]
mulM xs ys = simpM (sort3 [(xa,yb,xc*yc)
       | (xa,xb,xc) <- xs, (ya,yb,yc) <- ys, xb==ya])  -- samotne nasobeni mul :: RM -> RM -> RM
mul (m1,n1,s1) (m2,n2,s2) | n1==m2 = (m1,n2,s3)
                           where s3 = del0 (mulM s1 s2)

-- testovaci matice

t1 :: RM
t1 = (2,3,[(1,3,1),(2,1,2),(2,2,1)])

t2 :: RM
t2 = (3,4,[(1,1,6),(1,2,2),(2,1,1),(3,4,1)])

-- testy testovacich matic

r1 :: RM
r1 = trans t1

r2 :: RM
r2 = trans t2

r3 :: RM
r3 = t1 `mul` t2




-- 2. VYPOUSTENI Z BVS  --------------------------------------------------------

{-
Definujte prirozenou reprezentaci binarniho stromu, v jehoz uzlech je ulozena
informace nejakeho typu (podtridy Ord).

Naprogramujte funkci, ktera z binarniho vyhledavaciho stromu vypusti uzly
patrici do zadaneho intervalu (nejsou-li tam zadne takove, bude to identita).
-}


-- datova struktura

data BVSTree a = Nil | BVS ((BVSTree a),a,(BVSTree a)) deriving (Show, Eq)

-- najde min/max v BVS
findMin :: (Ord a) => BVSTree a -> a
findMin (BVS (left,val,right))
       | left==Nil = val
       | otherwise = findMin left

findMax :: (Ord a) => BVSTree a -> a
findMax (BVS (left,val,right))
       | right==Nil = val
       | otherwise = findMax right

-- vypusti ze stromu vsechny uzly od m do n
remBVS :: (Ord a) => BVSTree a -> a -> a -> BVSTree a
remBVS Nil _ _ = Nil

remBVS (BVS (Nil,val,Nil)) m n
       | m <= val && val <= n = Nil         | otherwise = BVS (Nil,val,Nil)  remBVS (BVS (left,val,right)) m n =          if m>n then Nil
       else if n a -> [a] -> Bool
notMember _ [] = True
notMember y (x:xs)
       | y==x = False
       | otherwise = notMember y xs

-- resi danou ulohu
solve3 :: [Int] -> Int -> [Int]
solve3 xs k = take k [x | x <- [1..], x `notMember` xs]  -- testy solve3_test1 = solve3 [8,25,4,7,12,2,1,23] 16 solve3_test2 = solve3 [1,2,3,4,5,6,8,9,10] 1 solve3_test3 = solve3 [] 12     -- 4. 1-2 STROMY ---------------------------------------------------------------  {- Haskell: mam datovy typ reprezentujici 1-2 strom:  data T1 a = Nil | N1 a (T1 a) | N2 a (T1 a) (T1 a)  Ukolem je napsat funkci fold typu:  b -> (a -> b -> b) -> (a -> b -> b -> b) -> T1 a -> b

a funkci hodnota, ktera pomoci funkce fold projde zadany strom a vrati seznam
hodnot z konstruktoru N2 v poradi preorder - tj. vsechny hodnoty z vrcholu,
ktere maji dva potomky

Hint:
V tomto pripade byla fold definovana takto:

fold::b->(a->b->b)->(a->b->b->b)->T1 a->b

b nahradi vrcholy konstruovane Nil
na vrchol s konstruktorem N1 a (T1 a) zavola funkci (a->b->b)
a na N2 a (T1 a) (T1 a) zavola funkci (a->b->b->b)
-}


data T1 a = NilX | N1 a (T1 a) | N2 a (T1 a) (T1 a) deriving (Show, Eq)

-- funkce fold (=svinovani)
fold :: b -> (a -> b -> b) -> (a -> b -> b -> b) -> (T1 a) -> b
fold fNil fN1 fN2 NilX = fNil
fold fNil fN1 fN2 (N1 val next) = fN1 val (fold fNil fN1 fN2 next)
fold fNil fN1 fN2 (N2 val left right) = fN2 val (fold fNil fN1 fN2 left) (fold fNil fN1 fN2 right)

-- funkce hodnota pomoci fold
hodnota :: (T1 a) -> [a]
hodnota = fold [] (\ _ xs -> xs) (\ x xs ys -> (x:xs)++ys)


-- pro lepsi pochopeni jeste funkce pro seznam hodnot ve VSECH vrcholech
hodnota_all :: (T1 a) -> [a]
hodnota_all = fold [] (\ x xs -> (x:xs)) (\ x xs ys -> (x:xs)++ys)

-- testovaci strom

t12_t1 :: (T1 Int)
t12_t1 = N1 20
        (
          N2 13
          (
            N2 1
            (
              N2 21
              (
                N1 9 NilX
              )
              (
                N1 11
                (
                  N1 8 NilX
                )
              )
            )
            (
              N1 2
              (
                N1 5 NilX
              )
            )
          )
          (
            N1 4
            (
              N1 8
              (
                N1 7 NilX
              )
            )
          )
        )

{-
take se da zapsat jako

N1 20 (N2 13 (N2 1 (N2 21 (N1 9 NilX) (N1 11 (N1 8 NilX))) (N1 2 (N1 5 NilX)))
(N1 4 (N1 8 (N1 7 NilX))))
-}

-- testy
t12_test1 = hodnota t12_t1
      



-- 5. BATOH --------------------------------------------------------------------

{-
Je dan seznam A cislo N. Napiste funkci, ktera zjisti, zda je mozne poscitat
(nektere) prvky seznamu, aby soucet vysel N.
-}

-- implementujeme funkci, ktera tento seznam vrati, dana uloha pak by byla
-- pokud seznam neexistuje, vraci se []
batoh :: [Int] -> Int -> [Int]
batoh _ 0 = []
batoh [] _ = []
batoh (x:xs) n
 | sum newBatoh1 == n = newBatoh1
 | sum newBatoh2 == n = newBatoh2
 | otherwise = []
       where newBatoh1 = x:(batoh xs (n-x))
             newBatoh2 = batoh xs n

-- testy
b1 = batoh [1,58,3,9,2,1,85,2,6,51,8,69,21] 34
b2 = batoh [1,58,3,9,2,1,85,2,6,51,8,69,21] 35
b3 = batoh [1,58,3,9,2,1,85,2,6,51,8,69,21] 60
b4 = batoh [2,4,8,16,32,64,128] 91
b5 = batoh [1,2,4,8,16,32,64,128] 91
b6 = batoh [1,5..] 91
b7 = batoh [1,1..] 654




-- 6. PERMUTACE USPORADANI -----------------------------------------------------

{-
Je dan seznam A - seznam dvojic prvku, urcujici castecne usporadani. Vyrobte
seznam vsech permutaci puvodniho seznamu, ktere vyhovuji castecnemu
usporadani.
-}

-- vrati seznam bez jendoho prvku
without :: (Eq a) => [a] -> a -> [a]
without [] _ = []
without (x:xs) a
 | a==x = xs `without` a
 | otherwise = x:(xs `without` a)


-- not member vraci, zda prvek neni v seznamu
notMember1 :: (Eq a) => a -> [a] -> Bool
notMember1 _ [] = True
notMember1 y (x:xs)
       | y==x = False
       | otherwise = notMember1 y xs

-- ze seznamu prvku vylouci opakujici se prvky
uniq :: (Eq a) => [a] -> [a]
uniq [] = []
uniq (x:xs)
       | x `notMember1` xs = x:(uniq xs)
       | otherwise = uniq xs

-- vrati seznam prvku ze seznamu dvojic
tuplList :: (Eq a) => [(a,a)] -> [a]
tuplList [] = []
tuplList ((one,two):xs) = uniq (one:two:(tuplList xs))

-- vytvori seznam vsech permutaci prvku
perm :: (Eq a) => [a] -> [[a]]
perm [] = [[]]
perm xs = [one:others | one <- xs, others <- (perm (xs `without` one)) ]  -- vrati suffix seznamu od zadaneho prvku  upto :: (Eq a) => [a] -> a -> [a]
upto [] _ = []
upto (x:xs) a
       | x==a = [x]
       | otherwise = x:(xs `upto` a)

-- overi, zda permutace splnuje podminky usporadani
validone :: (Eq a) => [a] -> (a,a) -> Bool
validone p (a,b) = b `notMember1` (p `upto` a)

valid :: (Eq a) => [a] -> [(a,a)] -> Bool
valid p [] = True
valid p (cond:conds) = validone p cond && valid p conds

-- vyresi ulohu tak, ze ze seznamu dvojic udela seznam prvku, z nej vytvori
-- vsechny permutace, ktere pak prefiltruje pres podminky usporadani
permus :: (Eq a) => [(a,a)] -> [[a]]
permus a = [p | p <- perm (tuplList a), valid p a]  -- testy perm_test1 = permus [(1,2),(17,18),(16,17)]     -- 7. PREVOD N-ARNI -> BINARNI -------------------------------------------------

{-
Sestavte funkci realizujici kanonickou reprezentaci obecneho stromu pomoci
binarniho ("levy syn" = prvorozeny syn, "pravy syn" = mladsi bratr).
-}

-- datova struktura

data TreeN a = NodeN a [TreeN a] deriving (Eq, Show)
data TreeB a = NilB | NodeB a (TreeB a) (TreeB a) deriving (Eq, Show)


--
convNBs :: (Eq a) => [TreeN a] -> (TreeB a)
convNBs [] = NilB
convNBs [NodeN a []] = NodeB a NilB NilB
convNBs [NodeN a [x]] = NodeB a NilB (convNB x)
convNBs [NodeN a xs] = NodeB a (convNBs xs) NilB
convNBs ((NodeN a xs):ts) = NodeB a (convNBs xs) (convNBs ts)

--
convNB :: (Eq a) => (TreeN a) -> (TreeB a)
convNB tree = convNBs [tree]

-- testovaci data

treeN1 :: TreeN Int
treeN1 = NodeN 10
        [
          NodeN 5
          [
            NodeN 2 [],
            NodeN 7 []
          ],
          NodeN 7
          [
            NodeN 10 []
          ],
          NodeN 12 [],
          NodeN 3
          [
            NodeN 18 [],
            NodeN 1 [],
            NodeN 40 []
          ]
        ]

{-
take se da zapsat jako

NodeN 10 [NodeN 5 [NodeN 2 [],NodeN 7 []],NodeN 7 [NodeN 10 []],NodeN 12 [],
NodeN 3 [NodeN 18 [],NodeN 1 [],NodeN 40 []]]
-}

treeN2 :: TreeN Int
treeN2 = NodeN 10
        [
          NodeN 5
          [
            NodeN 4 [],
            NodeN 1 []
          ],
          NodeN 7 [],
          NodeN 2 []
        ]


-- testy

treeNB_t1 = convNB treeN1
treeNB_t2 = convNB treeN2




-- 8. PRUCHOD KANONICKOU REPREZENTACI ------------------------------------------

{-
Naprogramujte funkci, ktera na zaklade kanonicke reprezentace obecneho stromu
pomoci binarniho stromu vyda seznam vznikly pruchodem puvodniho obecneho
stromu do sirky.
-}

-- datova struktura - shodna s predchozi ulohou
{-
data TreeN a = NodeN a [TreeN a] deriving (Eq, Show)
data TreeB a = NilB | NodeB a (TreeB a) (TreeB a) deriving (Eq, Show)
-}

-- vraci value X (hodnotu v uzlu)
getVal :: (TreeB a) -> a
getVal (NodeB a _ _) = a

-- vraci leveho syna
getLeft :: (TreeB a) -> (TreeB a)
getLeft (NodeB _ left _) = left

-- vraci praveho syna
getRight :: (TreeB a) -> (TreeB a)
getRight (NodeB _ _ right) = right

-- reseni ulohy podle schematu:
-- 1) je-li fronta prazda -> konec, jinak odeber X prvek z fronty
-- 2) jestlize X==NilB jdi na 1) jinak na 3)
-- 3) dej value X na vystup (hodnota v uzlu)
-- 4) vloz left X do fronty a pro X:=right X proved 2)
--    rekurze pro right X je trikova pomoci zarazeni right X na zacatek fronty
--    a zavolani 1) tudiz se vlastne provede 2) pro right X

tKBFSq :: (Eq a) => [TreeB a] -> [a]
tKBFSq [] = []
tKBFSq (x:xs)
       | x==NilB = tKBFSq xs
       | otherwise = [getVal x]++(tKBFSq ([getRight x] ++ xs ++ [getLeft x]))

-- zavola funkci s frontou o jednom prvku
tKBFS :: (Eq a) => (TreeB a) -> [a]
tKBFS tree = tKBFSq [tree]

-- testovaci data
treeBK1 :: TreeB Int
treeBK1 = NodeB 10
         (
           NodeB 5
           (
             NodeB 2
             NilB
             (
               NodeB 7 NilB NilB
             )
           )
           (
             NodeB 7
             (
               NodeB 10 NilB NilB
             )
             (
               NodeB 12
               NilB
               (
                 NodeB 3
                 (
                   NodeB 18
                   NilB
                   (
                     NodeB 1
                     NilB
                     (
                       NodeB 40 NilB NilB
                     )
                   )
                 )
                 NilB
               )
             )
           )
         ) NilB

{-
take se da napsat jako

NodeB 10 (NodeB 5 (NodeB 2 NilB (NodeB 7 NilB NilB)) (NodeB 7 (NodeB 10 NilB
NilB) (NodeB 12 NilB (NodeB 3 (NodeB 18 NilB (NodeB 1 NilB (NodeB 40 NilB
NilB))) NilB)))) NilB

nebo jako vysledek predchozi ulohy

treeNB_t1
-}

-- testy

tKBFS_t1 = tKBFS treeBK1
tKBFS_t2 = tKBFS treeNB_t1
tKBFS_t3 = tKBFS treeNB_t2




-- 9. OPERACE NAD FUNKCI APL ---------------------------------------------------

{-
Definujte funkci apl se ctyrmi parametry:
  S ... seznam prvku nejakeho typu
  f ... unarni funkce aplikovatelna na prvky tohoto typu
  g ... binarni (vlevo asociativni) funkce aplikovatelna na prvky tohoto typu
  p ... pocatecni hodnota

Funkce apl "provede funkci f na vsechny prvky seznamu S, za takto vznikly
seznam pripoji prvek p a spocita vysledek, ktery vznikne tim, ze do vsech
mezer noveho seznamu vlozime funkci g". (To neni navod k programovani,
ale popis funkce.)

Na zaklade funkce apl vytvorte nasledujici funkce:
  a) minimum prvku z neprazdneho seznamu
  b) aritmeticky prumer z prvku neprazdneho seznamu
  c) geometricky prumer z prvku neprazdneho seznamu (n-ta odmocnina ze soucinu
     jeho prvku - n je delka seznamu.)
  d) harmonicky prumer z prvku neprazdneho seznamu (druha odmocnina ze souctu
     druhych mocnin jeho prvku)

Navod: Maji funkce b) az d) neco spolecneho?
-}

{-
zrejme tedy

apl [1,2,3] (*3) (+) 100

udela seznam

[3,6,9]

potom nasklada funkce g:

(((3 + 6) + 9) + 100)

a vysledek tedy bude

118
-}

-- funkce apl je slozeni foldl a map
apl :: [a] -> (a -> a) -> (a -> a -> a) -> a -> a
apl s f g p = foldl g p (map f s)

-- minimum prvku z neprazdneho seznamu
aplMin :: (Ord a) => [a] -> a
aplMin (x:xs) = apl xs (\ x -> x) (min) x

-- aritmeticky prumer z prvku neprazdneho seznamu
aplAvA :: (Fractional a) => [a] -> a
aplAvA (x:xs) = apl xs (\ y -> y/lxs) (+) (x/lxs)
       where lxs = fromInt (length (x:xs))

-- geometricky prumer z prvku neprazdneho seznamu
aplAvG :: [Double] -> Double
aplAvG (x:xs) = apl xs (\ y -> y**(1/lxs)) (*) (x**(1/lxs))
       where lxs = fromInt (length (x:xs))

-- harmonicky prumer z prvku neprazdneho seznamu
aplAvH :: [Double] -> Double
aplAvH (x:xs) = sqrt (apl xs (\ y -> y**2) (+) (x**2))
       where lxs = fromInt (length (x:xs))

-- testy

apl_t1 = apl [1,2,3] (*3) (+) 100
apl_t2 = aplMin [4,1,3,6,5,-3,2,6,0]
apl_t3 = aplAvA [5,9,1,0,4,5]
apl_t4 = aplAvG [16,9,12]
apl_t5 = aplAvH [3,5,4,10]              -- = 12.24




-- 10. CETNOST SLOV ------------------------------------------------------------

{-
Typ string je definovan takto: type String = [Char]. Krome zapisu
['a','n','n','a'] muzeme ekvivalentne psat i "anna". Naprogramujte funkci,
ktera dostane jako vstup string Doc (ktery pro jednoduchost muze obsahovat
jen mala pismena anglicke abecedy, znak \n a znak mezera) a cislo N a vyrobi
z nej "abecedni index vyskytu slov delky alespon N na radcich" dokumentu Doc,
tj. provede s nim nasledujici operace (budeme je demonstrovat na priklade):

Doc=="jak kul husar\nluk\nstal jak\n\nkul v plote\nuz jsem zase v tom"

N==3

 a) Rozdeli vstupni string doc na posloupnost radek (stringu) Lines
    (radky jsou oddeleny znakem \n)

    ["jak kul husar", "luk", "stal jak", [], "kul v plote",
     "uz jsem zase v tom"]


 b) Radky v seznamu Lines ocisluje - vystupem bude tedy seznam dvojic
    (cisloradky, radka)

    [(1, "jak kul husar"), (2, "luk"), (3, "stal jak"), (4, ""),
     (5, "kul v plote"), (6, "uz jsem zase v tom")]


 c) Rozdeli kazdou radku na slova - vyda seznam dvojic (cisloradky, slovo)

    [(1, "jak"), (1, "kul"), (1, "husar"), (2, "luk"), (3, "stal"),
     (3, "jak"), (5, "kul"), (5, "v"), (5, "plote"), (6, "uz"),
     (6, "jsem"), (6, "zase"), (6, "v"), (6, "tom")]


 d) Usprada tento seznam podle druhe slozky - slova

    [(1, "husar"), (1, "jak"), (3, "jak"), (6, "jsem"), (1, "kul"),
     (5, "kul"), (2, "luk"), (5, "plote"), (3, "stal"), (6, "tom")
     (6, "uz"), (5, "v"), (6, "v"), (6, "zase")]


 e) Prepracuje vstupni seznam na seznam dvojic
    (Slovo, SeznamCiselRadkuNaKterychSeTotoSlovoVyskytuje)

    [("husar", [1]), ("jak", [1,3]), ("jsem", [6]), ("kul", [1,5]),
     ("luk", [2]), ("plote", [5]), ("stal", [3]), ("tom", [6]),
     ("uz", [6]), ("v", [5,6]), ("zase", [6])]


 f) Vypusti slova kratsi nez vstupni parametr N (v priklade == 3)

    [("husar", [1]), ("jak", [1,3]), ("jsem", [6]), ("kul", [1,5]),
     ("luk", [2]), ("plote", [5]), ("stal", [3]), ("tom", [6]),
     ("zase", [6])]

-}

-- porovnani zacatku retezce s patternem
match :: String -> String -> Bool
match str pat = (take (length pat) str) == pat

-- ze stringu vybere string az do prvniho vyskytu patternu
upToStr :: String -> String -> String
upToStr "" _ = []
upToStr str@(x:xs) pat
       | str `match` pat = []
       | otherwise = x:(xs `upToStr` pat)

-- ze stringu vybere string po prvnim vyskytu patternu
fromStr :: String -> String -> String
fromStr str "" = str
fromStr "" _ = []
fromStr str@(x:xs) pat@(y:ys)
       | str `match` pat = xs `fromStr` ys
       | otherwise = (xs `fromStr` pat)


-- cast a)
makeLines :: String -> String -> [String]
makeLines [] _ = []
makeLines doc delim = [(doc `upToStr` delim)] ++ (makeLines (doc `fromStr` delim) delim)

-- cast b)
numberLines :: [String] -> [(Int,String)]
numberLines lines = numLines 1 lines

-- reseni b) s akumulatorem cisel
numLines :: Int -> [String] -> [(Int,String)]
numLines _ [] = []
numLines n (x:xs) = [(n,x)] ++ numLines (n+1) xs

-- cast c)
splitLines :: [(Int,String)] -> [(Int,String)]
splitLines [] = []
splitLines ((n,str):xs) = map ((,) n) (makeLines str " ") ++ splitLines xs

-- cast d)
sortPairs :: [(Int,String)] -> [(Int,String)]
sortPairs [] = []
sortPairs ((j,s):xs) = (sortPairs [(i,r) | (i,r) <- xs, r<- xs, s<=t])  -- cast e)  joinPairLists :: [(String,[Int])] -> [(String,[Int])]
joinPairLists [] = []
joinPairLists ((s,i):(t,j):xs)
       | s==t = joinPairLists ([(s,i ++ j)] ++ xs)
       | otherwise = [(s,i)] ++ joinPairLists ((t,j):xs)
joinPairLists xs = xs

joinPairs :: [(Int,String)] -> [(String,[Int])]
joinPairs xs = joinPairLists (map (\ (i,s) -> (s,[i])) xs)

-- cast f)
cutShorts :: [(String,[Int])] -> Int -> [(String,[Int])]
cutShorts [] _ = []
cutShorts ((s,i):xs) n
       | length(s) < n =" cutShorts" otherwise =" [(s,i)]"> Int -> [(String,[Int])]
wordFreq doc n = cutShorts (joinPairs (sortPairs (splitLines (numberLines (makeLines doc "\n"))))) n

-- testovaci data
doc :: String
doc = "jak kul husar\nluk\nstal jak\n\nkul v plote\nuz jsem zase v tom"

-- testy
wF_t1 = makeLines doc "\n"
wF_t2 = numberLines wF_t1
wF_t3 = splitLines wF_t2
wF_t4 = sortPairs wF_t3
wF_t5 = joinPairs wF_t4
wF_t6 = cutShorts wF_t5 3
wF_t7 = wordFreq doc 3




-- 11. VYPOUSTENI BVS UZLU -----------------------------------------------------

{-
Definujeme prirozenou reprezentaci binarniho stromu, v jehoz uzlech je
ulozena informace nejakeho typu (podtridy Ord).
Naprogramujte funkci, ktera z BVS vypusti uzel se zadanou hodnotou.
-}

-- jedna se o lehci variantu ulohy 2.


-- THE END ---------------------------------------------------------------------