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

21 февраля 2012

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

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

#!/usr/bin/perl

# parse-wiki.pl
# (c) Alexandr A 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;
}

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

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

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

#!/usr/bin/perl

# gen-gv.pl
# (c) Alexandr A 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. В ближайшие восемь лет таких больше не будет.

Кстати, пользуясь случаем, вновь призываю вас поддержать нашу кампанию на BoomStarter по сбору средств на запись второго сезона EaxCast. Поддержать можно как рублем, так и рассказав о кампании друзьям. Помогите нам сделать хороший, годный программерский подкаст!

Метки: , .

Подпишитесь на блог с помощью RSS, E-Mail, Google+ или Twitter.

Понравился пост? Поделитесь с другими: