在文件A中查找B、C、D中存在的元素，有的則為y，無則為n

米蘭的_小木匠

各位大神，請出手相助

在文件A中查找BCD中存在的元素，有的則為y，無則為n

處理前：

file A：             file B：        file C：        file D：
小明           小明                小紅           小蔡
小王                 小王           小黃                小楊
小李                 小紅                小蔡            小牛
小東                       
小蔡                       
小楊                       
小牛                       
小紅                       
小黃                       


處理后：


file A：             file B：        file C：        file D：
小明            y                  n               n
小王            y               n               n
小李            n                  n               n
小東            n                  n               n
小蔡            n                  y               y
小楊            n                  n               y
小牛            n                  n               y
小紅            y                  y               n
小黃            n                  y               n

謝謝！

stanley_tam

試試這個{:3_184:}

1. #!perl
   
2. use Modern::Perl;
   
3. use FileHandle;
   
4. 
   
5. my $data_href = +{};
   
6. 
   
7. for my $file ('a', 'b', 'c', 'd'){
   
8.     my @lines = FileHandle->new($file, 'r')->getlines;
   
9.     chomp @lines;
   
10.     $data_href->{$file} = \@lines;
    
11. }
    
12. 
    
13. my $out_fh = FileHandle->new('output.txt', 'w');
    
14. $out_fh->printf("%-10s%-10s%-10s%s$/", 'file A:', 'file B:', 'file C:', 'file D:');
    
15. 
    
16. for my $a_item ( @{ $data_href->{a} } ){
    
17.     my $in_b = $a_item ~~ $data_href-> ? 'Y' : 'N';
    
18.     my $in_c = $a_item ~~ $data_href->{c} ? 'Y' : 'N';
    
19.     my $in_d = $a_item ~~ $data_href->a9ur7n9vt ? 'Y' : 'N';
    
20.     $out_fh->printf("%-10s%-10s%-10s%s$/", $a_item, $in_b, $in_c, $in_d);
    
21. }
    
22. $out_fh->close;
    
23. 
    
24. __END__

復(fù)制代碼

substr函數(shù)

我想問一下，1 file ?  4 file ? 謝謝！

米蘭的_小木匠

本人小白一個，使用了一個awk命令，awk -v OFS='\t' 'NR==FNR{x[$1]=1}NR>FNR{if(x[$1]){a="y"}else{a="n"} print $0,a}'  file1  file2，就是要重復(fù)幾次

45177659

1. $ cat search.pl
   
2. #!/usr/bin/perl -w
   
3. 
   
4. @file_list = qw/B C D/;
   
5. $pat = qw/A/;
   
6. 
   
7. # construct hash table
   
8. foreach my $file (@file_list) {
   
9.         open(my $fh, $file) or die;
   
10.         while (defined (my $item = <$fh>)) {
    
11.                 next if $item =~ /^\s*$/;
    
12.                 chomp $item;
    
13.                 $file{$item} = 1;
    
14.         }
    
15.         close $fh;
    
16. }
    
17. 
    
18. # search for each pattern in file a
    
19. open($pat, "$pat") or die;
    
20. print "A      B   C   D\n";
    
21. while (defined(my $item = <$pat>)) {
    
22.         next if $item =~ /^\s*$/;
    
23.         chomp $item;
    
24.         print $item;
    
25.         foreach my $file (@file_list) {
    
26.                 print exists $$file{$item} ? "   y" : "   n";
    
27.         }
    
28.         print "\n";
    
29. }
    
30. 
    
31. close $pat;
    

復(fù)制代碼

result:
$ ./search.pl
A      B   C   D
小明   y   n   n
小王   y   n   n
小李   n   n   n
小東   n   n   n
小蔡   n   y   y
小楊   n   n   y
小牛   n   n   y
小紅   n   y   n
小黃   n   y   n

mcshell

1. my @files = qw/A B C D/;
   
2. my ( $g;
   
3. print join "\t", @files, "\n";
   
4. my $all = shift @files;
   
5. for my $file (@files) {
   
6.     open FH, $file or die $!;
   
7.     while (<FH>) {
   
8.         chomp;
   
9.         push @{ $g->{$file} }, $_;
   
10.     }
    
11. }
    
12. open FA, $all or die $!;
    
13. while (  my $line = <FA>  ) {
    
14.     chomp $line;
    
15.     print $line;
    
16.     my $letter;
    
17.     for my $file (@files) {
    
18.         for ( @{ $g->{$file} } ) {
    
19.             $line eq $_ ? do { $letter = "y"; last } : do { $letter = "n" };
    
20.         }
    
21.         print "\t$letter";
    
22.     }
    
23.     print "\n";
    
24. }

復(fù)制代碼

rubyish

perl abc.pl file1 > file2

1. #!/usr/bin/perl
   
2. my ( %h, @k );
   
3. my $title = <>;
   
4. my $max   = ( $title =~ tr/\t// ) - 1;
   
5. print $title;
   
6. 
   
7. while (<>) {
   
8.     chomp;
   
9.     my ( $k, @ks ) = split /\t/;
   
10.     push @k, $k;
    
11.     $h{ $ks[$_] }[$_] = 'y' for 0 .. $#ks;
    
12. }
    
13. 
    
14. for my $k (@k) {
    
15.     print join( "\t", $k, map { $h{$k}[$_] || 'n' } 0 .. $max ), $/;
    
16. }
    
17. 
    

復(fù)制代碼

609854

回復(fù) 1# 米蘭的_小木匠

1. my @fileA = qw(小明 小王 小李 小東 小蔡 小楊 小紅);
   
2. my @fileB = qw(小明 小王 小紅);
   
3. my %hash;
   
4. 
   
5. foreach my $item (@fileB){
   
6.         $hash{$item} = 1;
   
7. }
   
8. 
   
9. foreach my $item (@fileA){
   
10.         if($hash{$item}){
    
11.                 print "$item -> Y\n";
    
12.         }
    
13.         else
    
14.         {
    
15.                 print "$item -> N\n";
    
16.         }
    
17. }

復(fù)制代碼

1. 小明 -> Y
   
2. 小王 -> Y
   
3. 小李 -> N
   
4. 小東 -> N
   
5. 小蔡 -> N
   
6. 小楊 -> N
   
7. 小紅 -> Y

復(fù)制代碼

leo66888

mark downhere

huang6894

菜鳥也來一個吧。。。
不過，總是感覺哪不對。。。

1. my ( %h, @k );
   
2. my $ref = shift @ARGV;
   
3. my $title = 'file\name';
   
4. open REF, $ref or die "$!";
   
5. map {chomp;$title .= "\t$_"} <REF>;
   
6. close REF;
   
7. foreach my $value(@ARGV){
   
8.         open RT, $value or die "$!";
   
9.         map {chomp;$h->{$value}->{$_} = 'y';}<RT>;
   
10.         open REF, $ref or die "$!";
    
11.         push @k, join( "\t", $value, map {chomp;$h->{$value}->{$_} || 'n';} <REF>)."\n";
    
12.         close REF;
    
13.         close RT;
    
14. }
    
15. 
    
16. print "$title\n@k";
    
17. 
    
18. 
    
19. ---------------------------------
    
20. perl test.pl ref file1 file2 file3
    
21. file\name    小明    小王    小李    小東    小蔡    小楊    小牛    小紅    小黃
    
22. file1   y       y       n       n       n       n       n       y       n
    
23. file2  n       n       n       n       y       n       n       y       y
    
24. file3  n       n       n       n       y       y       y       n       n
    

復(fù)制代碼