Рекурсивная подпрограмма - PullRequest
Новая
       57

Рекурсивная подпрограмма

0 голосов
/ 07 ноября 2018

Допустим, у меня есть пул пакетов a, b, c, ... у каждого пакета есть имя, версия и зависимости.

В приведенном ниже коде get-cand sub принимает пакет и возвращает кандидатов из пула (вместе с их зависимостями рекурсивно).

так что если он принял пакет с именем c , а пул имеет

Пакет c1: имя c , версия 1 , dep a (любая версия) и b (версия 1 )

Пакет с2: имя c , версия 2 , dep b (версия 2)

вернет следующую структуру данных: 

((c1 ((((a1 ()) (a2 ()))) (((b1 ()))))) (c2 ((((b2 ()))))))  # can't figure out how to get rid of empty lists here

Я пытаюсь написать select-cand sub, который будет принимать вышеуказанную структуру данных, и цель состоит в том, чтобы вернуть первого кандидата, который не конфликтует (с установленными пакетами), и рекурсивно проверить его зависимости также.

поэтому саб должен работать так:

  • Проверьте c1 , если конфликты вернули False, возьмите c1 и опуститесь до его глубины
  • (теперь в c1 deps) Проверьте a1 , если конфликты вернули True, проверьте следующего кандидата ( a2 )

в конечном итоге он должен вернуть [c1 a2 b1] или [c2 b2] для успешного запуска или ничего, если все кандидаты конфликтуют.

но на данный момент select-cand sub возвращает: [c1 a1 a2 c2 b2], что неверно, потому что мне нужен только c1 (и рекурсивно deps) или c2.

( конфликты является подпрограммой-заполнителем, на данный момент она просто исключает пакет b1 для целей тестирования) 

#!/usr/bin/env perl6

my %pkgs;

class Pkg {
  has         $.name;
  has Version $.version = Version.new;
    has Pkg     @.dep;

    method Str {
      $!name ~ $!version;
    }
}

my $a1 = Pkg.new: name => 'a', version => Version.new: <1>;
my $a2 = Pkg.new: name => 'a', version => Version.new: <2>;
my $b1 = Pkg.new: name => 'b', version => Version.new: <1>;
my $b2 = Pkg.new: name => 'b', version => Version.new: <2>;
my $c1 = Pkg.new: name => 'c', version => Version.new: <1>;
my $c2 = Pkg.new: name => 'c', version => Version.new: <2>;

$c1.dep.push: Pkg.new(name => 'a');
$c1.dep.push: Pkg.new(name => 'b', version => Version.new: <1>);

$c2.dep.push: Pkg.new(name => 'b', version => Version.new: <2>);

%pkgs<a> .push: $a1, $a2;
%pkgs<b> .push: $b1, $b2;
%pkgs<c> .push: $c1, $c2;


sub return-pkg (Pkg $pkg) {
  my @pkgs = flat %pkgs{$pkg.name};
    return grep {$_.version ~~ $pkg.version}, @pkgs;
}  

sub get-cand (Pkg $pkg) {
    gather {
        take return-pkg($pkg).map( -> $pkg {
            ($pkg, $pkg.dep.map( -> $pkg {
                get-cand($pkg).Slip
            }).Slip)
        }).cache;
    }
}

sub conflicts (Pkg $pkg) {
  return True if $pkg.name eq <a> and $pkg.version eq <1>; 
  #take $pkg.Str if $pkg.name eq <a> and $pkg.version eq <1>; 
}

multi select-cand (Pkg $pkg) {
  return $pkg.Str if not conflicts $pkg;
}

multi select-cand (@cand) {
  gather {
    @cand.map({ .first({ take select-cand $_ })});
    }
}

my $c = Pkg.new: name => 'c';

my @cand =  get-cand $c;
my @selected = select-cand @cand;

say @selected; # [(c1 () (a2) (b1))]
...