Poslední články

Memoizace v Haskellu

aneb zatracené monády!

Poslední dobou si znovu hraji s Haskellem. Už jsem ho zkoušel několikrát, ale vždycky jsem to vzdal. Vypadá to, že teď už s ním dovedu aspoň trochu vyjít :)

Pro mě se vyznačuje hlavně tím, že píšete program, píšete, píšete, a pak uložíte, zkusíte spustit/zkompilovat, a zjistíte, že máte chyby v typech. Začnete opravovat chyby v typech, ty se zatím promítnou do všech možných částí kódu, a když potom konečně opravíte i tu poslední, program funguje přesně tak, jak jste chtěli. Haskell z run-time chyb dělá compile-time chyby.

Kvůli jednomu Project Euler problému jsem chtěl použít memoizaci. Což o to, na internetu je spousta článků, jak v Haskellu udělat memoizaci, problém je v tom, že jsem chtěl memoizovat funkci s více argumenty!

Našel jsem víceméně srozumitelný článek a jal se ho upravovat pro své potřeby. No ani za nic. Prostě ne. Skončilo to chybovou hláškou "Pro tuto funkci potřebujete Math level 41 a Monad level 73" (dobře, přeháním... jen 70). Vydal jsem se na IRC (#haskell), kde mě rychle uvedli na pravou míru. A protože bych řešení zapomněl, zvěčním si to tady (a tady).

-- from http://www.nadineloveshenry.com/haskell/memofib.html#memoize
-- had some problems when function had more arguments though, so saving this for future me :)

import Debug.Trace
import Data.Map as Map
import Control.Monad.State.Lazy as State

--------------------------------------------

type StateMap a b = State (Map a b) b

memoizeM :: (Show a, Show b, Ord a) => 
            ((a -> StateMap a b) -> (a -> StateMap a b)) -> (a -> b)
memoizeM t x = evalState (f x) Map.empty where
  g x = do
    y <- t f x  
    m <- get
    put $ Map.insert x y m
    newM <- get
    return y
    --return $ trace ("Map now containsn" ++ Map.showTree newM) y
  f x = get >>= m -> maybe (g x) return (Map.lookup x m)


--------------------------------------------
{-

how to do it:

 - type:
     :: Type1 -> Type2 -> Endtype
   rewrite into
     :: Monad m =>
        ((Type1, Type2) -> m Endtype)
      -> (Type1, Type2) -> m Endtype

 - definition:
     myFun x y
   rewrite into
     myFun f (x,y)

 - call:
     myFun x y
   rewrite into
     f (x,y)
   and probably inside return or its own var (cause it's monad)

-}
--------------------------------------------

-- one argument

normalFib :: Integer -> Integer
normalFib 0 = 1
normalFib 1 = 1
normalFib n = normalFib (n-1) + normalFib (n-2)

fibM :: Monad m =>
        (Integer -> m Integer)
      -> Integer -> m Integer
fibM f 0 = return 1
fibM f 1 = return 1
fibM f n = do
  a <- f (n-1)
  b <- f (n-2)
  return (a+b)

fib n = memoizeM fibM n

--------------------------------------------

-- more arguments

normalAdd :: Int -> Int -> Int
normalAdd 0 y = y
normalAdd x y = normalAdd (x-1) (y+1)

addM :: Monad m =>
        ((Int, Int) -> m Int)
      -> (Int, Int) -> m Int
addM f (0,y) = return y
addM f (x,y) = do
  answer <- f ((x-1), (y+1))
  return answer

add x y = memoizeM addM (x,y)

--------------------------------------------

main = do
        print $ normalFib 10
        print $ fib 10
        print $ normalAdd 5 6
        print $ add 5 6

Převod vícenásobné rekurze na iteraci

aneb kvůli stack overflow šaháme na StackOverflow.com

Občas si hraju na Project Euler - stránkách, kde jsou vystaveny (většinou matematické) úlohy, u kterých je cílem napsat program, který je vyřeší pokud možno za méně než minutu.

Na jazyku ani konečném řešení nezáleží, jde spíš o cestu, o průzkum bitevního pole (čti: hledání vlastností a algoritmů na Wikipedii, MathWorldu, počmárání tuny papíru při snaze najít opakující se vzor, který by šlo využít) a o ten pocit, kdy zadáte odpověď a ukáže se vám ... tohle. Ááááách. ;)

Není nad to :)

Před pár hodinami jsem se podíval na jeden z nových problémů, který má něco do činění s nesoudělnými čísly. Mě tedy zajímal hlavně algoritmus pro jejich generování:

def nesoudelna(n):
    # n = vrchni limit, nechceme v parech vetsi cisla nez toto

    # udelame seznam paru, ktery pak budeme vracet
    pary = []

    def rekurze(x,y):

        # jsme v limitu?
        # vzdy plati: x > y
        if x <= n:

            # vlozime to do seznamu
            pary.append((x,y))

            # funkci zavolame na dalsich parech
            rekurze(2*x - y, x)
            rekurze(2*x + y, x)
            rekurze(x + 2*y, y)

    # funkci zavolame na prvnich dvou parech
    rekurze(2,1)
    rekurze(3,1)

    # vse jsme vycerpali, vracime hotovy seznam
    return pary

Jenže ouha: tato funkce bude fungovat jen pro relativně malá n. Když bude n větší, vnitřní funkce se zavolá tolikrát, že mi program zařve na přetečení zásobníku.

print len(nesoudelna(50))   # 773
print len(nesoudelna(5000)) # RuntimeError: maximum recursion depth exceeded

To se většinou řeší převodem na funkci iterativní (tedy místo volání sebe sama používající nějakou smyčku). Vím, jak převést klasickou rekurzivní funkci, ale co když se volá vícekrát? StackOverflow.com dává odpověď: v tu chvíli je třeba použít zásobník.

Budeme jím napodobovat právě ten zásobník, který nám přetekl při rekurzivní funkci. Ale protože si na něj místo alokujeme sami, není nijak extra omezený. Může nám zabrat gigabajty paměti, programu to vadit nebude. Systémový zásobník by v tu chvíli už dávno spadl.

Využijeme toho, že Python má u seznamu funkce append() a pop() - což je přesně to, co potřebujeme, abychom zásobník mohli vytvořit. Náš zásobník bude obsahovat dvojice "argumentů," které je třeba zpracovat. S každým dalším voláním se teoreticky rozšíří o dvě dvojice (jednu jsme vyřešili, tři přidáváme), ale postupem času začneme narážet na náš limit n a prvků v zásobníku začne ubývat. Jdem na to:

def nesoudelna_iter(n):
    # n = vrchni limit, nechceme v parech vetsi cisla nez toto

    # udelame seznam paru, ktery pak budeme vracet
    pary = []

    # pocatecni hodnoty
    zasobnik = [(2,1),(3,1)]

    # dokud v zasobniku neco je
    while zasobnik:

        # vezmem to a dame do x,y
        x,y = zasobnik.pop()

        # jsme v limitu?
        # vzdy plati: x > y
        if x <= n:

            # vlozime to do seznamu
            pary.append((x,y))

            # do "todo" seznamu pridame dalsi vetve
            zasobnik.append((2*x - y, x))
            zasobnik.append((2*x + y, x))
            zasobnik.append((x + 2*y, y))
    
    # vse jsme vycerpali, vracime hotovy seznam
    return pary

Iterativní verze se liší tímto (zvýrazněné řádky výše):

  • ř. 8 - na začátku si definujeme zásobník s "argumenty"
  • ř. 11 - rozeběhneme to ne voláním vnitřní funkce, ale smyčkou while
  • ř. 14 - v té vyprazdňujeme zásobník
  • ř. 24-26 - místo znovuvolání vnitřní funkce přidáváme do zásobníku

A když tuto novou verzi zkusíme spustit?

print len(nesoudelna_iter(50))   # 773
print len(nesoudelna_iter(5000)) # 7600457

That's all, folks!

EDIT 3. 7. 2012: pročítám se tutoriálem Erlangu a narazil jsem na tuto skvělou ilustraci rekurze. :)

reCURSION

PHP - smazání adresáře

aneb proč by to mělo jít jednoduše?

Taky se vám občas hryzne FTP a dělá psí kusy, že ne, v žádném případě to nesmažu, co si o mně jako myslíš, blbečku?

Mně se to stalo párkrát (třeba včera při upgradu Symphony CMS) a tak jsem na to už připravený. Domnívám se, že potíž je ve skrytých souborech (kdyžtak mě někdo opravte). UNIX nedovolí smazat neprázdný adresář, musí se nejprve smazat jeho obsah. A pravděpodobně jste všechen nesmazali, ikdyž si to myslíte.

Občas se výborná řešení najdou v komentářích v PHP manuálu (http://php.net/nějaká_funkce). A právě tam jsem našel tento poklad: (mírně upraven)

<?php

function remove_dir($dir)
{
  if (!$dh = @opendir($dir)) return;
  while (false !== ($obj = readdir($dh)))
  {
    if ($obj == '.' || $obj == '..') continue;
    if (!@unlink($dir.'/'.$obj)) remove_dir($dir.'/'.$obj);
  }
  closedir($dh);
  @rmdir($dir);
}

// pouziti:
// remove_dir('name_of_directory');

?>

Zatím mě nezklamal a vždycky všechno poslušně smazal i tam, kde na to byl FTP klient krátký. Tak snad poslouží i vám. ;)