perl排序,按照频数由大到小排序

gr33n

各位大大能不能给我这个统计排序的perl脚本 ?
各位大大好:

一个字符串, 是由字符 A, B, C, D 字符组成的。如:
ABDCDCDC

1: 按照 输入值 K值 进行分割，分割成每 K个字符 一组。如:

K = 1   A B D C D C D C 共8组
K = 2   AB DC DC DC     共4组
K = 3   ABD CDC DC      共3组

2: 统计每组字符的数值:
字符的值 A = 0, B = 1, C = 2, D = 3

每组字符数值计算公式如:
DC  值 3, 2                 => (3 * 4**1) + (2 * 4**0) = 14
ABC 值 0, 1, 2 => (0 * 4**2) + (1 * 4**1) + (2 * 4**0) = 6


3: 结果按照频数由大到小排序, 如:

字符串: ABDCDCDC
K = 2, 共4组字符, AB DC DC DC 输出为:
字符组  频数  每组字符的数值



DC  3   14
AB  1   1


各位大大能不能给我这个统计排序的perl脚本 ?

字符串: ABDCDCDCAABBCDCCABBB
K值: 输入
输出为: ?

stanley_tam

偶试试{:3_195:}

1. #!perl
   
2. use strict;
   
3. use v5.10;
   
4. use Readonly;
   
5. use English;
   
6. 
   
7. ##############################################################################
   
8. # claim subs and vars
   
9. ##############################################################################
   
10. Readonly::Hash our %numeric_value_of => (
    
11.     A => 0,
    
12.     B => 1,
    
13.     C => 2,
    
14.     D => 3,
    
15. );
    
16. 
    
17. 
    
18. sub main;
    
19. sub get_input;
    
20. sub my_split;
    
21. sub calc;
    
22. sub format_write;
    
23. 
    
24. ##############################################################################
    
25. # main
    
26. ##############################################################################
    
27. main();
    
28. 
    
29. ##############################################################################
    
30. # subs
    
31. ##############################################################################
    
32. sub main {
    
33.     my ($string_from_input, $K) = get_input();
    
34.     my @letter_groups    = my_split($string_from_input, $K);
    
35.     my %occurrences_of   = ();
    
36.     my %values_of        = ();
    
37. 
    
38. 
    
39.     # get occurrences
    
40.     $occurrences_of{$_}++ for @letter_groups;
    
41. 
    
42.     # sort by occurrences value   
    
43.     my @sorted_keys = sort {
    
44.         $occurrences_of{$b} <=> $occurrences_of{$a}
    
45.         } keys %occurrences_of;
    
46. 
    
47.     # calculate values for letter
    
48.     $values_of{$_} = calc($_) for keys %occurrences_of;
    
49. 
    
50.     # output
    
51.     say 'Output: ';
    
52.     say 'Letters  Occurrences  Values';
    
53.     for my $key (@sorted_keys){
    
54.         format_write($key, $occurrences_of{$key}, $values_of{$key});
    
55.     }
    
56. 
    
57. }
    
58. 
    
59. 
    
60. sub get_input {
    
61.     my $string_from_input = q{};
    
62.     my $K = 0;
    
63.     while ($string_from_input !~ m{^ [ABCD]+ $}mx) {
    
64.         print 'String: ';
    
65.         chomp ($string_from_input = <STDIN>);
    
66.     }
    
67. 
    
68.     while ($K !~ m{^ [1-9] \d*$}mx) {
    
69.         print 'K: ';
    
70.         chomp ($K = <STDIN>);
    
71.     }
    
72. 
    
73.     while ($K > length $string_from_input) {
    
74.         print 'K: ';
    
75.         chomp ($K = <STDIN>);
    
76.     }
    
77.     return $string_from_input, $K;
    
78. }
    
79. 
    
80. sub my_split {
    
81.     my ($string_from_input, $K) = @_;
    
82.     my @letter_groups = $string_from_input =~ m{ (:? \w{$K}) }gx;
    
83.     push @letter_groups, $POSTMATCH if $POSTMATCH;
    
84. 
    
85.     return @letter_groups;
    
86. }
    
87. 
    
88. sub calc {
    
89.     my $string = shift;
    
90.     my $result = 0;
    
91.     my @values = reverse map {$numeric_value_of{$_}} split //, $string;
    
92. 
    
93.     for my $i (0 .. $#values){
    
94.         my $value = $values[$i];
    
95.         $result += $value * 4 ** $i;
    
96.     }
    
97.     return $result;
    
98. }
    
99. 
    
100. sub format_write {
     
101.     my ($letter, $occurrence, $value) = @_;
     
102. format WRITELETTER =
     
103. @<<<<<<<<   @||||   @>>>>>>
     
104. $letter, $occurrence, $value
     
105. .
     
106.     $FORMAT_NAME = 'WRITELETTER';
     
107.     write;
     
108. }
     
109. 
     
110. __END__

复制代码

gr33n

好厉害！谢谢大大了。