Perlで重複しない場所を特定する

Question

私は場所の集まりを持っています - ここにはデータ構造の例があります。

my $locations = 
{ 
    loc_1 => 
    { 
    start => 1, 
    end => 193, 
    }, 
    loc_2 => 
    { 
    start => 180, 
    end => 407, 
    }, 
    loc_3 => 
    { 
    start => 329, 
    end => 684, 
    }, 
    loc_4 => 
    { 
    start => 651, 
    end => 720, 
    }, 
}; 

可能性のある重複しない場所の組み合わせをすべて調べるにはどうすればよいですか？この例の答えは、このようになります。 1つ以上の場所があり、これらの場所が重複していても構わない場合もあります。

my $non_overlapping_locations = 
[ 
    { 
    loc_1 => 
    { 
     start => 1, 
     end => 193, 
    }, 
    loc_3 => 
    { 
     start => 329, 
     end => 684, 
    }, 
    }, 
    { 
    loc_1 => 
    { 
     start => 1, 
     end => 193, 
    }, 
    loc_4 => 
    { 
     start => 651, 
     end => 720, 
    }, 
    }, 
    { 
    loc_2 => 
    { 
     start => 180, 
     end => 407, 
    }, 
    loc_4 => 
    { 
     start => 651, 
     end => 720, 
    }, 
    } 
]; 

更新：ysthの応答は私が私の文言の欠陥を参照してください助けました。私は//重複しない場所のすべての//可能な組み合わせには興味がないと思うが、私は他のソリューションのサブセットではないソリューションにしか興味がない。

Answer 1

use strict; 
use warnings; 

my $locations = 
{ 
    loc_1 => 
    { 
    start => 1, 
    end => 193, 
    }, 
    loc_2 => 
    { 
    start => 180, 
    end => 407, 
    }, 
    loc_3 => 
    { 
    start => 329, 
    end => 684, 
    }, 
    loc_4 => 
    { 
    start => 651, 
    end => 720, 
    }, 
}; 
my $non_overlapping_locations = []; 
my @locations = sort keys %$locations; 

get_location_combinations($locations, $non_overlapping_locations, [], @locations); 

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

sub get_location_combinations { 
    my ($locations, $results, $current, @remaining) = @_; 

    if (! @remaining) { 
     if (not_a_subset_combination($results, $current)) { 
      push @$results, $current; 
     } 
    } 
    else { 
     my $next = shift @remaining; 
     if (can_add_location($locations, $current, $next)) { 
      get_location_combinations($locations, $results, [ @$current, $next ], @remaining); 
     } 
     get_location_combinations($locations, $results, [ @$current ], @remaining); 
    } 
} 

sub can_add_location { 
    my ($locations, $current, $candidate) = @_; 

    # not clear if == is an overlap; modify to use >= and <= if so. 
    0 == grep $locations->{$candidate}{end} > $locations->{$_}{start} && $locations->{$candidate}{start} < $locations->{$_}{end}, @$current; 
} 

sub not_a_subset_combination { 
    my ($combinations, $candidate) = @_; 

    for my $existing (@$combinations) { 
     my %candidate; 
     @candidate{@$candidate} =(); 
     delete @candidate{@$existing}; 
     if (0 == keys %candidate) { 
      return 0; 
     } 
    } 
    return 1; 
} 

比較的単純な最適化が開始により@locationsをソートし、その後終了し、事前に計算し、STORことであろうeをハッシュ（または$ locations - > {foo}）に置き換えます。次の場所の数がその場所と矛盾します。次に、can_add ...の場合、再帰の前に@remainingの番号をスプライスします。

また、競合するすべての次の場所のハッシュを各場所で事前に計算し、再帰する前にgrepですべて削除します。 （そのアプローチでは、ハッシュを残しておくことがより意味をなさないが）

更新：解決策のもう1つのアプローチは、除外する場所のツリーを構築することです。まだ矛盾している。上位ノードはすべての位置であり、各ノードは、親ノードによって削除された位置（存在する場合）よりも大きい（任意の順序付け方式で）残りの競合する位置のうちの1つを除去することを表す子を有する。

Answer 2

私はCSの男ではないので、私がダウンして最高のアルゴリズムのすべてではないんだけど、より良いアプローチがあるかしら：do_not_overlapと定義され、適切なadd_to_outputで

my @location_keys = keys %{$locations}; 
while (my $key_for_checking = (shift @location_keys) { 
    foreach my $key_to_compare (@location_keys) { 
     if (do_not_overlap($locations->{$key_for_checking}, 
          $locations->{$key_to_compare}) { 
      add_to_output($key_for_checking, $key_to_compare); 
     } 
    } 
} 

が。

オーバーラップをチェックするのが不思議なら、それはかなり簡単です。あなたが共有境界がオーバーラップを構成しているかどうかに応じて微調整する必要があるかもしれません

((A->start < B->start) && (A->end < B->start)) || 
((A->start > B->end) && (A->end > B->end)) 

：場合 AとBは重なりません。また、AとBが何らかの方法でソートされているかどうかを知っているならば、これを単純化することができます

Answer 3

まず、個々の点（各点の始点と終点）それらをリストに保管してください。あなたの場合は：

1,180,193,329,407,651,684,720. 

このリストの各間隔について、それが重なるセグメントの数を調べます。あなたの場合、これは：

1, 180 -> 1 
180, 193 -> 2 
193, 329 -> 1 
329, 407 -> 2 
407, 651 -> 1 
651, 684 -> 2 
684, 720 -> 1 

であり、どのセグメントが1より大きいか（この場合は3）ループするでしょう。したがって、ケースの合計数は2 x 2 x 2 = 8個の解です（ソリューション内で複数の区間を処理するセグメントは1つしか選択できません）。

,2,2,2（または2,3,4）が見つかりました。それらを配列にして、最後から始める。 0になるまで値を減らします。1に達すると前の値を減算し、最初の数値から1を引いた値を設定します。

最初のセグメントに番号を付けました（この場合は1,2,3,4,5,6）。オーバーラップするセグメントには、次のセグメントが含まれます。[1,2], [2,3], [3,4]したがって、3つのオーバーラップするセグメントがあります。ここで、選択/除外の再帰的プロセスを開始します。 各ステップで、複数のセグメントを持つ重複セグメントを見ています。私たちは選択肢を繰り返し、選択肢ごとに2つのことを行います。今度は選択しなかったセグメントを後続の重複セグメントから除外し、この選択肢を持つ可能性のある後続の重複セグメントごとに現在のセグメント選択を強制します。オーバーラップしないセグメントはすべて新しい選択肢として扱われます。次の複数選択肢と再帰を検索します。我々が選択肢を見つけることができなくなると、我々は部分的な解決策を持っている。重複していないセグメントを追加する必要があります。それを印刷します。これが正常に動作するはず

we are here [1,2], [2,3], [3,4]: 
    chose 1 -> // eliminate 2 from rest and force 1 (3 is a single choice so we do the same) 
     [1], [3], [3] -> [1, 3] solution 
    chose 2 -> // eliminate 1 from the rest and force 2 (2 single choice so we do the same). 
     [2], [2], [4] -> [2, 4] solution 

：第1工程：

この場合、それは次のように行くだろう。

今（それは私が前提と周りのきれいなPerlコードではありませんが、私は実際にperlの男ではないよ）これを実装するコード：

#!/bin/perl 

use strict; 
use warnings; 
use 5.010; 
use Data::Dumper; 

my $locs = { 
    loc_1 => { 
    start => 1, 
    end => 193, 
    }, 
    loc_2 => { 
    start => 180, 
    end => 407, 
    }, 
    loc_3 => { 
    start => 329, 
    end => 684, 
    }, 
    loc_4 => { 
      start => 651, 
    end => 720, 
    } 
}; 

my (%starts, %ends); 
map { 
     my ($start, $end) = ($locs->{$_}->{start}, $locs->{$_}->{end}); 

     push @{ $starts{$start} }, $_; 
     push @{ $ends{$end} }, $_; 
} keys %$locs; 

my @overlaps, my %tmp; 

map { 
     map { $tmp{$_} = 1 } @{$starts{$_}}; 
     map { delete $tmp{$_} } @{$ends{$_}}; 

     my @segs = keys %tmp; 
     push @overlaps, \@segs if 1 < @segs 
} sort (keys %starts, keys %ends); 

sub parse_non_overlapping { 
    my ($array,$pos)=($_[0], $_[1]); 

    my @node = @{$array->[$pos]}; 
    foreach my $value (@node) { 

    my @work = map { [@$_] } @$array; 
    $work[$pos] = [ $value ]; 

    my ($removed, $forced) = ({}, {$value => 1}); 
    map { $removed->{$_} = 1 if $_ ne $value } @node; 

    my ($i, $new_pos) = (0, -1); 
    for ($i = $pos + 1; $i <= $#work; $i++) { 
     $_ = $work[$i]; 

     #apply map 
     @$_ = grep { not defined($removed->{$_}) } @$_; 
     if ($#$_ == 0) { $forced->{@$_[0]} = 1 } 

     #apply force 
      my @tmp = grep { defined $forced->{$_} } @$_; 
     if ($#tmp == 0) { 
      map { $removed->{$_} = 1 if $tmp[0] ne $_ } @$_; 
      @$_ = @tmp; 
     } 

     if ($#$_ > 0 && $new_pos == -1) { 
       $new_pos = $i; 
     } 

     $work[$i] = $_; 
    } 

    if ($new_pos != -1) { 
     parse_non_overlapping(\@work, $new_pos); 
    } else { 
     print Dumper \@work 
     # @work has the partial solution minux completely non overlapping segments. 
    } 
    } 
}  

parse_non_overlapping(\@overlaps, 0); 

Answer 4

（実人生が侵入 - 謝罪は、私が説明を書きます - それはかなり些細だが、これらの空の配列リファレンスの乗り心地を得る - ！それ以降）

#! /usr/bin/perl 
use strict; 
use warnings; 
use 5.010; 
use List::MoreUtils qw(any); 
use Data::Dumper; 

my $locations = { 
    loc_1 => { 
     start => 1, 
     end => 193, 
    }, 
    loc_2 => { 
     start => 180, 
     end => 407, 
    }, 
    loc_3 => { 
     start => 329, 
     end => 684, 
    }, 
    loc_4 => { 
     start => 651, 
     end => 720, 
    }, 
}; 

my @keys = keys %$locations; 

my %final; 

for my $key (@keys) { 
    push @{ $final{$key} }, map { 
     if ( $locations->{$key}->{start} >= $locations->{$_}->{start} 
      && $locations->{$key}->{start} <= $locations->{$_}->{end} 
      or $locations->{$key}->{end} >= $locations->{$_}->{start} 
      && $locations->{$key}->{end} <= $locations->{$_}->{end}) 
     { 
      (); 
     } 
     else { 
      my $return = [ sort $key, $_ ]; 
      if (any { $return ~~ $_ } @{ $final{$_} }, @{ $final{$key} }) { 
       (); 
      } 
      else { $return; } 
     } 
    } grep { $_ ne $key } keys %$locations; 
} 

say Dumper \%final;