Question

示例。

如果输入为

输出应为

因此，如果原始未排序的列没有这样的字符串，则每一行必须仅包含相同的值或undef。列中的值应按字母顺序排序。

如何实现这种排序？

P.S。原始任务-我们有一些模块，我们想在视觉上比较它们的名称相似功能。

Answer 1

也许是这样？

use warnings;
use strict;

my @data = (
    { name => 'Foo', funcs => [qw/abc def ghi xyz/] },
    { name => 'Bar', funcs => [qw/def jkl mno uvw xyz/] },
    { name => 'Baz', funcs => [qw/abc uvw xyz/] },
);

my %allfuncs = ( map { map {$_=>undef} @{$$_{funcs}} } @data );
$$_{funcs} = { %allfuncs, map {$_=>1} @{$$_{funcs}} } for @data;

use Data::Dump;
dd @data;

# just for output:
use List::Util qw/max/;
my $maxlen = max map {length} map({$$_{name}} @data), keys(%allfuncs);
my $fmt = join('  ', ("%${maxlen}s") x @data)."\n";
printf $fmt, map { $$_{name} } @data;
for my $f (sort keys %allfuncs) {
    printf $fmt, map { $$_{funcs}{$f}?$f:'' } @data;
}

输出：

(
  {
    funcs => { abc => 1, def => 1, ghi => 1, jkl => undef, mno => undef, uvw => undef, xyz => 1 },
    name  => "Foo",
  },
  {
    funcs => { abc => undef, def => 1, ghi => undef, jkl => 1, mno => 1, uvw => 1, xyz => 1 },
    name  => "Bar",
  },
  {
    funcs => { abc => 1, def => undef, ghi => undef, jkl => undef, mno => undef, uvw => 1, xyz => 1 },
    name  => "Baz",
  },
)
Foo  Bar  Baz
abc       abc
def  def     
ghi          
     jkl     
     mno     
     uvw  uvw
xyz  xyz  xyz

更新：如果您输入的数据以AoA的形式出现，则它需要@table并产生与上述相同的@data（它基本上会转置AoA，然后产生哈希结构）：

my @table = ( [qw/Foo Bar Baz/], [qw/abc def abc/], [qw/def jkl uvw/],
    [qw/ghi mno xyz/], [qw/xyz uvw/], [undef, qw/xyz/] );
my @data;
for my $col ( 0 .. $table[0]->$#* )
    { push @data, [ map {$_->[$col]//()} @table ] }
@data = map { {name=>shift @$_, funcs=>$_} } @data;

如果您还需要将输出格式设为AoA：

my @out = ( [map {$$_{name}} @data] );
for my $f (sort keys %allfuncs)
    { push @out, [ map {$$_{funcs}{$f}?$f:undef} @data ] }

产生@out：

(
  ["Foo", "Bar", "Baz"],
  ["abc", undef, "abc"],
  ["def", "def", undef],
  ["ghi", undef, undef],
  [undef, "jkl", undef],
  [undef, "mno", undef],
  [undef, "uvw", "uvw"],
  ["xyz", "xyz", "xyz"],
)

Answer 2

一些手动但希望清晰的方法来“填充”缺失点：收集所有值的排序引用，并使用它“填充”（空）以填充每个arrayref列中的缺失元素

@data

另一种方法是逐行检查每个元素，然后再次使用参考列表进行打印。我认为，这里使用的列式预处理应该更加灵活和通用。

上面的照片

[
  ["abc", "def", "ghi", undef, undef, undef, "xyz"],
  [undef, "def", undef, "jkl", "mno", "uvw", "xyz"],
  ["abc", undef, undef, undef, undef, "uvw", "xyz"],
]

其中Data::Dump产生的字符串“ undef ”表示什么都没有的数组条目。

现在use List::Util qw(max); my $fmt = '%' . (max map { length } @all) . 's'; say join "\t", map { sprintf $fmt, $_ } qw(Foo Bar Baz); for my $i (0..$#{$data[0]}) { say join "\t", map { sprintf $fmt, $_->[$i]//'' } @data; }可用于以选定的格式打印，例如

open my $fh, '>', 'out.csv' or die "Can't open: $!";
say $fh join ',', qw(Foo Bar Baz);
foreach my $i (0..$#{$data[0]}) {
    say $fh join ',', map { $_->[$i]//'' } @data;
}

以所需的“输出”方式打印表的内容。为了快速对齐，我对所有字段使用最长字的宽度；使用文本格式模块可以最轻松地改善这一点。

如果这是电子表格（例如问题中的表格），则只需用逗号连接字段

type Query {
  getUser(filters:UserFilter): User
}

input UserFilter{
    ID : Int,
    Username : String
}

Answer 3

以下代码应执行此操作，输出格式为CSV：

#!/usr/bin/perl
use strict;
use warnings;

use Text::CSV_XS qw( );

my $csv = Text::CSV_XS->new({ binary => 1, auto_diag => 2 });

my @headers = qw(Foo Bar Baz);
my @columns = (
    [qw/abc def ghi xyz/],
    [qw/def jkl mno uvw xyz/],
    [qw/abc uvw xyz/],
);

my %output;
my $N       = scalar(@columns);
my @new_row = ('') x $N;

foreach my $index (0..$N-1) {
    my $column = $columns[$index];

    foreach my $key (@{ $column }) {
        $output{$key} ||= [ @new_row ];
        $output{$key}->[$index] = $key;
    }
}

$csv->say(\*STDOUT, \@headers);

# NOTE: add {....} after sort for special sorting requirements
foreach my $key (sort keys %output) {
    $csv->say(\*STDOUT, $output{$key});
}

示例输出：

$ perl dummy.pl
Foo,Bar,Baz,
abc,,abc,
def,def,,
ghi,,,
,jkl,,
,mno,,
,uvw,uvw,
xyz,xyz,xyz,

注意：：以上是默认的排序算法，但是您可以插入自己的示例，例如

# reverse sort
foreach my $key (sort { $b cmp $a } keys %output) {

感谢您的提问。这很有趣：-）

EDIT2 ：根据问题的格式猜测输入也可能是CSV，因此该算法基于行的变体可能更合适。

#!/usr/bin/perl
use strict;
use warnings;

use Text::CSV_XS qw( );

my $csv = Text::CSV_XS->new({ binary => 1, auto_diag => 2 });

my $headers;
my @new_row;

my %keys;
my $line = 0;
while ( my $row = $csv->getline(\*STDIN) ) {
    if ($line == 0) {
        $headers = $row;
        @new_row = ('') x @$row;
    } else {
        foreach my $index (0..$#$row) {
            my $key = $row->[$index];
            $keys{$key} ||= [ @new_row ];
            $keys{$key}->[$index] = $key;
        }
    }

    $line++;
}

# delete "undefined" key
delete $keys{''};

$csv->say(\*STDOUT, $headers);
# NOTE: add {....} after sort for special sorting requirements
$csv->say(\*STDOUT, $keys{$_}) foreach (sort keys %keys);

示例输出：

$ cat input.csv 
Foo,Bar,Baz
abc,def,abc
def,jkl,uvw
ghi,mno,xyz
xyz,uvw,
,xyz,

$ perl dummy.pl <input.csv 
Foo,Bar,Baz
abc,,abc
def,def,
ghi,,
,jkl,
,mno,
,uvw,uvw
xyz,xyz,xyz

Answer 4

另一种使用哈希和数组以及Hash :: Merge的解决方案。查看您的示例，我得出的结论是，只要您跟踪它们所属的列，就可以将表中的每个值存储为单个哈希条目。创建未排序的哈希后，程序将使用示例打印算法结束，以所需的格式提取数据。

use warnings;
use strict;
use Hash::Merge ;

my @data = (
    { name => 'Foo', funcs => [qw/abc def ghi xyz/] },
    { name => 'Bar', funcs => [qw/def jkl mno uvw xyz/] },
    { name => 'Baz', funcs => [qw/abc uvw xyz/] },
);

my $merger = Hash::Merge->new('RETAINMENT_PRECEDENT');
my $unsorted = {} ;
for my $i ( 0..$#data) {
    my $tmpH = {} ;
    foreach( @{$data[$i]->{funcs}} ) {
        if( exists $tmpH->{ $_ } ) {
            push @{$tmpH->{ $_ }}, $i ;
        } else {
            $tmpH->{ $_ } = [ $i ] ;
        }
    } ;
    $unsorted = $merger->merge( $unsorted, $tmpH ) ;
}
print "Foo\tBar\tBaz\n" ;
foreach ( sort keys %{$unsorted} ) {
    my @txt;
    @txt[@{$unsorted->{ $_ }}] = ($_) x @{$unsorted->{ $_ }} ;
    {
        no warnings 'uninitialized';
        printf("%s\t%s\t%s\n", $txt[0], $txt[1], $txt[2]) ; 
    }
}
__END__
Foo     Bar     Baz
abc             abc
def     def
ghi
        jkl
        mno
        uvw     uvw
xyz     xyz     xyz

按列中的相同值对表（或二维数组）排序

4 个答案: