Mosty w grafie - Haskell

Zbliża się powrót do szkoły więc trzeba powrócić do implementowania algorytmów. Jako projekt do wykonania dostałem napisanie algorytmu znajdującego mosty w grafie i działającego w czasie O(n+m), gzie n to liczba wierzchołków, a m to liczba krawędzi. Moje upodobania na szczęście się przez święta nie zmieniły więc napisałem to w Haskellu.

Algorytm znajdowania mostów wykorzystuje algorytm DFS. Zmiany są niewielkie, a mianowicie:

• przeglądając dany wierzchołek nadajemy mu od razu kolejny numer,
• nadajemy mu także początkową wartość low taką samą jak numer wierzchołka,
• dalej postępujemy jak w algorytmie DFS, czyli przeglądamy wszystkie sąsiadujące wierzchołki i jeżeli są nieodwiedzone to wrzucamy je na stos po czym wywołujemy procedurę rekurencyjnie z nowym stosem,
• wracając z rekurencji sprawdzamy wszystkie sąsiadujące wierzchołki, różne od tego, z którego przyszliśmy (czyli różne od ojca) i jeżeli sąsiad był odwiedzony i ma wartość low mniejszą od wierzchołka, w którym jesteśmy to zmieniamy naszą wartość low na wartość tego sąsiada.

Po wykonaniu tej procedury, wierzchołki, które mają numer równy low tworzą mosty.

Algorytm stanie się bardziej jasny jak przeanalizujemy kod:


Linie od 7 do 10 definiują nam typy danych, tak aby się nam lepiej programowało. Wierzchołek (Vertex) ma jak widać jakiś numer, jakąś listę krawędzi oraz jakąś wartość low. Krawędź to po prostu liczba, a most z kolei to para liczb oznaczająca parę wierzchołków tworzących jeden most.

Funkcja findBridges przyjmuje tablicę wierzchołków i zwraca listę mostów. Dalej treść funkcji czytamy od końca. Zatem wywołujemy funkcję dfsBridges dla pierwszego wierzchołka i naszej tablicy, która uzupełni nam podanym wyżej algorytmem wartości low oraz numery wierzchołków i zwróci te dane jako nową tablicę wierzchołków. Funkcja assocs zamieni nam tablicę na listę par typu (indeks, Vertex). Przeglądamy tą listę (foldr) i dla każdej pary sprawdzamy czy wartość low jest równa numerowi wierzchołka (czyli wyszukujemy wierzchołki tworzące mosty). Jeżeli nie to pomijamy ten wierzchołek. Natomiast jeżeli tak to bierzemy z listy sąsiadów tylko te wierzchołki, które mają wartość low różną od wartości low danego wierzchołka (filter). Dalej z tej listy tworzymy pary (mosty) w ten sposób: bierzemy numer naszego wierzchołka jako pierwszą liczbę w parze oraz dany element uzyskanej przed chwilą listy jako drugą liczbę (zip). Na koniec zostaje nam dołączenie tej listy do listy już uzyskanej.

Funkcja dfsBridges przyjmuje "stos" (w naszym przypadku po prostu listę) indeksów wierzchołków, ich tablicę oraz aktualny numer do przydzielenia. Zwraca natomiast uzupełnioną tablicę wierzchołków o numer i wartość low. Tą funkcję zaczynamy czytać od where. Na początku inicjalizujemy wartości naszego wierzchołka czyli przydzielamy mu numer oraz low równy aktualnemu numerowi - wartość d. Odbywa się to w ten sposób, że tworzymy nową tablicę wierzchołków (initArr), która zawiera te same dane za wyjątkiem naszego wierzchołka (//). Dalej obliczamy nowy "stos" przeglądając sąsiadów aktualnego wierzchołka i jeżeli któryś z nich nie był jeszcze odwiedzony (czyli ma numer większy niż -1) to wrzucamy go na koniec listy.

Kolejnym krokiem jest wywołanie naszej funkcji rekurencyjnie z nowym "stosem" i nową tablicą oraz kolejnym numerem. Jak przypadkiem skończy się nam "stos" (czyli lista będzie pusta, czyli wszystkie wierzchołki zostały odwiedzone) to zwracamy uzyskaną tablicę wierzchołków. Wracając z rekurencji przeglądamy sąsiadów naszego wierzchołka ale z nowo uzyskanej tablicy. Dalej jest już jak w algorytmie czyli jak któryś z sąsiadów był odwiedzony i nie jest to wierzchołek, z którego przyszliśmy oraz ma mniejszą wartość low to bierzemy jego wartość low. Na koniec zmieniamy tablicę tak aby nasz wierzchołek uzyskał tą nową wartość low i ją zwracamy.

Jeżeli ktoś jeszcze nie za bardzo rozumie co to jest ta wartość low to w skrócie można powiedzieć, że jeżeli napotkamy cykl w grafie to wszystkim wierzchołkom w tym cyklu nadajemy jednakową wartość low (obrazowo można powiedzieć, że kolorujemy cykle w grafie).

To właściwie wszystko. Czekam na komentarze.

Parsowanie plików pcap w Haskellu

Dzisiaj przykład prostego parsowania w Haskellu. Zadanie to znalazłem na stronie firmy Tsuru Capital jako code sample do napisania, gdybyśmy ubiegali się o stanowisko programisty. Opis zadania znajduje się tutaj. Jest tam dostępny także przykładowy plik z danymi w formacie pcap.

W skrócie to co mamy zrobić to:

• wyciągnąć z pliku linie, które zaczynają się od znaków B6034,
• daną linię sparsować,
• i wypisać ją w ten sposób:
  

     @ ... @ @ ... @

To jak dokładnie wygląda linia danych jest opisane na stronie z opisem zadania. Generalnie wystarczy wypisać tylko część danych z linii oraz w nieco innej kolejności.
• uruchamiając nasz program z parametrem "-r" powinien on sortować dane po zawartej w linii informacji "accept-time". Dla ułatwienia podana jest informacja, że różnica między czasem wysłania pakietu (czyli pkt-time) a accept-time nigdy nie jest większa niż 3 sekundy.

No to zaczynamy. Na początku warto wspomnieć o pakiecie Network.Pcap, który ułatwi nam czytanie z takich plików. Jedyne co nam pozostaje zrobić to parsowanie linii, ewentualne jej sortowanie oraz wypisanie przeczytanych danych. Zacznijmy od zdefiniowania sobie głównych typów danych:

module Main where

import Network.Pcap
import qualified Data.ByteString.Char8 as BS

data MarketData = MarketData {
      issueCode  :: BS.ByteString
    , bids       :: [(BS.ByteString, BS.ByteString)]
    , asks       :: [(BS.ByteString, BS.ByteString)]
    , acceptTime :: AcceptTime
    }

data AcceptTime = AcceptTime {
      hh :: BS.ByteString
    , mm :: BS.ByteString
    , ss :: BS.ByteString
    , uu :: BS.ByteString
    }

Jako, że pakiet Network.Pcap dostarcza nam danych w ByteStringach to wszędzie będziemy ich używać. Na uwagę zasługują pola bids i asks w MarketData. Otóż są to pary, w których pierwsza wartość to cena a druga to liczba danego towaru. Stworzone wyżej typy danych reprezentują jedną linię w pliku z danymi. Teraz sprawmy aby się automatycznie dobrze wypisywały:

instance Show AcceptTime where
    show (AcceptTime h m s u) = (BS.unpack h) ++ ":"
                                              ++ (BS.unpack m)
                                              ++ ":"
                                              ++ (BS.unpack s)
                                              ++ "."
                                              ++ (BS.unpack u)

instance Show MarketData where
    show (MarketData i b a t) = (show t)
        ++ " " ++ (BS.unpack i)
        ++ " " ++ (drop 1 $ foldr (\(ty, pr) ac ->
            "@" ++ (BS.unpack ty) ++ "@" ++ (BS.unpack pr) ++ ac) [] b)
        ++ " " ++ (drop 1 $ foldr (\(ty, pr) ac ->
            "@" ++ (BS.unpack ty) ++ "@" ++ (BS.unpack pr) ++ ac) [] a)

W ten sposób wystarczy wywołać funkcję show na typie MarketData i otrzymamy linię opisaną w zadaniu.

Przechodzimy zatem do najtrudniejszej części czyli parsowania danych. W pakiecie Network.Pcap dostępna jest funkcja dispatch, która przyjmuje otworzony plik (może to być również gniazdo sieciowe), liczbę pakietów do przeczytania (w naszym przypadku -1 czyli cały plik) oraz funkcję, która będzie przetwarzać dany pakiet o typie PktHdr -> ByteString -> IO (). Zanim jednak przejdziemy do napisania funkcji parsującej przypomnijmy sobie warunek czytania danego pakietu. Otóż musi się on zaczynać od znaków B6034, a to z kolei oznacza, że mogą pojawić się pakiety, które tego warunku spełniać nie będą. W takim wypadku musimy je pominąć. Napiszmy więc funkcję sprawdzającą ten warunek i jeżeli on zachodzi to parsujemy daną linię i ją wyświetlamy, a jeżeli nie to nic nie robimy. Nazwijmy ją showData:

prefix :: BS.ByteString
prefix = (BS.pack "B6034")

showData :: PktHdr
         -> BS.ByteString
         -> IO ()
showData hdr dat = do
    let (_, _d) = BS.breakSubstring prefix dat
        (sec, msec) = (hdrTime hdr) `divMod` 1000000
    if (BS.length _d) > 0
        then putStrLn $ (show $ TOD (toInteger sec) (toInteger (msec*1000000)))
            ++ " " ++ (show $ parseData _d)
        else return ()

To wszystko co występuje przed wywołaniem funkcji parseData to wyświetlenie po prostu pkt-time, który nie jest zawarty w danych ale w nagłówku pakietu. Sprawdzanie odbywa się w ten sposób, że dzielimy linię na dwie części: tam gdzie występuje prefix i to co przed nim. Jeżeli uda się podzielić linię w ten sposób to znaczy, że możemy parsować:

parseData :: BS.ByteString
          -> MarketData
parseData line = MarketData (BS.take 12 l) _bids _asks (AcceptTime h m s u)
  where
    l = BS.drop 5 line
    (_bids, r1) = takeBids $ BS.drop 24 l
    (_asks, r2) = takeAsks $ BS.drop 7 r1
    (h, r3) = BS.splitAt 2 (BS.take 8 $ BS.drop 50 r2)
    (m, r4) = BS.splitAt 2 r3
    (s, u) = BS.splitAt 2 r4
 
takeBids :: BS.ByteString
         -> ([(BS.ByteString, BS.ByteString)], BS.ByteString)
takeBids bs = takeBids' bs (5::Integer)
  where
    takeBids' b n
        | n > 0     = let (_b, _r) = takeBids' (BS.drop 12 b) (n-1)
                      in (_b ++ [(BS.splitAt 5 $ BS.take 12 b)], _r)
        | otherwise = ([], b)
 
takeAsks :: BS.ByteString
         -> ([(BS.ByteString, BS.ByteString)], BS.ByteString)
takeAsks bs = takeAsks' bs (5::Integer)
  where
    takeAsks' b n
        | n > 0     = let (_b, _r) = takeAsks' (BS.drop 12 b) (n-1)
                      in ((BS.splitAt 5 $ BS.take 12 b):_b, _r)
        | otherwise = ([], b)

Funkcja parseData jest bardzo prosta. Pobiera ona kolejną konkretną ilość znaków z linii i wrzuca je odpowiednio do konstruktora MarketData. Np. jako pierwszy parametr konstruktor przyjmuje issueCode, który według opisu zadania ma długość 12 znaków. W tym celu najpierw pomijamy pierwsze 5 znaków warunkowych (czyli B6034) po czym bierzemy kolejne 12 właśnie jako issueCode itd. Na uwagę zasługują jeszcze dwie funkcje takeBids oraz takeAsks. Są one niemal identyczne - różnią się kolejnością dodawania czytanych elementów do listy. Pierwsza odwraca kolejność a druga pozostawia ją bez zmian. Obie natomiast czytają dane rekurencyjnie biorąc 12 znaków i dzieląc je na dwie listy od 1 do 5 znaku oraz od 6 do 12. Powtarzają tą czynność tak długo aż uzyskają 5 par danych (parametr n).

Pozostaje nam tylko dopisanie pozostałych funkcji odpalających cały mechanizm:

readQuote :: Bool
          -> PcapHandle
          -> IO ()
readQuote False h = dispatchBS h (-1) showData >> return ()
readQuote True h = return ()
 
main :: IO ()
main = do
    opt <- liftA parseOptions getArgs
    hdl <- openOffline $ filename opt
    readQuote (quoteOrder opt) hdl
 
data Options = Options { filename :: FilePath, quoteOrder :: Bool }

parseOptions :: [String]
             -> Options
parseOptions [] = Options "" False
parseOptions (x:xs)
    | x == "-r" = Options (head xs) True
    | otherwise = Options x False

Dodałem tu nowy typ danych Options, który odpowiada za parametry programu, takie jak nazwa pliku oraz czy ma być sortowany. Funkcja openOffline zwraca nam uchwyt do otworzonego pliku pcap, a funkcja readQuote przyjmuje jako parametr czy ma sortować dane (jeżeli tak to nic nie robi) i dalej wywołuje funkcję dispatchBS, która przetwarza dane wywołując showData na każdym pakiecie.

To by było na tyle. Sortowanie oczywiście pozostawiam czytelnikom do samodzielnej realizacji :)

Jakby jednak ktoś chciał zobaczyć jak ja wykonałem sortowanie danych to tutaj jest cały plik.

Vim Hoogle

Dzisiaj coś dla programistów Haskella. Ostatnio znalazłem bardzo ciekawy plugin do Vima integrujący ten wspaniały edytor z równie wspaniałą wyszukiwarką Hoogle. Jeżeli ktoś jeszcze o niej nie słyszał to w skrócie jest to wyszukiwarka, która umożliwia nam znalezienie funkcji haskellowych w dostępnych bibliotekach (z hackage.haskell.org) po nazwie oraz po typie. Dodatkowo po kliknięciu na znalezionej funkcji odsyła nas do jej dokumentacji.

Plugin zwie się vim-hoogle i jest dostępny tutaj. Instaluje się go standardowo - ściągamy sobie archiwum z github i wypakujemy zawartość do katalogu ~/.vim/
Aby plugin działał poprawnie wymagane jest jeszcze zainstalowanie programu hoogle. Najłatwiej jest to zrobić wykorzystując program cabal:

$ cabal install hoogle

Po czym należy jeszcze ściągnąć bazę danych w ten sposób:

$ hoogle data

Na koniec możemy uruchomić Vima i np. wywołać :Hoogle foldr. Po więcej informacji odsyłam do :help hoogle.

Cieniowanie oraz poziome klamry w MetaPost-cie

Ostatnio pisząc pewien referat natknąłem się na problem w LaTeXu. Otóż po pierwsze chciałem narysować sobie prostokąt, którego część będzie wykreskowana (wycieniowana) ukośnymi liniami. Po drugie potrzebowałem narysować pod figurą taką poziomą klamrę z podpisem. Generalnie chciałem uzyskać coś takiego:

Na pierwszy ogień poszedł MetaPost i jak się okazało świetnie się do tego nadaje. Wystarczyła w sumie prosta pętelka (właściwie to dwie) for i wszystko ładnie wyszło. Oto kod odpowiedzialny za cieniowanie:

for i=0 upto width/2: 
  draw (x,y-i*2)--(x+i*2,y);
endfor

for i=1 upto width/2: 
  draw (x+i*2,y2)--(x2,y - i*2);
endfor

Koncepcja jest bardzo prosta. Jeżeli mamy kwadrat do wykreskowania to dzielimy go na dwie części wzdłuż przekątnej, która będzie również kreską. Dzielimy go z tego powodu, że długości kresek rosną do połowy kwadratu a później maleją. Stąd potrzebne są również dwie pętle.

Druga rzecz to pozioma klamra. Długo się naszukałem jak to zrobić więc jak już w końcu znalazłem to się tą wiedzą podzielę. Cały trick polega na wyrenderowaniu zwykłej klamry z czcionki, rozciągnięcie jej i obrócenie. Kod:

label.bot(btex $\lbrace$ etex xscaled 1.5 yscaled 15 rotated 90, (x,y));

Na koniec zamieszczam cały kod jak wygenerować obrazek przedstawiony powyżej:

prologues:=3;
verbatimtex
%&latex
\documentclass{minimal}
\begin{document}
etex
beginfig(0);
s:=20;

draw (350,s+25)--(350,s+125)--(500,s+125)--(500,s+25)--cycle;
draw (350,s+125)--(400,s+75)--(400,s+25);
draw (400,s+75)--(450,s+25);
draw (350,s+75)--(500,s+75) dashed evenly scaled 2;
label.lft(btex $m/2$ etex, (350,s+100));
label.lft(btex $m/2$ etex, (350,s+50));
label.top(btex $p$ etex, (425,s+125));
label(btex $H$ etex, (450,s+100));
label(btex $U_2$ etex, (475,s+50));

for i=0 upto 25: 
  draw (350+i,s+125-i)--(350,s+125-i*2);
endfor

for i=1 upto 25: 
  draw (375+i,s+100-i)--(350+i*2,s+75);
endfor

for i=0 upto 25: 
  draw (350,s+75-i*2)--(350+i*2,s+75);
endfor

for i=1 upto 25: 
  draw (350+i*2,s+25)--(400,s+75 - i*2);
endfor

for i=0 upto 25: 
  draw (400+i,s+75-i)--(400,s+75-i*2);
endfor

for i=1 upto 25: 
  draw (425+i,s+50-i)--(400+i*2,s+25);
endfor

s:= 40;

label.bot(btex $\lbrace$ etex xscaled 1.5 yscaled 15 rotated 90, (425,s));

labeloffset:=5.5mm;
label.bot(btex $U$ etex, (425,s));


endfig;
end