[PerlChina] Re: 一个限制酶切作图算法的Perl语言实现问题

下面的代码通过了上面的样例测试，其他的没测。
主要是没有针对可重复元素的集合的操作，比较烦。
========================
my(@res, @init, $width, $cur);
my $count = 0;
@res = qw(10 2 2 3 3 4 5 6 7 8);
@res = sort {$a <=> $b} @res;
$width = pop @res;

$cur = $width;
@init = qw(0);
push @init, $cur;
&place;

sub place
{
my $cur;
my @minus = ();

if(@res == 0)
{
$count++;
print "result_$count: @init\n";
return 1;
}
@res = sort {$a <=> $b} @res;
$cur = @res[@res - 1];

@minus = &get_minus($cur);
if(&among(\@minus))
{
push @init, $cur;
&del_set(\@minus);
&place;
pop @init;
@res = (@res, @minus);
}
@minus = &get_minus($width - $cur);
if(&among(\@minus))
{
push @init, $width - $cur;
&del_set(\@minus);
&place;
pop @init;
@res = (@res, @minus);
}
return 0;
}

sub among
{
my $y = shift;
foreach $tmp (@$y)
{
$flag = 0;
foreach(@res)
{
if($_ == $tmp)
{
$flag = 1;
last;
}
}
return 0 if($flag == 0);
}
return 1;
}

sub get_minus
{
my $y = shift;
my @minus;
@minus = ();
foreach (@init)
{
push @minus, abs($y - $_);
}
return @minus;
}

sub del_set
{
my $minus = shift;

$res = join("-", @res);
$res .= "-";
foreach(@$minus)
{
$res =~ s/$_-//;
}
@res = split(/-/, $res);
}

On 12月11日, 下午3时36分, D-Horse <ifre...@gmail.com> wrote:
> 我这两个星期才开始学习Perl语言，前几天在看《生物信息学算法导论》的时候看到一个限制酶切作图的算法，就想用Perl语言来实现以下。
> 该算法的伪代码是：
> 一些符号的定义：
> <----：赋值
> X,L是数组
> ~(y,X)表示y与数组X中元素的差值集合，比如~(2,{1,3,4,5}) = {1,1,2,3}
> =============================================================
> Partialdigest(L)
> 1 width <----L中的最大元素
> 2 DELETE(width,L)
> 3 X<----{0,width}
> 4 PLACE(L,X)
>
> PLACE(L,X)
> 1 if L是空集
> 2 output X
> 3 return
> 4 y<----L中最大元素
> 5 if ~(y,X)属于L
> 6 将y添加到X，且从L中删除长度~(y,X)
> 7 PLACE(L,X)
> 8 在X中删除y,且将长度~(y,X)添加到L中
> 9 if ~(width-y,X)属于L
> 10 将width-y添加到X，且从L中删除长度~(width-y,X)
> 11 PLACE(L,X)
> 12 在X中删除width-y,且将长度~(width-y,X)添加到L中
> 13 return
>
> ===============================================================
> 我的Perl语言代码：
> sub by_number
> {
> if($a<$b) {-1} elsif($a>$b) {1} else {0}}
>
> sub place{
> if (@array == 0){
> print "@x";
> return;
> }
> $y = $array_L[-1];
> if (&isSubArray_1 == 1){
> push @x,$y;
> @x = sort by_number @x;
> $_ = join "-",@array_L;
> $_ = "$_-";
> while (@rec_array != 0){
> my $item = pop @rec_array;
> s/$item-//;
> }
> return &place;
> }
> if (&isSubArray_2 == 1){
> push @x,($width-$y);
> @x = sort by_number @x;
> $_ = join "-",@array_L;
> $_ = "$_-";
> while (@rec_array != 0){
> my $item = pop @rec_array;
> s/$item-//;
> }
> return &place;
> }
> return;}
>
> sub isSubArray_1{
> my @temp_array = @x;
> my @result_array;
> my $signal = 0;
> while (@temp_array != 0){
> my $si = pop @temp_array;
> my $result = abs($si-$y);
> push @result_array, $result;
> }
> @rec_array = sort by_number @result_array;
> $_ = join "-",@array_LL;
> $_ = "$_-";
> while (@result_array != 0){
> my $item = pop @result_array;
> if (s/$item-//){
> }
> else{
> $signal += 1;
> }
> }
> if ($signal != 0){
> return 0;
> }
> else{
> return 1;
> }
>
> }
>
> sub isSubArray_2{
> my @temp_array = @x;
> my @result_array;
> my $signal = 0;
> while (@temp_array != 0){
> my $si = pop @temp_array;
> my $result = abs($si-($width-$y));
> push @result_array, $result;
> }
> @rec_array = sort by_number @result_array;
> $_ = join "-",@array_LL;
> $_ = "$_-";
> while (@result_array != 0){
> my $item = pop @result_array;
> if (s/$item-//){
> }
> else{
> $signal += 1;
> }
> }
> if ($signal != 0){
> return 0;
> }
> else{
> return 1;
> }}
>
> my @rec_array;
> my $y = 0;
> my @array_L = qw(2 2 3 3 4 5 6 7 8 10);
> my @array_LL = qw(2 2 3 3 4 5 6 7 8 10);
> @array_L = sort by_number @array_L;
> my $width = pop @array_L;
> my @x = qw(0);
> push @x,$width;
> &place;
>
> 调试了一天多了，还是不能运行，希望大家有空的话能帮我看看啊，谢谢啦！

--

您收到此邮件是因为您订阅了 Google 网上论坛的"PerlChina Mongers 讨论组"论坛。
要向此网上论坛发帖，请发送电子邮件至 perlchina@googlegroups.com。
要取消订阅此网上论坛，请发送电子邮件至 perlchina+unsubscribe@googlegroups.com。
若有更多问题，请通过 http://groups.google.com/group/perlchina?hl=zh-CN 访问此网上论坛。