求助：除去成对的括号

longbow0

设最外层括号为第 1 层，请问怎么样能够除去 1 对第 2 层的括号，保留其他括号？

谢谢！

例如：

1. (((1,2),3),4)   =>  ((1,2),3,4)
   
2. 
   
3. ((1,2),(3,4))   =>  ((1,2),3,4)
   
4.                         or
   
5.                     (1,2,(3,4))
   
6.                     
   
7. (1,(2,(3,4)))   => (1,2,(3,4))

复制代码

longbow0

基本能够完成任务的代码，请各位指正。

1. 
   
2. #!/usr/bin/perl
   
3. 
   
4. use strict;
   
5. use warnings;
   
6. 
   
7. while (<DATA>) {
   
8.     next if /^#/;
   
9.     next if /^\s*$/;
   
10.     chomp;
    
11.    
    
12.     print $_, "==>\n";
    
13.    
    
14.     my ($lnode, $rnode) = getNodes($_);
    
15.    
    
16.     if ($lnode =~ /^\(/) {
    
17.         my $str = $lnode;
    
18.         
    
19.         my ($lnode, $mnode) = getNodes($str);
    
20.         
    
21.         print join(',', ($lnode, $mnode, $rnode)), "\n";
    
22.     }
    
23.     else {
    
24.         my $str = $rnode;
    
25.         
    
26.         my ($mnode, $rnode) = getNodes($str);
    
27.         
    
28.         print join(',', ($lnode, $mnode, $rnode)), "\n";
    
29.     }
    
30. }
    
31. 
    
32. =begin
    
33.   Name:     getNodes
    
34.   Desc:     Get 2 nodes of a binary tree
    
35.   Usage:    getNodes($str)
    
36.   Args:     A string
    
37.   Return:   2 strings
    
38. =cut
    
39. 
    
40. sub getNodes {
    
41.     my ($str) = @_;
    
42.    
    
43.     # Remove leading and tailing parentheses
    
44.     # $str =~ s/^\(|\)$//g;
    
45.    
    
46.     # '((1,2),3)'
    
47.     if ($str =~ /^\((\(.+\)),(\w+)\)$/) {
    
48.     #    print "L\n";
    
49.         return ($1, $2);
    
50.     }
    
51.     # '((1,2),(3,4))'
    
52.     elsif ($str =~ /^\((\(.+\)),(\(.+\))\)$/) {
    
53.     #    print "M\n";
    
54.         return ($1, $2);
    
55.     }
    
56.     # '(1,(2,3))'
    
57.     elsif ($str =~ /^\((\w+),(\(.+\))\)$/) {
    
58.     #    print "R\n";
    
59.         return ($1, $2);
    
60.     }
    
61.     # '(1,2)'
    
62.     elsif ($str =~ /^\((\w+),(\w+)\)$/) {
    
63.         return ($1, $2);
    
64.     }
    
65.     else {
    
66.         print "Error!\n";
    
67.         return (0, 0);
    
68.     }
    
69. }
    
70. 
    
71. __DATA__
    
72. (((1,2),3),4)
    
73. ((1,2),(3,4))
    
74. (1,(2,(3,4)))
    
75. ((1,2),(3,(4,5)))
    
76. (((((1,2),3),4),(5,6))
    

复制代码

输出

1. 
   
2. (((1,2),3),4)==>
   
3. (1,2),3,4
   
4. ((1,2),(3,4))==>
   
5. 1,2,(3,4)
   
6. (1,(2,(3,4)))==>
   
7. 1,2,(3,4)
   
8. ((1,2),(3,(4,5)))==>
   
9. 1,2,(3,(4,5))
   
10. (((((1,2),3),4),(5,6))==>
    
11. (((1,2),3),4,(5,6)
    
12. 
    

复制代码

guap514

回复 1# longbow0

1. SubstrIndex( $_ ) for "(((1,2),3),4)", "((1,2),(3,4))", "(1,(2,(3,4)))", "(((((1,2),3),4),(5,6))";
   
2. 
   
3. sub SubstrIndex {
   
4.     my $string = shift;
   
5.     print "$string\t==>\t";
   
6.     my $posi = Index( $string );
   
7.     substr( $string, $posi->[0], 1 ) = "";
   
8.     substr( $string, $posi->[1], 1 ) = "";
   
9.     print "$string\n";
   
10. }
    
11. sub Index {
    
12.     my $string = shift;
    
13.     my $n = 2;
    
14.     my $where1 = -1;
    
15.     $where1 = index $string, "(", $where1 + 1 for 1 .. $n;
    
16.     my $where2 = index $string, ")", $where1 + 1;
    
17.     my $where3 = index $string, "(", $where1 + 1;
    
18.     while( $where3 < $where2 and $where3 != -1 ){
    
19.         $where2 = index $string, ")", $where2 + 1;
    
20.         $where3 = index $string, "(", $where3 + 1 ;
    
21.     }
    
22.     return [ $where1, $where2 - 1 ];
    
23. }

复制代码

黑色阳光_cu

正则版本

1. #!/bin/env perl
   
2. 
   
3. use strict;
   
4. use warnings;
   
5. use 5.010;
   
6. 
   
7. while (my $str = <DATA>)
   
8. {
   
9.         chomp $str;
   
10. 
    
11.         print "$str => ";
    
12.         my @stack;
    
13.         foreach (0 .. 1)
    
14.         {
    
15.                 $str =~ /(\()(?=((?:[^()]|(?1)(?2))+(\))))/g;
    
16.                 push(@stack, [$-[1], $-[3]]);
    
17.         }
    
18. 
    
19.         substr($str, $stack[1][1], 1) = "";
    
20.         substr($str, $stack[1][0], 1) = "";
    
21.         print "$str\n";
    
22. }
    
23. 
    
24. __DATA__
    
25. (((1,2),3),4)
    
26. ((1,2),(3,4))
    
27. (1,(2,(3,4)))
    

复制代码

黑色阳光_cu

1. $str =~ /
   
2. (\()        # $1: 匹配左括号
   
3. (?=        # 整体是1个环视，这样，第1次匹配成功会从第1个左括号开始，第2个次匹配成功会从第2个左括号开始，以此类推
   
4.         (        # $2: 匹配括号里的内容加上$3
   
5.                 (?:        # 分组不捕获
   
6.                         [^()] # 要么不包括括号
   
7.                         |
   
8.                         (?1)(?2)        # 要么是分组1加上分组2的递归
   
9.                 )+
   
10.                 (\)) # $3: 匹配右括号
    
11.         )
    
12. )
    
13. /xg;

复制代码

黑色阳光_cu

二叉树版本

1. #!/bin/env perl
   
2. 
   
3. use strict;
   
4. use warnings;
   
5. use Data::Dumper;
   
6. 
   
7. while (my $str = <DATA>)
   
8. {
   
9.     chomp $str;
   
10. 
    
11.     print "$str => ";
    
12.     my $binary_tree = [undef, undef, undef, -1];    # [左孩子，右孩子，父节点，数据]
    
13.     my $cnt = $binary_tree;
    
14.     my $pos = -1;
    
15.     do
    
16.     {
    
17.         (my $c, $pos) = find_parenthese($str, $pos);
    
18.         if ($pos != -1)
    
19.         {
    
20.             if ($c eq "(")
    
21.             {
    
22.                 while (defined $cnt->[0])
    
23.                 {
    
24.                     $cnt = $cnt->[0];
    
25.                 }
    
26. 
    
27.                 $cnt->[0] = [undef, undef, $cnt, $pos];
    
28.             }
    
29.             else
    
30.             {
    
31.                 $cnt->[1] = [undef, undef, $cnt, $pos];
    
32.                 while (defined $cnt->[1])
    
33.                 {
    
34.                     $cnt = $cnt->[2];
    
35.                 }
    
36.             }
    
37. 
    
38.             $pos = -1 if (defined $binary_tree->[0][0] and defined $binary_tree->[0][1]);
    
39.         }
    
40.     } while ($pos != -1);
    
41. 
    
42.     substr($str, $binary_tree->[0][1][3], 1) = "";
    
43.     substr($str, $binary_tree->[0][0][3], 1) = "";
    
44.     print "$str\n";
    
45. }
    
46. 
    
47. 
    
48. sub find_parenthese
    
49. {
    
50.     my ($str, $base) = @_;
    
51.     $base = -1 if (not defined $base);
    
52.     my ($c, $pos) = ("", -1);
    
53. 
    
54.     my $pos1 = index($str, "(", $base + 1);
    
55.     my $pos2 = index($str, ")", $base + 1);
    
56. 
    
57.     if ($pos1 != -1 and ($pos2 == -1 or $pos1 < $pos2))
    
58.     {
    
59.         $c = "(";
    
60.         $pos = $pos1;
    
61.     }
    
62.     elsif ($pos2 != -1 and ($pos1 == -1 or $pos2 < $pos1))
    
63.     {
    
64.         $c = ")";
    
65.         $pos = $pos2;
    
66.     }
    
67. 
    
68.     return ($c, $pos);
    
69. }
    
70. 
    
71. __DATA__
    
72. (((1,2),3),4)
    
73. ((1,2),(3,4))
    
74. (1,(2,(3,4)))
    

复制代码

黑色阳光_cu

堆栈

1. #!/bin/env perl
   
2. 
   
3. use strict;
   
4. use warnings;
   
5. 
   
6. while (my $str = <DATA>)
   
7. {
   
8.     chomp $str;
   
9. 
   
10.     print "$str => ";
    
11.     my @stack;
    
12.     my ($l_pos, $r_pos);
    
13.     my $pos = -1;
    
14.     do
    
15.     {
    
16.         (my $c, $pos) = find_parenthese($str, $pos);
    
17.         if ($pos != -1)
    
18.         {
    
19.             if ($c eq "(")
    
20.             {
    
21.                 push(@stack, $pos);
    
22.             }
    
23.             else
    
24.             {
    
25.                 $l_pos = pop(@stack);
    
26.                 if ($#stack == 0)
    
27.                 {
    
28.                     $r_pos = $pos;
    
29.                     $pos = -1;
    
30.                 }
    
31.             }
    
32.         }
    
33.     } while ($pos != -1);
    
34. 
    
35.     substr($str, $r_pos, 1) = "";
    
36.     substr($str, $l_pos, 1) = "";
    
37.     print "$str\n";
    
38. }
    
39. 
    
40. sub find_parenthese
    
41. {
    
42.     my ($str, $base) = @_;
    
43.     $base = -1 if (not defined $base);
    
44.     my ($c, $pos) = ("", -1);
    
45. 
    
46.     my $pos1 = index($str, "(", $base + 1);
    
47.     my $pos2 = index($str, ")", $base + 1);
    
48. 
    
49.     if ($pos1 != -1 and ($pos2 == -1 or $pos1 < $pos2))
    
50.     {
    
51.         $c = "(";
    
52.         $pos = $pos1;
    
53.     }
    
54.     elsif ($pos2 != -1 and ($pos1 == -1 or $pos2 < $pos1))
    
55.     {
    
56.         $c = ")";
    
57.         $pos = $pos2;
    
58.     }
    
59. 
    
60.     return ($c, $pos);
    
61. }
    
62. 
    
63. __DATA__
    
64. (((1,2),3),4)
    
65. ((1,2),(3,4))
    
66. (1,(2,(3,4)))
    

复制代码

2gua

越短越好呢。

ace_fei

黑色阳光_cu 发表于 2011-02-21 00:55

我拷过去执行出现错误
Sequence (?1...) not recognized in regex; marked by <-- HERE in m/(\()(?=((?:[^()]|(?1 <-- HERE )(?2))+(\))))/ at 2.pl line 11.

justlooks

回复 9# ace_fei


    检查下perl的版本，这个是5.10的新特性