1行目を比較して,重複する配列で且つ添え字の若いもの（@array = <DATA>）を削除します.
以下結果です
Z 100 10 10
SC 200 5 9
SA 200 70 5
CC 100 100 9
BB 300 50 2
AA 100 70 5
c 5 0 0 9
上記の結果を元に,2行目の数字を比較して,降順にソートします.
BB 300 50 2
SC 200 5 9
SA 200 70 5
Z 100 10 10
CC 100 10 9
AA 100 70 5
c 5 0 0 9
上記の結果を元に,2行目が,同一の場合のペアのみを選び出して,3行目の数字を比較して,2行目の並びは崩さず降順にソートします.
BB 300 50 2
SA 200 70 5
SC 200 5 9
AA 100 70 5
CC 100 10 9
Z 100 10 10
c 5 0 0 9
上記の結果を元に,2,3行目が,同一のペアのみを選び出して,4行目の数字を比較して,降順にソートします.
BB 300 50 2
SA 200 70 5
SC 200 5 9
AA 100 70 5
Z 100 10 10
CC 100 10 9
c 5 0 0 9
以上のようなPerlプログラムを作りたいのですが,どなたか,動作するものを書いていただけないでしょうか？
宜しくお願い致します.
__DATA__
Z 100 10 10
AA 100 70 5
BB 200 50 1
SC 200 5 9
SA 200 70 5
AA 110 60 7
CC 160 10 9
BB 300 50 2
AA 100 70 1
c 5 0 0 9
以下,長々と続きます
No.1
58
10
100pt
data.txt
Z 100 10 10
AA 100 70 5
BB 200 50 1
SC 200 5 9
SA 200 70 5
AA 110 60 7
CC 100 10 9
BB 300 50 2
AA 100 70 5
c 5 0 0 9
my_sort.pl
use strict;
use Data::Dumper;
open my $fh, "data.txt";
my @data;
while(<$fh>){
chomp;
push @data, $_;
}
@data = remove_dup( @data );
@data = sort my_custom_sort @data;
foreach(@data){
print $_, "\n";
}
sub remove_dup{
my(@data)=@_;
my @new_data;
my %exists;
while(my $val = pop @data){
my @record = split /\s+/, $val;
unless( $exists{ $record[0] } ) {
unshift @new_data, $val;
$exists{ $record[0] }=1;
}
}
return @new_data;
}
sub my_custom_sort {
my(@a) = split /\s+/, $a;
my(@b) = split /\s+/, $b;
if($a[1]!=$b[1]){
return $b[1]<=>$a[1];
}
elsif($a[2]!=$b[2]){
return $b[2]<=>$a[2];
}
elsif($a[3]!=$b[3]){
return $b[3]<=>$a[3];
}
else{
return $b[4]<=>$a[4];
}
}
結果
BB 300 50 2
SA 200 70 5
SC 200 5 9
AA 100 70 5
Z 100 10 10
CC 100 10 9
c 5 0 0 9
「行」ではなくて「列」ですよね。あと、データと結果が食い違っているので混乱しました。
URLはダミーです。 http://d.hatena.ne.jp/yoshifumi1975/
No.1
5810
ここでベストアンサー
100pt
data.txt
Z 100 10 10
AA 100 70 5
BB 200 50 1
SC 200 5 9
SA 200 70 5
AA 110 60 7
CC 100 10 9
BB 300 50 2
AA 100 70 5
c 5 0 0 9
my_sort.pl
use strict;
use Data::Dumper;
open my $fh, "data.txt";
my @data;
while(<$fh>){
chomp;
push @data, $_;
}
@data = remove_dup( @data );
@data = sort my_custom_sort @data;
foreach(@data){
print $_, "\n";
}
sub remove_dup{
my(@data)=@_;
my @new_data;
my %exists;
while(my $val = pop @data){
my @record = split /\s+/, $val;
unless( $exists{ $record[0] } ) {
unshift @new_data, $val;
$exists{ $record[0] }=1;
}
}
return @new_data;
}
sub my_custom_sort {
my(@a) = split /\s+/, $a;
my(@b) = split /\s+/, $b;
if($a[1]!=$b[1]){
return $b[1]<=>$a[1];
}
elsif($a[2]!=$b[2]){
return $b[2]<=>$a[2];
}
elsif($a[3]!=$b[3]){
return $b[3]<=>$a[3];
}
else{
return $b[4]<=>$a[4];
}
}
結果
BB 300 50 2
SA 200 70 5
SC 200 5 9
AA 100 70 5
Z 100 10 10
CC 100 10 9
c 5 0 0 9
「行」ではなくて「列」ですよね。あと、データと結果が食い違っているので混乱しました。
URLはダミーです。 http://d.hatena.ne.jp/yoshifumi1975/
回答いただきありがとうございます。
＞「行」ではなくて「列」ですよね。あと、データと結果が食い違っているので混乱しました。
大変失礼いたしました。
動作の方は、Excelで作成したデータと完全に一致しました。
ありがとうございました！
No.2
2915301
30pt
PerlはWindows版バージョン5.8.8で動作確認
単純にprint出力しているだけですので、改行コードの追加等は適宜行ってください。
40
35
#読み込み
open("I","test.txt");
@a=<I>;
close("I");
#重複削除（一列目を比較して重複するものは添え字の若い者を削除）
@b=grep{!$count{(split(/ /,$_))[0]}++}sort{(split(/ /,$a))[0] cmp (split(/ /,$b))[0] || (split(/ /,$b))[1] <=> (split(/ /,$a))[1] || (split(/ /,$b))[2] <=> (split(/ /,$a))[2] || (split(/ /,$b))[3] <=> (split(/ /,$a))[3];}@a;
#並び替え（まず２列目数値降順、次に３列目数値降順、さらに４列目数値降順、最後に１列目文字列昇順）
@c=sort{(split(/ /,$b))[1] <=> (split(/ /,$a))[1] || (split(/ /,$b))[2] <=> (split(/ /,$a))[2] || (split(/ /,$b))[3] <=> (split(/ /,$a))[3] || (split(/ /,$a))[0] cmp (split(/ /,$b))[0];}@b;
print @c;
項目によるソートの動作確認には以下のように作業を順に複雑にしていってみてください。
#読み込み
open("I","test.txt");
@a=<I>;
close("I");
#項目による並び替え
@b=sort{(split(/ /,$a))[0] cmp (split(/ /,$b))[0];}@a;
print @b;
#複数項目による並び替え
# １列目で比較して、同じであればさらに２列目で比較する
@c=sort{(split(/ /,$a))[0] cmp (split(/ /,$b))[0] || (split(/ /,$b))[1] <=> (split(/ /,$a))[1];}@a;
print @c;
#以下略
回答いただきありがとうございます。
WinXp,Perl5.8.8で環境は同じものですが、大量のデータを入れた時、
重複削除の部分が思った通りの動作をしませんでした。
恐らく、添え字の大きなものから削除されているのではないかと思います。
kn1967
2008/06/04 20:47:19
1
2
1
2
回答いただきありがとうございます。
＞「行」ではなくて「列」ですよね。あと、データと結果が食い違っているので混乱しました。
大変失礼いたしました。
動作の方は、Excelで作成したデータと完全に一致しました。
ありがとうございました！