git.rot13.org Git - csv-join-similarity/blob - upari.pl

   1 #!/usr/bin/perl
   2
   3 use warnings;
   4 use strict;
   5 use autodie;
   6
   7 # apt install libtext-csv-perl libstring-similarity-perl
   8 use Text::CSV;
   9 use Data::Dump qw(dump);
  10 use String::Similarity;
  11 use Storable;
  12 use Text::Unaccent;
  13
  14 my $debug = $ENV{DEBUG};
  15
  16 my @files = qw( 1.csv 2.csv 3.csv 4.csv );
  17
  18 our $stat;
  19 my $keys;
  20
  21 sub duplicate {
  22         my @for = @_;
  23         my $use;
  24         $use->{$_}++ foreach ( map { @{ $stat->{_}->{$_} } } @for );
  25         my $duplicate = grep { $use->{$_} > 1 } keys %$use;
  26         print "XXX use @for ",dump($use),$/ if $debug && $duplicate;
  27         return $duplicate;
  28 }
  29
  30 sub candidates {
  31         my ( $num, $key_id, $limit_sim ) = @_;
  32         $limit_sim //= $ENV{LIMIT};
  33         $limit_sim //= 0.9;
  34
  35         my @candidates;
  36         foreach my $key ( sort keys %{ $keys->{ $key_id } } ) {
  37                 next if $key eq $num; # XXX don't return key from input
  38                 my $s = similarity $num, $key, $limit_sim;
  39                 #warn "# $num $key $s\n";
  40                 if ($s > $limit_sim ) {
  41                         if ( exists $stat->{_}->{"$key-$key_id"} ) {
  42                                 my $use;
  43                                 $use->{$_}++ foreach (
  44                                         @{ $stat->{_}->{"$num-$key_id"} },
  45                                         @{ $stat->{_}->{"$key-$key_id"} },
  46                                 );
  47                                 #print "XXX use $num $key ",dump($use);
  48                                 my $duplicate = grep { $use->{$_} > 1 } keys %$use;
  49                                 if ( $duplicate ) {
  50                                         print "XXX $limit_sim suggest duplicate  $num $key SKIP duplicate ",dump($use), $/ if $debug;
  51                                         $stat->{suggest}->{duplicate}++;
  52                                 } else {
  53                                         push @candidates, { key => $key, s => $s };
  54                                 }
  55                         } else {
  56                                 print "XXX $limit_sim candidates $key missing\n" if $debug;
  57                         }
  58                 }
  59         }
  60 =for description
  61         for limit 0.6 to work, we need to prefer longer results over shorter ones:
  62         MERGE A0246A 3078-8326 (
  63           { key => "A4065A", s => 0.666666666666667 },
  64           { key => "ANDREJA0246A", s => 0.666666666666667 },
  65   ) val=[3]
  66   .++ A0246A-3078-8326 1 .++ A0246A-3078-8326 2 result val=[3, 1, 2] result_elements=3
  67 =cut
  68
  69         if ( $#candidates > 0 ) {
  70                 #print "XXX candidates before = ",dump( \@candidates ),$/;
  71                 @candidates = sort {
  72                         $b->{s} <=> $a->{s}     # hi -> low
  73                         or length($b->{key}) <=> length($a->{key})
  74                 } @candidates;
  75                 #print "XXX candidates after  = ",dump( \@candidates ),$/;
  76         }
  77         return @candidates;
  78 }
  79
  80 my $keys_file = 'keys.storable';
  81 if ( -e $keys_file ) {
  82         #$keys = retrieve($keys_file) or die "$keys_file: $!";
  83         print "LOAD $keys_file", scalar keys %$keys, "\n";
  84 }
  85
  86 our $data;
  87 our @data_headers;
  88
  89
  90 foreach my $val ( 1 .. 4 ) {
  91         my $file = "$val.csv";
  92         warn "# $file\n";
  93
  94         open(my $duplicate_fh, '>', "duplicate-$val.csv");
  95
  96         my $csv = Text::CSV->new ({ binary => 1, auto_diag => 1 });
  97         open my $fh, "<:encoding(utf8)", $file or die "$file: $!";
  98         while (my $row = $csv->getline ($fh)) {
  99                 $stat->{file}->{$file}->{lines}++;
 100                 $stat->{file}->{$file}->{columns}->{ $#$row }++;
 101
 102                 if ( ! exists $data_headers[$val] ) {
 103                         $data_headers[$val] = $row;
 104                         next;
 105                 }
 106
 107                 if ( $row->[3] ne $row->[1] . $row->[2] ) {
 108                         $stat->{XX_invalid_combined}->{$val}++;
 109                         print "INVALID $file combined [$row->[3]] not [$row->[1]$row->[2]]\n";
 110                 }
 111
 112                 my $c_id = $row->[0];
 113                 my $c_s = $row->[1];
 114                 my $c_r = $row->[2];
 115                 $row->[0] =~ s/[^\w\d]+//ig && $stat->{file}->{$file}->{corrupt_id}->{$c_id}++ && print 'c0';
 116                 $row->[1] =~ s/\D+//g && $stat->{file}->{$file}->{corrupt_s}->{$c_s}++ && print 'c1';
 117                 $row->[2] =~ s/\D+//g && $stat->{file}->{$file}->{corrupt_r}->{$c_r}++ && print 'c2';
 118                 my $id = join('-',
 119                         uc $row->[0],
 120                         $row->[1],
 121                         $row->[2],
 122                 );
 123
 124                 my $num = uc $row->[0];
 125                 if ( length $num < 3 ) {
 126                         print "IGNORE $val ",dump($row->[ 0 .. 5 ]),$/;
 127                         $stat->{ignore}->{$val}++;
 128                         next;
 129                 }
 130
 131                 if ( $row->[3] ne $row->[1] . $row->[2] ) {
 132                         $stat->{XX_invalid_combined_cleanup}->{$val}++;
 133                         print "INVALID $file combined [$row->[3]] not [$row->[1]$row->[2]] after cleanup\n";
 134                 }
 135
 136                 my $key_id = $row->[1] . '-' . $row->[2];
 137
 138                 $stat->{A_key_id}->{$key_id}->{$val}++;
 139
 140                 $keys->{ $key_id }->{ $num }++;
 141
 142                 $stat->{exists}->{$val}++ if exists $stat->{_}->{ $id };
 143
 144                 push @{ $stat->{_}->{ $id } }, $val;
 145
 146                 if ( exists $data->{$key_id}->{$num}->{$val} ) {
 147                         $stat->{file}->{$file}->{duplicate_keyid_num}->{$val}++;
 148
 149                         my $old = $data->{$key_id}->{$num}->{$val};
 150                         print $duplicate_fh join(',', $file, @$old), "\n";
 151                         print $duplicate_fh join(',', $file, @$row), "\n";
 152                         print $duplicate_fh "\n";
 153
 154                         # select row by longer lenght;
 155                         my $l_old = length dump $old;
 156                         my $l_row = length dump $row;
 157
 158                         print "DUPLICATE $file $key_id $num $val len: $l_old < $l_row\n";
 159
 160                         if ( $l_old > $l_row ) {
 161                                 print "DUPLICATE KEEP old longer $l_old row (new only $l_row)\n";
 162                                 next;
 163                         }
 164
 165 =for diff
 166                         my $diff;
 167                         foreach ( 0 .. $#$row ) {
 168                                 if ( $old->[$_] ne $row->[$_] ) {
 169                                         $diff->[$_] = [ $old->[$_], $row->[$_] ];
 170                                 }
 171                         }
 172                         print "diff = ",dump($diff) if $diff;
 173                         #print "old=", dump( $data->{$key_id}->{$num}->{$val} ), $/;
 174                         #print "new=", dump( $row ), $/;
 175 =cut
 176                 }
 177                 # remove .000000 from values
 178                 $data->{$key_id}->{$num}->{$val} = [ map { s/^(\d+)\.0+$/$1/g; $_; } @$row ];
 179         }
 180         close $fh;
 181
 182 }
 183
 184
 185 my $merge_ids;
 186
 187 my $first = 1;
 188 # 0.9 - 0.7 -- 0.6 is too lax
 189 foreach my $limit ( 0.7 ) { #, 0.6 ) {
 190 warn "XXX limit $limit\n";
 191
 192 print "# total = ",scalar keys %{ $stat->{_} }, $/;
 193 foreach my $id ( sort keys %{ $stat->{_} } ) {
 194         my @val;
 195         my $v = $stat->{_}->{$id};
 196         if ( defined $v && ref $v eq 'ARRAY' ) {
 197                 @val = @$v;
 198         } else {
 199                 #print "SKIP[$id]";
 200                 next;
 201         }
 202         my $u;
 203         $u->{$_}++ foreach @val;
 204         my @u_v = sort keys %$u;
 205         if ( $first == 1 ) {
 206                 $stat->{A_count}->{ scalar @val }++;
 207                 $stat->{A_count_total}++;
 208
 209                 #$stat->{A_count_val_dup}->{ join(' ', @val) }++; # with duplicates
 210
 211                 $stat->{A_count_val}->{ join(' ', @u_v ) }++; # without duplicates
 212         }
 213
 214         if ( $#u_v < 3 ) { # single, double
 215                 my ( $num, $key_id ) = split(/-/,$id,2);
 216                 my @candidates = candidates $num => $key_id, $limit; #, 0.7; # XXX 0.9 too high, 0.8 better, 0.7 too lax
 217                 if ( @candidates ) {
 218                         print "MERGE ",scalar @candidates, " $limit $num $key_id ", dump( @candidates ), ' val=', dump( \@val ), $/;
 219                         my @keys = map { $_->{key} } @candidates;
 220                         my  $m_id = $id; # "$keys[0]-$key_id";
 221                         foreach my $i ( 0 .. $#keys ) {
 222                                 my  $id = "$keys[$i]-$key_id";
 223                                 if ( ! exists $stat->{_}->{$id} ) {
 224                                         print "ERROR: $num $key_id can't find $i $id";
 225                                 }
 226
 227                                 # XXX I298O-4743-7996
 228                                 if ( duplicate( $m_id => $id ) ) {
 229                                         print "XXX duplicate2 $m_id $id\n";
 230                                         $stat->{duplicate2}++;
 231                                         next;
 232
 233                                 }
 234
 235                                 my $o = delete $stat->{_}->{$id};
 236                                 die "FATAL: can't find $id" if ! $o;
 237
 238                                 my ( $id_s, $s, $r ) = split('-', $id);
 239                                 my $key_s = "$s-$r";
 240
 241                                 foreach my $val ( @$o ) {
 242                                         print '.';
 243                                         push @{ $stat->{_}->{ $m_id } }, $val;
 244                                         print "++ $m_id $val ";
 245                                         $stat->{merge_val}->{$val}++;
 246
 247
 248                                         die "ERROR merge: $val $id $m_id exists",dump( $merge_ids->{$val}->{$key_s}->{$id_s} ) if exists $merge_ids->{$val}->{$key_s}->{$id_s};
 249                                         my $m_id_s = (split('-',$m_id,3))[0];
 250                                         $merge_ids->{$val}->{$key_s}->{$id_s} = $m_id_s;
 251
 252                                         my $o_row = delete $data->{$key_s}->{$id_s}->{$val};
 253                                         die "FATAL: $id | $m_id | data $key_s $id_s $val" unless $o_row;
 254                                         $data->{$key_s}->{$m_id_s}->{$val} = $o_row;
 255
 256                                 }
 257                                 my @not_empty = sort keys %{ $data->{$key_s}->{$id_s} };
 258                                 die "FATAL: $id_s not empty" if @not_empty;
 259                                 delete $data->{$key_s}->{$id_s}; # FIXME check before cleanup
 260
 261                                 print "result val=",dump( $stat->{_}->{ $m_id } ), " result_elements=", scalar @{ $stat->{_}->{ $m_id } }, $/;
 262                         }
 263                         $stat->{merge}++;
 264                 }
 265
 266         }
 267 }
 268
 269 print "# total after merge $limit = ",scalar keys %{ $stat->{_} }, $/;
 270
 271 foreach my $id ( sort keys %{ $stat->{_} } ) {
 272         my @val; # = @{ $stat->{_}->{$id} };
 273         my $v = $stat->{_}->{$id};
 274         if ( defined $v && ref $v eq 'ARRAY' ) {
 275                 @val = @$v;
 276         } else {
 277                 print "SKIP[$id]";
 278                 next;
 279         }
 280         $stat->{"B${limit}_count"}->{ scalar @val }++;
 281         $stat->{"B${limit}_count_total"}++;
 282
 283         #$stat->{"B${limit}_count_val_dup"}->{ join(' ', @val) }++; # with duplicates
 284
 285         my $u;
 286         $u->{$_}++ foreach @val;
 287         my @u_v = sort keys %$u;
 288         $stat->{"B${limit}_count_val"}->{ join(' ', @u_v ) }++; # without duplicates
 289 }
 290
 291 $first++;
 292 } # for $limit
 293
 294 print "# stat = ",dump( $stat );
 295 #print "# keys = ",dump( $keys );
 296
 297 store $keys, $keys_file;
 298
 299 my $merge_file = 'merge.storable';
 300 store $merge_ids, $merge_file;
 301 #print "XXX merge_ids = ", dump($merge_ids);
 302
 303 my $out_file = 'merged.csv';
 304 print "out_file $out_file";
 305 open(my $out_fh, '>', $out_file);
 306 foreach my $val ( 1 .. 4 ) {
 307         print $out_fh join(',', map { unac_string('utf-8',$_) . '_' . $val } @{ $data_headers[$val] });
 308         print $out_fh ',';
 309 }
 310 print $out_fh "broj_valova";
 311 print $out_fh "\n";
 312
 313 foreach my $key ( sort keys %$data ) {
 314         print " $key";
 315         foreach my $id ( sort keys %{ $data->{$key} } ) {
 316                 #print $out_fh "## $id ## ";
 317
 318                 my $broj_valova = 0;
 319
 320                 foreach my $val ( 1 .. 4 ) {
 321                         if ( my $id_data = $data->{$key}->{$id}->{$val} ) {
 322                                 print $out_fh join(',', map { m/,/ ? qq{"$_"} : $_ } @$id_data);
 323                                 $broj_valova++;
 324                         } else {
 325                                 print $out_fh ( ',' x $#{ $data_headers[$val] } ) ; # FIXME +1?
 326                         }
 327                         print $out_fh ',';
 328                 }
 329                 print $out_fh $broj_valova;
 330                 print $out_fh "\n";
 331         }
 332 }
 333 close $out_fh;
 334 print "\n", -s $out_file, " bytes created\n";
 335