Граф развития языков программирования

21 февраля 2012

На страницах Википедии, посвященных определенному языку программирования, приводится информация о том, на какие языки он оказал влияние и влиянию со стороны каких языков подвергся. Например, Haskell исптытал влияние со стороны Lisp и ML, повлияв при этом на Scala, Perl 6 и Python. Интересно, а что будет, если нарисовать граф отношения «язык X повлиял на язык Y»?

Я написал несложный скриптик, который забирает с Вики всю информацию о «родословной» языков и сохраняет ее в текстовый файл:

#!/usr/bin/perl

# parse-wiki.pl
# (c) Alexandr Alexeev 2012 | http://eax.me/

use strict;
use warnings;
use LWP::UserAgent;

main(
    ['Perl'],
    {
      Perl => { url => 'http://en.wikipedia.org/wiki/Perl' }
    }
  );

sub main {
  my ($queue, $lang_info) = @_;
  my %influenced_table; # {Perl}{Python} = 1

  while(@{$queue}) {
    my $lang = shift @{$queue};
    my $url = $lang_info->{$lang}{url};

    warn "Queue size: ".scalar(@{$queue}).
         ", fetching $lang info, url: $url\n";
    my $data = getUrl($url);

    $lang_info->{$lang}{year} = parseYear($data);
   
    my $influenced = parseInfluenced($data);
    for my $new_lang(keys %{$influenced}) {
      $influenced_table{$lang}{$new_lang} = 1;
      # in queue or allready parsed
      next if defined $lang_info->{$new_lang}; 
      $lang_info->{$new_lang} = {
          url => $influenced->{$new_lang}
        };
      push @{$queue}, $new_lang;
    }

    my $influencedBy = parseInfluencedBy($data);
    for my $new_lang(keys %{$influencedBy}) {
      $influenced_table{$new_lang}{$lang} = 1;
      # in queue or allready parsed
      next if defined $lang_info->{$new_lang}; 
      $lang_info->{$new_lang} = {
          url => $influencedBy->{$new_lang}
        };
      push @{$queue}, $new_lang;
    }
  }
  warn "All done, writing result\n";
  dumpInfo($lang_info, \%influenced_table);
}

sub dumpInfo {
  my ($lang_info, $influenced) = @_;
  for my $lang(keys %{$lang_info}) {
    my $inf_list = join(",", keys %{$influenced->{$lang}});
    my $year = $lang_info->{$lang}{year};
    my $url = $lang_info->{$lang}{url};
    print "$year:$lang:$url:$inf_list\n";
  }
}

sub parseYear {
  my ($data) = @_;

  my($year) = $data =~ m!Appeared in</th>[^<]*<td[^>]*>(?:<a[^>]*>)⏎
?((?:19|20)\d{2})!si;

  $year = "unknown" unless defined $year;
  return $year;
}

sub parseInfluenced {
  my ($data) = @_;
  return parseLangList("Influenced", $data);
}

sub parseInfluencedBy {
  my ($data) = @_;
  return parseLangList("Influenced by", $data);
}

sub parseLangList {
  my ($key, $data) = @_;
  my %lang_table;

  my($inf_block) = $data =~ m!<th[^>]*>$key</th>[^<]*<td class="" ⏎
style="">(.*?)</td>!si;

  if(defined $inf_block) {

    while(my ($url, $lang, $rest) = $inf_block =~ m'^<a href="⏎
/([^"]+)"[^>]*>([^<]+)</a>(?:, )?(.*)$'si) {

      $inf_block = $rest;
      next unless($url =~ m!^wiki/!);
      $url = "http://en.wikipedia.org/$url";
      warn "    $key $lang, url: $url\n";
      $lang_table{$lang} = $url; 

    }

  }
  return \%lang_table;
}

sub getUrl {
  my ($url) = @_;
  my $lwp = LWP::UserAgent->new(
      timeout => 30,
      agent => 'Opera/9.80 (X11; FreeBSD 8.2-RELEASE i386; U; ru) ⏎
Presto/2.9.168 Version/11.52',
    );
  my $res = $lwp->get($url);
  unless($res->is_success) {
    die "Failed to download $url (".$res->status_line.")";
  }
  return $res->as_string;
}

Объем собранных данных оказался довольно велик. Чтобы получить из них граф, удобный для восприятия, нужно сделать три вещи:

Избавиться от синонимов. Например, «K Shell» и «Korn Shell» – это одно и то же;
Избавиться от транзитивных дуг. Например, если Haskell повлиял на Python, а тот в свою очередь повлиял на Perl 6, то дуга «Haskell повлиял на Perl 6» нам не нужна;
Преобразовать данные в формат, понятный Graphviz;

Первая задача довольно быстро решается вручную. Для решения второй и третьей задачи был написан следующий скрипт:

#!/usr/bin/perl

# gen-gv.pl
# (c) Alexandr Alexeev 2012 | http://eax.me/

use strict;
use warnings;

my $fname = shift;
unless($fname) {
  die "Usage: $0 <fname>\n";
}

my $graph = loadGraph($fname);
optimizeGraph($graph);
printGraph($graph);

sub optimizeGraph {
  my($graph) = @_;
  my $rev_graph = reverseGraph($graph);
  # для каждой дуги ($from, $to);
  for my $from(keys %{$graph}) {
    for my $to(keys %{$graph->{$from}}) {
      # если есть обратный путь без использования этой дуги
      my %used_paths;
      $used_paths{$to}{$from} = 1;
      if(pathExists($rev_graph, $to, $from, \%used_paths)) {
        # то это транзитивная дуга - удаляем ее
        delete $graph->{$from}{$to};  
        delete $rev_graph->{$to}{$from};  
      }
    }
  }
}

sub pathExists { # поиск в ширину пути в $graph из $from в $to
  my($graph, $from, $to, $used_patchs) = @_;
  my @open_patchs;
  # перебираем вершины, соседние с начальной
  for my $new_to(keys %{$graph->{$from}}) {
    unless($used_patchs->{$from}{$new_to}) {
      return 1 if($new_to eq $to);
      push @open_patchs, [$from, $new_to];
    }
  }

  while(@open_patchs) {
    my $path = shift @open_patchs;
    my $curr_from = $path->[0];
    my $curr_to = $path->[1]; # придумать имя получше?
    $used_patchs->{$curr_from}{$curr_to} = 1;
    for my $new_to(keys %{$graph->{$curr_to}}) {
      unless($used_patchs->{$curr_to}{$new_to}) {
        return 1 if($new_to eq $to);
        push @open_patchs, [$curr_to, $new_to];
      }
    }
  }
  return 0;
}

sub reverseGraph {
  my($graph) = @_;
  my %rslt;
  for my $from(keys %{$graph}) {
    for my $to(keys %{$graph->{$from}}) {
      $rslt{$to}{$from} = 1; 
    }
  }
  return \%rslt;
}

sub loadGraph {
  my($fname) = @_;
  my %graph;
  open my $fid, "<", $fname or die $!;
  # my $i = 0;
  while(my $line = <$fid>) {
    # last if(++$i > 50);
    chomp($line);
    my ($year, $lang, $url1, $url2, $influenced) = split /:/, $line;
    next if($year eq "unknown");
    my @influenced_list = split /,/, $influenced;
    for my $infl_lang(@influenced_list) {
      $graph{$lang}{$infl_lang} = 1;
    }
  }
  close $fid;
  return \%graph;
}

sub printGraph {
  my($graph) = @_;
  print "digraph G {\n  nodesep=1;\n  mindist=1;\n"; 
  for my $from(keys %{$graph}) {
    for my $to(keys %{$graph->{$from}} ) {
      print qq{  "$from" -> "$to";\n};
    }
  }
  print "}\n";
}

Наибольший интерес тут представляет функция optimizeGraph, удаляющая транзитивные дуги. Логика тут следующая – для каждой пары соседних вершин мы пытаемся найти обратный путь (то есть, прямой путь в инвертированном графе), не включающий дугу, соединяющую эту пару вершин. Если такой путь существует, то дуга, по которой мы определили «соседство» текущих вершин, является транзитивной и удаляется. Сам поиск пути реализован в функции pathExists и представляет собой классический поиск в ширину.

Я почти уверен, что должен быть более быстрый алгоритм для удаления транзитивных дуг. Если вам такой известен, отпишитесь, пожалуйста, в комментариях.

Получившийся граф в формате PNG весит более мегабайта, в связи с чем здесь я могу привести лишь небольшую его часть:

Граф развития языков программирования

Вы можете загрузить полную версию графа вместе со всеми исходниками к этой заметке отсюда. Файл называется «rslt/langs.png». Довольно интересно проследить всю родословную какого-нибудь Erlang или Scala до самого Speedcode. Кстати, вы знали, что это первый высокоуровновый язык программирования и появился он более полувека назад – аж в 1953 году?

P.S. Поздравляю всех с зеркальной датой 21.02.2012. В ближайшие восемь лет таких больше не будет.