source: branches/stable/PERL_SCRIPTS/GENERAL/listDiff.pl

Last change on this file was 5562, checked in by westram, 15 years ago
  • given 2 lists of species (or accs, …) create difference lists and common list
  • Property svn:executable set to *
File size: 2.5 KB
Line 
1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
6sub getContent($\%) {
7  my ($fname,$content_r) = @_;
8
9  my $dups_removed = 0;
10  open(LIST,'<'.$fname) || die "can't read '$fname' (Reason: $!)";
11  my $line;
12  while (defined($line=<LIST>)) {
13    # remove whitespace:
14    chomp($line);
15    $line =~ s/^\s+//og;
16    $line =~ s/\s+$//og;
17
18    if ($line ne '') {
19      if (defined $$content_r{$line}) { $dups_removed++; }
20      $$content_r{$line} = 1;
21    }
22  }
23  close(LIST);
24  if ($dups_removed>0) {
25    print "Warning: $dups_removed duplicate lines were ignored (while reading $fname)\n";
26  }
27}
28
29sub saveContent(\%$) {
30  my ($content_r, $fname) = @_;
31
32  open(LIST, '>'.$fname) || die "can't write to '$fname' (Reason: $!)";
33  my @lines = sort keys %$content_r;
34  foreach (@lines) { print LIST $_."\n"; }
35  close(LIST);
36
37  my $lines = scalar(@lines);
38  print "$fname: $lines entries written\n";
39}
40
41sub main() {
42  my $args = scalar(@ARGV);
43  if ($args != 2) {
44    die
45      "Usage: listDiff.pl list1 list2\n".
46      "       Writes differences (to list1.only and list2.only)\n".
47      "       and similarities (to list1.list2.common)\n";
48  }
49
50  my $list1 = $ARGV[0];
51  my $list2 = $ARGV[1];
52
53  if (not -f $list1) { die "No such file '$list1'\n"; }
54  if (not -f $list2) { die "No such file '$list2'\n"; }
55
56  my $list1_only  = $list1.'.only';
57  my $list2_only  = $list2.'.only';
58  my $list_common = $list1.'.'.$list2.'.common';
59
60  if (-f $list1_only)  { die "File already exists: '$list1_only'\n"; }
61  if (-f $list2_only)  { die "File already exists: '$list2_only'\n"; }
62  if (-f $list_common) { die "File already exists: '$list_common'\n"; }
63
64  my %content1 = (); getContent($list1,%content1);
65  my %content2 = (); getContent($list2,%content2);
66
67  my $content1 = scalar(keys %content1);
68  my $content2 = scalar(keys %content2);
69
70  print "$list1: $content1 unique entries\n";
71  print "$list2: $content2 unique entries\n";
72
73  my %unique1 = ();
74  my %unique2 = ();
75  my %common  = ();
76
77  foreach (keys %content1) {
78    if (defined $content2{$_}) { $common{$_} = 1; }
79    else { $unique1{$_} = 1; }
80  }
81  foreach (keys %content2) {
82    if (not defined $content1{$_}) { $unique2{$_} = 1; }
83  }
84
85  my $unique1 = scalar(keys %unique1);
86  my $unique2 = scalar(keys %unique2);
87  my $common  = scalar(keys %common);
88
89  my $sum_old = $content1+$content2;
90  my $sum_new = $unique1+2*$common+$unique2;
91
92  if ($sum_old != $sum_new) { die "Number of entries changed -- logic error"; }
93
94  saveContent(%unique1, $list1_only);
95  saveContent(%unique2, $list2_only);
96  saveContent(%common, $list_common);
97}
98main();
99
Note: See TracBrowser for help on using the repository browser.