Combining hash values for like hashs. 2

[DunLudjin]

I have the following data that is read into a hash
==============================================
507: quantity=1.0000 ,description=THERMOWELL ,tags= TW-3,partnum=2202579000
658: quantity=1.0000 ,description=FLOWMETER ,tags=FE-1/FT-1 ,partnum=2901675000
557: quantity=1.0000 ,description=THERMOWELL ,tags= TW-1 TW-2,partnum=2202579000
593: quantity=3.0000 ,description=THERMOWELL ,tags= ,partnum=2202579000
==============================================

by

===============================================
foreach (@file) {
chomp;
s/^(.*?):\s*//;
$who=$1;
$rec = {};
$HoH{$who}=$rec;
for $field (split(/,/)) {
($key,$value) = split /=/, $field;
$rec->{$key} =$value;
}
}
=================================================

I ultimately need to combine the hash down to a single key that has the combined tags of all the same partnum.

I've tried sorting the hash via
==================================================
my @partgroups = sort {lc($HoH{$a}{partnum}) cmp lc($HoH{$b}{partnum}) || $HoH{$a}{partnum} <=> $HoH{$b}{partnum}} keys %HoH;
==================================================

and
============================================
my $i=0;
my $flag = 0;
my @combine=();

for $i (1 .. $#partgroups) {
for my $k1 (keys %HoH) {
if (lc($HoH{$partgroups[$i]}{partnum}) eq $HoH{$k1}{partnum} && lc($HoH{$partgroups[($i-1)]}{partnum}) eq $HoH{$k1}{partnum}) {
$flag =1;
push @combine, $k1;
}
if ($flag == 1) {
push @combine,$k1;
$flag =0;
}
}
}
====================================================

Without any success. Any thoughts on the best way to go about this?

 

[bichonfrise74]

Can you show the actual output that you want?

 

[DunLudjin]

I'm looking for a hash like:
================================
507: quantity=6.0000 ,description=THERMOWELL ,tags= TW-3 TW-1 TW-2,partnum=2202579000
658: quantity=1.0000 ,description=FLOWMETER ,tags=FE-1/FT-1 ,partnum=2901675000
================================

I would love the have the quantities add up as well as the tags combined, the actual key (507) doesn't really matter.

Thanks,

 

[bichonfrise74]

Try this...

#!/usr/bin/perl

use strict;

my %record;
while (my $line = <DATA>) {
    chomp $line;
    my ($quantity, $key) = $line =~ /\d+:\s\w+=(\d\.\d+)\s\,\w+=(\w+)\s+.*/;

    $quantity += $record{$key}->[0] if exists $record{$key};
    @{ $record{$key} } = ( $quantity, $line );
}

for my $i ( keys %record ) {
    my $quantity = ($record{$i}->[0] !~ /\./)
                 ? $record{$i}->[0] . '.0000'
                 : $record{$i}->[0];

    $record{$i}->[1] =~ s/quantity=\d.\d+/quantity=$quantity/;
    print "$record{$i}->[1]\n";
}

__DATA__
507: quantity=1.0000 ,description=THERMOWELL ,tags= TW-3,partnum=2202579000
658: quantity=1.0000 ,description=FLOWMETER ,tags=FE-1/FT-1 ,partnum=2901675000
557: quantity=1.0000 ,description=THERMOWELL ,tags= TW-1 TW-2,partnum=2202579000
593: quantity=3.0000 ,description=THERMOWELL ,tags= ,partnum=2202579000

 

[prex1]

This one is a derivation of your original attempt and has the advantage of conserving the whole data structure for further elaboration:

use strict;
my($rec,$key,$value,$field);
my%HoH;
while(<DATA>)  {
  chomp;
  s/^(.*?):\s*//;
  $rec = {'key',$1};
  for $field (split(/,/)) {
    ($key,$value) = split /=/, $field;
    $key=~s/^\s*//;
    $key=~s/\s*$//;
    $value=~s/^\s*//;
    $value=~s/\s*$//;
    $rec->{$key} =$value;
  }
  push@{$HoH{$value}},$rec;
}
for$key(keys%HoH){
  print join',',map{$$_{key}}@{$HoH{$key}};
  print': quantity=';
  $value=0;map{$value+=$_}map{$$_{quantity}}@{$HoH{$key}};
  print sprintf("%.4f",$value);
  print' ,description=',${$HoH{$key}}[0]{description};
  print' ,tags=',join(' ',grep{$_}map{$$_{tags}}@{$HoH{$key}});
  print" ,partnum=$key\n";
}
__DATA__
507: quantity=1.0000 ,description=THERMOWELL ,tags= TW-3,partnum=2202579000
658: quantity=1.0000 ,description=FLOWMETER ,tags=FE-1/FT-1 ,partnum=2901675000
557: quantity=1.0000 ,description=THERMOWELL ,tags= TW-1 TW-2,partnum=2202579000
593: quantity=3.0000 ,description=THERMOWELL ,tags= ,partnum=2202579000

Franco

http://www.xcalcs.com

: Online engineering calculations

http://www.megamag.it

: Magnetic brakes for fun rides

http://www.levitans.com

: Air bearing pads

 

[DunLudjin]

I tried the first and I was able to combine the quantities, but was unable to combine the tags. The second as able to give me what I needed.

Thanks to all that responded.