我有一组位置 - 这是数据结构的一个例子。
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 =
[
{
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
的回复让我看到了我的措辞存在缺陷。我想我对//每个可能//非重叠位置的组合都不感兴趣,我只对那些不是其他解决方案子集的解决方案感兴趣。
答案 0 :(得分:1)
我不是CS人,所以我并没有使用所有最好的算法,但我想知道是否有更好的方法:
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);
}
}
}
do_not_overlap
和add_to_output
合适定义。
如果你想知道检查重叠......这非常简单。 如果出现以下情况,A和B不会重叠:
( (A->start < B->start) && (A->end < B->start) ) ||
( (A->start > B->end) && (A->end > B->end) )
您可能需要根据共享边界是否构成重叠进行调整。此外,如果您知道A和B是否以某种方式(从开始或结束)排序,您可以简化此操作。
答案 1 :(得分:1)
首先,我将收集所有单独的点(每个位置的开始和结束),对它们进行排序并将它们保存在列表中。在你的情况下:
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个解决方案(您只能在解决方案中选择一个加工多个区间的段)。
我们发现了2,2,2(或2,3,4)。将它们保存在一个数组中并从最后一个开始。递减直到达到0.当达到1时,递减前一个数字并将第一个数字设置为初始值减去1.
假设我们已经对初始段进行了编号:(在本例中为1,2,3,4,5,6
)。重叠的细分中将包含以下细分[1,2], [2,3], [3,4]
。所以我们有3个重叠的部分。现在我们开始一个选择/消除的递归过程:
在每个步骤中,我们都在查看具有多个段的重叠段。我们迭代选择,并且对于每个选择,我们做两件事:从每个后续重叠段中消除我们现在没有选择的段,并且在每个后续重叠段中强制当前段选择作为可能性。变为非重叠的每个段都将被视为新选择。搜索下一个多项选择并递归。一旦我们找不到选择,我们就会有部分解决方案。我们需要添加不涉及任何重叠的段。打印出来。
在这种情况下它会是这样的:第一步:
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
这应该正常工作。
现在实现这个的代码(它不是我假设的最漂亮的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);
答案 2 :(得分: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然后结束并预先计算并存储在每个位置的哈希(或仅位于$ locations-&gt; {foo}中)以下多少位置发生冲突与该位置。然后在can_add ...的情况下,在递归之前将该数字从@remaining中拼接出来。
或者为每个位置预先计算冲突的所有后续位置的哈希值,并在递归之前用grep将它们全部删除。 (尽管采用这种方法,剩余的哈希开始变得更有意义。)
更新:解决方案的另一种方法是建立一个要排除的位置树,其中叶子代表解决方案,内部节点代表仍然存在冲突的组合;顶部节点是所有位置,并且每个节点都有子节点,表示删除剩余的冲突位置之一(在某些任意排序方案中)比父节点删除的位置(如果有的话)更大。
答案 3 :(得分:0)
(真实的入侵 - 道歉,我会写一个解释 - 并获得那些空的阵列,虽然这是相当微不足道的 - 稍后!)
#! /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;