[文本处理] 各位大大能不能给我这个标示的脚本?

104359176

1. #!perl
   
2. 
   
3. use 5.016;
   
4. use YAML qw(Dump);
   
5. 
   
6. my @array = <DATA>;
   
7. chomp @array;
   
8. 
   
9. my @pattern_list = qw(
   
10. X+$
    
11. X+A
    
12. X+B[^X]
    
13. X+B$
    
14. X+B(?<=X)
    
15. X+C$
    
16. X+C(?<=X)
    
17. X+C[^X]$
    
18. X+C[^X](?<=X)
    
19. X+C[^X][^X]
    
20. X+D$
    
21. X+D[^X]$
    
22. X+D[^X][^X]$
    
23. X+D[^X](?<=X)
    
24. X+D[^X][^X](?<=X)
    
25. X+D[^X][^X][^X]
    
26. );
    
27. 
    
28. say Dump(zhuan_zhi(change_array(zhuan_zhi(change_array([@array])))));
    
29. 
    
30. sub wu_ran {
    
31.     my $char_list = shift;
    
32.     foreach my $pat (@pattern_list) {
    
33.         # x equal X
    
34.         $char_list =~ s/($pat)/lc($1)/gei;
    
35.     }
    
36.     return $char_list;
    
37. }
    
38. 
    
39. sub change_wu_ran {
    
40.     my $char_list = shift;
    
41.     $char_list = wu_ran($char_list);
    
42.     $char_list = scalar reverse(wu_ran(scalar reverse($char_list)));
    
43.     return $char_list;
    
44. }
    
45. 
    
46. sub change_array {
    
47.     my $ref_array = shift;
    
48.     my @change_array = ();
    
49.     foreach my $char_list (@{$ref_array}) {
    
50.         my $change_char_list = change_wu_ran($char_list);
    
51.         push @change_array, $change_char_list;
    
52.     }
    
53.     return [ @change_array ];
    
54. }
    
55. 
    
56. sub zhuan_zhi {
    
57.     my $array = shift;
    
58.     my $zhuan_zhi = [];
    
59.     foreach my $char_list (values $array) {
    
60.         my $array_count = 0;
    
61.         foreach my $char (split //, $char_list) {
    
62.             $zhuan_zhi->[$array_count] .= $char;
    
63.             $array_count++;
    
64.         }
    
65.     }
    
66.     return $zhuan_zhi;
    
67. }
    
68. 
    
69. __DATA__
    
70. ABDCDCDCAAXCXCDCCABABDCDCDCAABXBABDCDCDCAABBCDCCAXDBBXABDCDCDCAABBCDXCCA
    
71. BBCDCCABBBABXCDCDCAABBCDXCCABBBBBABDCDCDCAABBCDCCAXBBBABCDAAAXBCDADCAXXX
    
72. XABCDCDCAAXBBCCDCCABABDCDCDCAABXBABDABACCCAXCDCDCAABBCDCCABBBXABDCDCDCAA
    
73. AACDCCAADCABDCDCDCAABXCDXCXABCDDBABDCDCDCAABBXBXCAABBBABCDAAAXBCDADCABBB
    
74. ADCAAAAAXABCDCCCCCDCABXBBCCDCCABABDCDCDCAABXBABDABDCCCAXCDCDCAAAAABBCDCC
    
75. XCCCAABDCAAXXAADCCCCCCAACCAAAAAAAAAXBBDCCXACDACDAAXCBBBBBBBAAABCADDCAAXC
    
76. XABCDCDCAAXBBCCDCCABABDCDCDCAABXBABDABACCCAXCDCDCAABBCDCCABBBXABDCDCDCAA
    

复制代码

output:

1. ---
   
2. - aBDCDCDCaaxCxcdcCABABDCDcDcAabxbaBDCDCDCAABbCdCcaxdbbxaBDCDCDcAAbbcdxcca
   
3. - bBCDCCABbBabxcdcDCAAbbcdxccaBBbbBABDCDCDCAAbBcDcCaxbbbABCDAAaxbcDADCaxxx
   
4. - xaBCDCDCaaxbbCCDCCABAbdCDCdCAabxbaBdABACCCaxcdcdCAaBBcDcCABbbxaBDCDCDcaa
   
5. - aACDCCAAdCabdCDCDCAabxcDxCxaBCDDBABdCDCDCAAbbxBxcaaBBBAbCDAAaxbcDADCAbbB
   
6. - aDCAAAAaxaBcDCCCCCDCabxbbCcDCCABABDcDCDCAabxbaBdABDCCCaxcdcDCaAAAABBCdcC
   
7. - xcccAABDcAaxxaADCCCCCcaAcCaAAAAaAAaxbbdccxaCDACdAaxcbbBbBBBAAaBCADDCAaxc
   
8. - xaBCDCDCaaxbbCCDCCABABDCDCdCAabxbaBdABACCcaxcdcdCAaBBCDcCABbbxaBDCDCDCaA
   

复制代码

rubyish

成功~

1. #!/usr/bin/perl
   
2. 
   
3. my %V = qw/x 0 a 1 b 2 c 3 d 4 X 0 A 1 B 2 C 3 D 4/;
   
4. my %uc = qw/A 1 B 1 C 1 D 1/;
   
5. my ( @data, %X );
   
6. sub MIN { @_[ $_[0] > $_[1] ] }
   
7. 
   
8. while (<DATA>) {
   
9.     chomp;
   
10.     my @line = split //;
    
11.     my @X =
    
12.       grep { $line[$_] eq 'X' and push @{ $X{$_} }, $. - 1 } 0 .. $#line;
    
13.     for my $i ( 0 .. $#X ) {
    
14.         my $L = $i > 0
    
15.           ? MIN( $X[$i] - $X[ $i - 1 ], $V{ $line[ $X[$i] - 1 ] } )
    
16.           : $X[$i] ? MIN( $X[$i], $V{ $line[ $X[$i] - 1 ] } ) : 0;
    
17.         my $R = $i < $#X
    
18.           ? MIN( $X[ $i + 1 ] - $X[$i], $V{ $line[ $X[$i] + 1 ] } )
    
19.           : $#line != $X[$i]
    
20.             ? MIN( $V{ $line[ $X[$i] + 1 ] }, $#line - $X[$i] ) : 0;
    
21.         $line[$_] = lc $line[$_] for $X[$i] - $L .. $X[$i] + $R;
    
22.     }
    
23.     push @data, \@line;
    
24. }
    
25. 
    
26. for my $x ( sort { $a <=> $b } keys %X ) {
    
27.     my @Y = @{ $X{$x} };
    
28.     for my $j ( 0 .. $#Y ) {
    
29.         my $T = $j > 0
    
30.           ? MIN( $Y[$j] - $Y[ $j - 1 ], $V{ $data[ $Y[$j] - 1 ][$x] } )
    
31.           : $Y[$j] ? MIN( $Y[$j], $V{ $data[ $Y[$j] - 1 ][$x] } ) : 0;
    
32.         my $B = $j < $#Y
    
33.           ? MIN( $Y[ $j + 1 ] - $Y[$j], $V{ $data[ $Y[$j] + 1 ][$x] } )
    
34.           : $#data != $Y[$j]
    
35.             ? MIN( $V{ $data[ $Y[$j] + 1 ][$x] }, $#data - $Y[$j] ) : 0;
    
36.         $uc{ $data[$_][$x] } and $data[$_][$x] = lc $data[$_][$x]
    
37.           for $Y[$j] - $T .. $Y[$j] + $B;
    
38.     }
    
39. }
    
40. 
    
41. print @$_, $/ for @data;
    
42. 
    
43. __DATA__
    
44. ABDCDCDCAAXCXCDCCABABDCDCDCAABXBABDCDCDCAABBCDCCAXDBBXABDCDCDCAABBCDXCCA
    
45. BBCDCCABBBABXCDCDCAABBCDXCCABBBBBABDCDCDCAABBCDCCAXBBBABCDAAAXBCDADCAXXX
    
46. ABDXACDCAAXBBCCDCCABABDCDCDCAABXBABDABACCCAXCDCDCAABBCDCCABBBXABDCDCDCAA
    
47. AACDCCAADCABDCDCDCAABXCDXCXABCDDBABDCDCDCAABBXBXCAABBBABCDAAAXBCDADCABBB
    
48. ADCAAAAAXABCDCCCCCDCABXBBCCDCCABABDCDCDCAABXBABDABDCCCAXCDCDCAAAAABBCDCC
    
49. XCCCAABDCAAXXAADCCCCCCAACCAAAAAAAAAXBBDCCXACDACDAAXCBBBBBBBAAABCADDCAAXC
    
50. AAAAXDXBCDCDCAAXBBCCDCCABABDCDCDCAABXBABDABACCCAXCDCDCAABBCDCCABBBXDXAAA

复制代码

104359176

回复 12# rubyish


    你的代码比问题还复杂，基本感觉是在看机器码。如果代码出问题了，估计又要纠结了。

pitonas

回复 11# 104359176


谢谢了，果然 lz的正则匹配功力已经到了遥不可及的地步了。

104359176

回复 14# pitonas


     如果代码让人感觉遥不可及，就危险了，也许我用了后顾的功能，这个确实很多人不知道。其实也可以不用。

    把  (?<=X) 直接替换成 X 也行。不过不知道污染过的数据，还能继续污染吗？

pitonas

回复 15# 104359176



感觉污染过的数据abcd不能继续污染

rubyish

回复 13# 104359176


    谢谢 lz 。简化SLOW版~

1. #!/usr/bin/perl
   
2. my %V = qw/x 0 a 1 b 2 c 3 d 4 X 0 A 1 B 2 C 3 D 4/;
   
3. sub min  { @_[ $_[0] > $_[1] ] }
   
4. sub mark {
   
5.     for my $E (@_) {
   
6.         my @X = grep $E->[$_] =~ /^[Xx]$/, 0 .. $#$E;
   
7.         for my $i ( 0 .. $#X ) {
   
8.             my $L = $i > 0
   
9.               ? min( $X[$i] - $X[ $i - 1 ], $V{ $E->[ $X[$i] - 1 ] } )
   
10.               : $X[$i] ? min( $X[$i], $V{ $E->[ $X[$i] - 1 ] } ) : 0;
    
11.             my $R = $i < $#X
    
12.               ? min( $X[ $i + 1 ] - $X[$i], $V{ $E->[ $X[$i] + 1 ] } )
    
13.               : $#$E != $X[$i]
    
14.                 ? min( $V{ $E->[ $X[$i] + 1 ] }, $#$E - $X[$i] ) : 0;
    
15.             $_ = lc $_ for @{$E}[ $X[$i] - $L .. $X[$i] + $R ];
    
16.     } } @_
    
17. }
    
18. sub rock   { map { $a = $_; [ map $_[$_][$a], 0 .. $#_ ] } 0 .. $#{ $_[0] } }
    
19. sub marked { rock mark rock mark @_ }
    
20. sub data   { map { chomp; [ split // ] } <DATA> }
    
21. 
    
22. print @$_, $/ for marked data;
    

复制代码