Perličky: datové struktury a I/O reference

Zadání programu

Dejme tomu, že budeme chtít program, který načte text posazený do různých úrovní a očísluje jej jako číslovaný seznam s podseznamy. Vlivem vášnivé diskuse o významu odsazení prázdnými znaky pod předchozím dílem seriálu bude náš program používat pro označení úrovně seznamu právě odsazení prázdnými znaky. Kupříkladu náš program bude načítat takovýto vstup:

První
    Podprvní
Druhý
    Poddruhý
        Podpoddruhý
Třetí

A budeme s ním chtít zacházet takto:

1. První
   1. Podprvní
2. Druhý
   1. Poddruhý
      1. Podpoddruhý
3. Třetí

Konstrukce a naplnění datové struktury

První věcí je návrh příslušné datové struktury. Pro uchování jednoho prvku si potřebujeme pamatovat jeho název a odkazy na prvky, které má jako potomky. Z praktických důvodů je vhodné pamatovat si i odkaz „nahoru“, tj. na předka prvku. Jelikož tímto vytváříme cyklus v odkazech (prvek→potomek→pře­dek=prvek), je potřeba jednu z referencí zeslabit. V našem případě to bude reference směrem k předkovi, jelikož chceme, aby tato se chovala spíše jako pomocná, tj. prvek s jeho podstromem můžeme smazat tak, že „odpojíme“ příslušný odkaz směrem od rodiče k němu. Kdybychom chtěli opačné chování, zeslabovali bychom referenci směrem„dolů“.

Jelikož se k těmto údajům u prvku potřebujeme dostat spíše po jméně než po čísle, bude datová struktura jednoho prvku stromu reprezentována jako hash a bude obsahovat následující položky:

1. Název – řetězec
2. Odkaz na pole odkazů na potomky – zde je pořadí důležité, proto použijeme pole
3. Odkaz na předkův hash

Kdyby na to přišlo, mohli bychom celou strukturu nacpat do pole, například takto (název, \předek [, potomci …]), nicméně manipulace s touto strukturou by byla méně přehledná a příslušný kód také. A neprocvičili bychom reference na hashe.

Celou strukturu budeme adresovat prostřednictvím dvou proměnných-referencí. V první budeme uchovávat odkaz na kořen celého stromu a druhou budeme ukazovat dle potřeby tam, kde se zrovna něco děje. Vybaveni teoretickým náčrtem struktury můžeme tyto proměnné nadeklarovat.

my $root_elem = { };
my $pos_in_tree = $root_elem;

Pokud vás překvapuje, že jsme do kořenu stromu neumístili ani zbla, vzpomeňte si, že Perl disponuje funkcí zvanou autovivification. Tudíž dokud daný index v hashi nepotřebujeme, nemusíme jej definovat.

Strom již tedy máme vyřešen a můžeme se vrhnout na algoritmus pro načtení vstupu. Budeme se snažit být trochu chytří a nenutit uživatele používat jednu mezeru pro první úroveň, dvě mezery pro druhou úroveň atd. Místo toho si budeme pamatovat úrovně odsazení podle toho, jak se na vstupu vyskytují, a pokud dojde k její změně, budeme náležitě jednat. Také dovolíme uživateli začít první úroveň číslování kdekoliv, tj. nula a více mezer odsazení.

my @indent_levels = (-1);

Pole @indent_levels nám bude sloužit jako zásobník typu LIFO. Budeme do něj ukládat počty mezer (úrovně odsazení) pro jednotlivé logické úrovně číslování. Pole na začátku algoritmu obsahuje zarážku -1, abychom nemuseli ošetřovat speciální případ, kdy je pole prázdné, a také abychom mohli dovolit pro první úroveň odsazení nula mezer (tj. text bez odsazení). Například pokud zrovna budeme zpracovávat text na třetí logické úrovni odsazení a jednotlivé úrovně budou ve vzdálenosti 0, 3 a 10 mezer od levého okraje, budou v poli hodnoty (-1, 0, 3, 10).

Za účelem přidávání prvků do stromu si budeme pamatovat odkaz na poslední přidaný prvek v již zmíněné referenci $pos_in_tree. Prvky budeme ze vstupu načítat po řádkách v klasickém while (<>) cyklu. Prvním úkolem je zjistit úroveň odsazení načteného řádku.

while (my $line = <>) {
        chomp $line;
        $line =~ s/^\s*//;
        my $indent_part = $&;
        $indent_part =~ s/\t/q{ } x 8/ge;
        my $cur_indent_len = length $indent_part;

Po ufiknutí znaku konce řádku \n z konce řetězce ( chomp) sežereme pomocí regulárního výrazu všechny prázdné znaky ze začátku řetězce a uložíme je do $indent_part. Pro případ, že někdo míchá tabelátory a mezery, expandujeme tabelátory na osm mezer. Úroveň odsazení je pak prostě délka řetězce s mezerami. Tímto nám také v proměnné $line zbyl pouze název bez odsazení a můžeme zadefinovat nový prvek stromu, přičemž opět ponecháme zbytek položek nedefinovaných.

    my $new_elem = { name => $line };

Známe-li již úroveň odsazení, je potřeba nějak zareagovat na její změny oproti předchozímu řádku. V případě snížení úrovně odsazení vylezeme s referencí $pos_in_tree o úroveň výš a odstraníme poslední zapamatovanou hodnotu odsazení. Je-li odsazení sníženo o více než jednu úroveň, proces opakujeme. V tomto ohledu může být vstup nekorektní a potřebujeme ošetřit dvě situace.

První problém je podtečení odsazení. To může nastat v případě, že první úroveň odsazení nezačíná na nula mezerách a později se dostaneme pod tuto úroveň. Znamenalo by to posunutí na menší než první úroveň číslování, což vyhodnotíme jako neplatnou operaci.

    První
Druhý

Druhý problém je odsazení na úroveň, která neodpovídá předchozí úrovni.

První
    Druhý
   Třetí

To můžeme chápat několika způsoby. Buď má být „Třetí“ na
stejné úrovni jako „První“ a uživatel se
„netrefil“ do předchozí úrovně. V tomto případě můžeme
poopravit hodnotu odsazení, kterou si pamatujeme. Nebo to znamená změnu
odsazení dolů a zároveň nahoru, tj. na stejné úrovni budou
„Třetí“ a „Druhý“, pouze s jiným
počtem mezer (vzpomeňme, že uživatele nenutíme dodržovat konstantní
rozestupy, pouze sledujeme relativní změny.) Konečně, můžeme prohlásit,
že vstup je nejednoznačný, nevíme co s tím a je na uživateli,
aby vstup opravil. Všechny varianty jsou zhruba stejně náročné na
napsání, nicméně ta poslední vypadá nejlépe, jelikož je dobrým zvykem,
aby počítač v nerozhodné chvíli moc „nemyslel“. (Ještě
je další možnost, a to takový řádek ignorovat, ale ta je snad
nejhorší ze všech.)

        while ($cur_indent_len < $indent_levels[-1]) {
                pop @indent_levels;
                $pos_in_tree = $pos_in_tree->{parent};
                die <<"_E" if scalar @indent_levels == 1;
Indent level underflow
at line $., containing "$line".
_E
                die <<"_E" if $cur_indent_len > $indent_levels[-1];
Indent level mismatch:
$cur_indent_len should be $indent_levels[-1]
at line $., containing "$line".
_E
        }

Zvýšení úrovně odsazení je poněkud méně komplikované, jelikož je jednoznačné – zvyšujeme o jednu logickou úroveň bez ohledu na počet mezer. Do pole se zapamatovanými úrovněmi odsazení si tedy zapamatujeme novou úroveň. Zároveň se zde rozhodneme, pod který prvek ve stromu umístíme prvek nový. Pokud se úroveň zvýšila, bude to prvek na pozici $pos_in_tree (tj. posledně vložený prvek). Pokud se nezvýšila, tedy zůstala stejná, nebo se snížila, bude to předek prvku $pos_in_tree. Specielně to znamená, že pokud se úroveň nezměnila, předek současného a naposledy vloženého prvku bude stejný, což je přesně to, co chceme.

        if ($cur_indent_len > $indent_levels[-1]) {
                push @indent_levels, $cur_indent_len;
                $new_elem->{parent} = $pos_in_tree;
        } else {
                $new_elem->{parent}
                        = $pos_in_tree->{parent};
        }

Na závěr řádkového cyklu provedeme oslabení reference „nahoru“, vložíme prvek mezi potomky jeho předka a aktualizujeme proměnnou  $pos_in_tree.

        weaken($new_elem->{parent});
        push @{$new_elem->{parent}{children}}, $new_elem;
        $pos_in_tree = $new_elem;
}

Pokud bychom neměli k dispozici odkaz na předka prvku, nemohli bychom elegantně snížit úroveň odsazení, ale museli bychom pokaždé procházet strom od kořene a rozhodnout se, pod který prvek budeme vkládat.

Výpis datové struktury

Když už máme data v paměti, chtěli bychom se nějak podívat, jak vypadají. Nejhrubším nástrojem pro tento účel je modul Data::Dumper.

use Data::Dumper;
print Dumper($root_elem);

# Vstup
Prvni
    Druhy
Treti

# Výstup
$VAR1 = {
          'children' => [
                          {
                            'parent' => $VAR1,
                            'name' => 'Prvni',
                            'children' => [
                                            {
                                              'parent' => $VAR1->{'children'}[0],
                                              'name' => 'Druhy'
                                            }
                                          ]
                          },
                          {
                            'parent' => $VAR1,
                            'name' => 'Treti'
                          }
                        ]
        };

Tento modul umí vypsat libovolně složitou datovou strukturu jako Perlovský kód. Z výpisu je patrné, že umí rozpoznat i  cykly v referencích. Pokud bychom se odkazovali dopředně na objekty, které nebyly ještě definovány, lze nastavit $Data::Dumper::Purity = 1. Pak se neobjeví cyklické reference v definici struktury, ale až dodatečně.

$VAR1 = {
          'children' => [
                          {
                            'parent' => {},
                            'name' => 'Prvni',
                            'children' => [
                                            {
                                              'parent' => {},
                                              'name' => 'Druhy'
                                            }
                                          ]
                          },
                          {
                            'parent' => {},
                            'name' => 'Treti'
                          }
                        ]
        };
$VAR1->{'children'}[0]{'parent'} = $VAR1;
$VAR1->{'children'}[0]{'children'}[0]{'parent'} = $VAR1->{'children'}[0];
$VAR1->{'children'}[1]{'parent'} = $VAR1;

Perlovský zápis má výhodu v tom, že výsledek můžeme okamžitě vložit do programu, nebo opatrněji, vykonat jej pomocí eval. Pokud se nám nelíbí implicitní název proměnné $VAR1, můžeme použít variantu Data::Dumper->Dump, která bere jako parametry dvě reference na pole, první je seznam proměnných a druhé je seznam názvů. V  Data::Dumper toho lze nastavit ještě mnohem více, včetně způsobu formátování výpisu. Viz příslušná stránka perldoc.

use Data::Dumper;
$Data::Dumper::Purity = 1;

my $new_tree;
eval Data::Dumper->Dump([$root_elem], ["new_tree"]);
die "Error in data loading: $@" if $@;
print Data::Dumper->Dump([$new_tree], ["new_tree"]);

Tímto způsobem můžeme jednoduše kopírovat složité struktury nebo je ukládat do souboru a načítat. Poznamenejme, že takto nám zmizí slabé reference (v nové struktuře budou normální-silné). Můžeme si ale napsat jednoduchý rekurzivní algoritmus, který projde celý strom a zeslabí odkazy parent. Rekurzivní procházení stromem budeme ale raději demonstrovat na funkci, která nám obsah stromu vypíše tak, jak bylo požadováno v zadání, tedy očíslovaně. Zeslabování referencí ponecháme jako domácí úkol.

K rekurzivnímu výpisu stromu zvolíme pohodlný a klasický přístup. Budeme používat rekurzivní funkci a přes parametry si předávat právě zpracovávaný prvek, úroveň zanoření a řetězec pro výpis číslování. (Algoritmus by také bylo možno napsat nerekurzivně, podobně jako je nerekurzivní načítání vstupu.)

sub print_tree {
        my ($cur_elem, $recursion_lvl, $enum_label) = @_;

Jako první krok provedeme vypsání současného prvku. Zvolíme pevné odsazení tří mezer na logickou úroveň. Nebudeme vypisovat prvky, které nemají název (což je normálně pouze kořen).

        print
                q/ / x (3 * $recursion_lvl)
                , $enum_label
                , q/ /
                , $cur_elem->{name}
                , qq/\n/
                        if exists $cur_elem->{name};

Jako druhý krok provedeme rekurzivní volání pro všechny potomky současného prvku. Zvýšíme úroveň zanoření a prvky necháme očíslovat v pořadí, v jakém jsou v poli potomků.

    my $num = 1;
        for my $child_elem (@{$cur_elem->{children}}) {
                print_tree(
                        $child_elem
                        , $recursion_lvl + 1
                        , $enum_label . $num . q/./
                );
                $num++;
        }
}

Nakonec spustíme výpis pro kořen, minus první úroveň zanoření (aby jeho potomci měli nultou úroveň, tedy žádné odsazení) a prázdný prefix číslování.

print_tree($root_elem, -1, q//);

Tímto máme hotový program dle zadání v základním tvaru.

# Vstup
Bla
        Fla
                Pla
                Dla
                        Hula
                Marcel
Tla
        Tra
        Dru
                Bru
                Lu
        Zu

# Výstup
1. Bla
   1.1. Fla
      1.1.1. Pla
      1.1.2. Dla
         1.1.2.1. Hula
      1.1.3. Marcel
2. Tla
   2.1. Tra
   2.2. Dru
      2.2.1. Bru
      2.2.2. Lu
   2.3. Zu

Další metody úschovy a kopírování datových struktur

Ke kopírování objektů můžeme také použít modul Clone. Tento modul však nemusí být na vašem systému nainstalován a je potřeba jej v tom případě doinstalovat z balíčků nebo CPANu.

use Clone qw(clone);
my $new_tree = clone($root_elem);

Další možností je použít serializaci datových struktur. Moduly Storable a  FreezeThaw poskytují metody freeze a  thaw určené pro serializaci a deserializaci objektů. Funkce  freeze

„zmrazí“ objekt do řetězce. Tento řetězec můžeme uchovat
v paměti, na disku, poslat po síti, atd. Zmrazená data roztavíme
pomocí funkce thaw. Jelikož je řetězec binární, máme
v modulu Storable funkce nfreeze
a  nthaw, které data v řetězci chápou
v network-byte-order. Funkce dclone je zkratkou za

use Storable qw/freeze thaw/;
use String::Escape qw/printable/;
my $frozen = freeze($root_elem);
print 'Serializace $root_elem:', qq/\n/, printable($frozen), qq/\n/;
my $new_tree = thaw($frozen);
print Data::Dumper->Dump([$new_tree], ["new_tree"]);

# Výstup serializace není něco, co bychom měli číst před spaním
Serializace $root_elem:
\04\07\0812345678\04\08\08\10\03\01\00\00\00\04\02\02\00\00\00\04\03\03\00\00\00\1b\00\00\00\00\00\06\00\00\00parent\n\05Prvni\04\00\00\00name\04\02\01\00\00\00\04\03\02\00\00\00\1b\00\00\00\00\04\06\00\00\00parent\n\05Druhy\04\00\00\00name\08\00\00\00children\04\03\02\00\00\00\1b\00\00\00\00\00\06\00\00\00parent\n\05Treti\04\00\00\00name\08\00\00\00children

Jak vidno, způsobů, jak klonovat objekt, je více. Obvykle ne všechny jsou dostupné na všech systémech. Modul Clone::Any (není totéž co Clone) slouží jako wrapper pro různé možnosti (včetně již popsaných) a nabízí jednotné rozhraní přes funkci clone.

Ve výčtu možností, jak uchovávat datové struktury, nelze nezmínit jazyk YAML. Pomocí funkcí Dump a  Load z modulu YAML lze datovou strukturu uložit či nahrát v tomto jazyce. Na YAML je velmi výhodné, že si poradí i s celkem složitou strukturou, jako je náš strom, ale výstup zůstává perfektně čitelný pro lidské bytosti.

use YAML qw/Dump/;
print Dump($root_elem);

# Výstup
--- &1
children:
  - &2
    children:
      - name: Druhy
        parent: *2
    name: Prvni
    parent: *1
  - name: Treti
    parent: *1

Pro načtení bychom použili Load($string). Pro naše pohodlí existují také funkce freeze a  thaw jako aliasy na Dump a  Load.

Nejvyšším stupněm vývoje a pokroku v oblasti úschovy dat jsou databáze. Moduly z rodiny DBM:: nám dovolí pomocí proměnných pracovat přímo s databází v souboru (ve formátu berkeley db apod.). Takto je vhodné ukládat velké objekty, jelikož datová struktura pak není celá v paměti, nýbrž na disku. Druhou výhodou je rychlý start programu, jelikož se datová struktura nenačítá.

Moduly DBM:: jsou vesměs stavěny pouze na práci s hashi a nikoliv se složitějšími strukturami. Výjimku tvoří modul DBM::Deep, který zázračně poskytuje transparentní ukládání víceúrovňových struktur. Jeho použití je velmi jednoduché. Místo inicializace prázdným hashem napojíme referenci $root_elem na databázový soubor.

use DBM::Deep;

my $root_elem = DBM::Deep->new("cislovani.db");

# Zbytek programu se nemění

Náš konkrétní algoritmus se chová vůči více vstupům jako cat, tj. nový vstup připisuje na konec seznamu.

# Vstup
Prvni
 Druhy
Treti

# První výstup při použití DBM
1. Prvni
   1.1. Druhy
2. Treti

# Druhý výstup při použití DBM
1. Prvni
   1.1. Druhy
2. Treti
3. Prvni
   3.1. Druhy
4. Treti

Zřejmě by program šlo upravit tak, aby kromě toho, že data uchovává v databázovém souboru, například dovoloval měnit jednotlivé nadpisy nebo přidávat a odebírat prvky na různých úrovních. Toto také zůstává jako domácí úkol.

I/O reference

Nyní trochu odbočíme od klonování datových struktur. (Je takové klonování vůbec etické a zákonné?) Popíšeme si ještě jednu častou možnost použití referencí. Jsou to reference na I/O objekty, tj. věci vracené funkcemi open, opendir, objekt STDIN atd.

Trik spočívá v tom, že namísto s holými slovy STDIN nebo SOUBOR pracujeme s referencemi na tento objekt. Výhoda toho přístupu je zejména ve skalární povaze reference. Referenci lze ukládat do datových struktur a předávat jako parametry funkcím. Referenci získáme zpravidla pomocí vlastnosti autovivification a příslušné funkce na vytvoření I/O objektu. Práce s takovou referencí bude velmi podobná práci s I/O objekty.

open(my $soubor, "<soubor.txt");
# namísto
open(SOUBOR, "<soubor.txt");

print while (<$soubor>);
# namísto
print while (<SOUBOR>);

# zapisovat lze také
open(my $out, ">out.txt");
print $out "ahoj\n";

Kdybychom chtěli změnit funkci print_tree z příkladu se stromy tak, aby mohla vypisovat kamkoliv, nejen na standardní výstup, mohli bychom použít právě referenci na I/O objekt. Ve volání funkce si budeme předávat také tuto referenci a tisknout budeme do ní. Změny jsou velmi prosté a jsou vyznačeny tučným písmem.

sub print_tree {
        my ($file, $cur_elem, $recursion_lvl, $enum_label) = @_;

        print $file
                q/ / x (3 * $recursion_lvl)
                , $enum_label
                , q/ /
                , $cur_elem->{name}
                , qq/\n/
                        if exists $cur_elem->{name};

        my $num = 1;
        for my $child_elem (@{$cur_elem->{children}}) {
                print_tree(
                        $file

                        , $child_elem
                        , $recursion_lvl + 1
                        , $enum_label . $num . q/./
                );
                $num++;
        }
}

open(my $output, "|-", "tac");

print_tree($output, $root_elem, -1, q//);

Jinou možností, ke které programátoři často tíhnou, by bylo místo print použít řetězec, do kterého bychom přidávali dílčí výstupy, a pak celý řetězec vytisknout do souboru v hlavním programu. Tohle je však zbytečné, nepohodlné a navíc pro velké výstupy zabere hodně paměti, jelikož v řetězci si musíme pamatovat celý výstup. Pokud bychom ale chtěli připisovat do řetězce s čistým úmyslem, můžeme opět využít I/O reference.

my $string;
open(my $output, ">", \$string);

print_tree($output, $root_elem, -1, q//);
print $string;

Pokud bychom chtěli vyrobit referenci na již existující I/O objekt, například STDOUT, můžeme použít funkci open v režimu duplikace existujícího I/O objektu, anebo můžeme referencovat přímo I/O objekt pomocí speciální syntaxe.

# open v režimu dup
open(my $stdout, ">&STDOUT");

# reference na I/O objekt
my $stdout = *STDOUT{IO};

# reference na celý typeglob
# (lepší je použít jednu z předchozích možností)
my $stdout = \*STDOUT;

Chceme-li tisknout do více I/O referencí současně, nabízí se modul IO::Tee. Chová se k I/O referencím podobně jako T rozbočka na trubkách a výsledek je opět I/O reference. Můžeme tak najednou tisknout do souboru, na obrazovku, do řetězce, na standardní vstup programu nebo do dalšího „téčka“.

Závěr

V dnešním díle jsme si ukázali použití referencí v praxi pro vybudování stromové struktury a manipulaci s ní. Také jsme ukázali sílu I/O referencí. Jediné, co jsme neprobrali, jsou reference na podprogramy, a to na základě domněnky, že zvládá-li čtenář reference na podprogramy v jiných jazycích a bude-li vybaven dostatečnou znalostí Perlích referencí, nebude mu činit problém je použít i v Perlu. Nicméně pokud bude (v diskusi pod článkem) dostatečný zájem, můžeme věnovat některý z následujícíh dílů i referencím na podprogramy. Příští díl se nicméně bude věnovat něčemu oddechovějšímu, a to pokročilým regulárním výrazům.

Program vytvořený během dnešního článku a některé jeho modifikace si lze pro případné další experimenty stáhnout:

1. Načtení stromu, výpis a klonování přes Data::Dumper
2. Tisk stromu
3. Tisk stromu s I/O referencí
4. Verze s DBM::Deep