Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations TouchToneTommy on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Comparing 1

Status
Not open for further replies.

YouEnjoyMyself

IS-IT--Management
Jul 27, 2004
111
US
Hey, I need some help once again...Here is what I am looking to do I want to be able to compare two different lists. What I want to compare in these lists is a set of numbers that will change on a daily basis. The lists are structered differently. I have attached A copy of both lists and highlighted the info i need compared. Basicly if a number from list B isnt listed on List A then I wanted the number deleted from list B. If no numbers compare then I need the script to spit out a line of text indicating that.

List A: (compare information is the Barcode Column)


Slot Tape Barcode
==== ==== ============
1 Yes 000314
2 Yes 002042
3 Yes 001876
4 Yes 002714
5 Yes 000747
6 Yes 001853
7 Yes 002365
8 Yes 000871
9 Yes 000062
10 Yes 000986
11 Yes 000217
12 Yes 002853
13 Yes 002306
14 Yes 000610
15 Yes 002662
16 Yes 000705
17 Yes 000988
18 Yes 003043
19 Yes 001890

List B:

002035:002046:002095:002144:002153:002157:002176:002177:002194:002202:
002214:002226:002234:002246:002253:002294:002344:002713:002743:002744:
002745:002746:002748:002753:002760:002762:002765:002771:002775:002782:
002792:002794:002804:002875:002880:002882:002886:002887:002889:002892:
002893:002894:002897:002898:002900:002905:002906:002907:002908:002910:
002911:002913:002914:002940:002941:002942:002943:002944:002945:002946:
002947:002948:002949
 
Have you taken a shot at comparing the lists yet? What have you come up with?
 
Ahh well, I had some time to kill. Try this on for size:

Code:
my (@lista, @listb, %comparison, @orderb);

# Chew through the headers
$_ = <DATA>; $_ = <DATA>;

while (<DATA>) {
    /.*\s(\d+)/;
    $comparison{$1} = 'a';
}

my $text = '002035:002046:002095:002144:002153:002157:002176:002177:002194:002202:
002214:002226:002234:002246:002253:002294:002344:002713:002743:002744:
002745:002746:002748:002753:002760:002762:002765:002771:002775:002782:
002792';
map {$comparison{$_} .= 'b'; push(@orderb, $_)} split(':', $text);

# Find the matches
my @union = grep {$comparison{$_} eq 'ab'} keys %comparison;

# No matches?
unless (scalar @union) {
    print "Ahhh crap! Didn't find anything\n";
}

# listb and not in lista - unordered
#my $cleaned_listb = join(':', grep {$comparison{$_} eq 'b'} keys %comparison);
# listb and not in lista - ordered
my $cleaned_listb = join(':', grep {$comparison{$_} eq 'b'} @orderb);

print $cleaned_listb, "\n";

__DATA__
Slot    Tape  Barcode     
====    ====  ============
  1     Yes  000314       
  2     Yes  002042       
  3     Yes  001876       
  4     Yes  002714       
  5     Yes  000747       
  6     Yes  001853       
  7     Yes  002365       
  8     Yes  000871       
  9     Yes  000062       
 10     Yes  000986       
 11     Yes  000217       
 12     Yes  002853       
 13     Yes  002306       
 14     Yes  000610       
 15     Yes  002662       
 16     Yes  000705       
 17     Yes  000988       
 18     Yes  002035       
 19     Yes  002177
 
Slight correction - code works, but @union should probably be @intersect.

Apparently I needed some more caffeine yesterday.
 
Rharsh:

Just to be correct the output you are getting from the script is:

002194:002202:002214:002226:002234:002
246:002253:002294:002344:002713:002743:002744:002745:002746:002748:002753:002760
:002762:002765:002771:002775:002782:002792


None of those numbers match up to the DATA, therefore the output should be (as you put it..hehehe) "Ahhh crap! Didn't find anything" Basicly what this script should be doing is comapring two sets of numbers what ever numbers match each other are then spit out into a text file in this format:

xxxxxx:xxxxxx:xxxxxx:xxxxxx:xxxxxx:xxxxxx


I appreciate all the input.
 
Ok so I made some changes to the script, but I am getting both outputs "Success" and "ahh crap"

use strict;

my (@lista, @listb, %comparison, @orderb,$text);

# Chew through the headers
open(DATA, "< C:\\vmcheckxxx.txt") || die "ERROR\n"; #opens filelist created by vertices
$_ = <DATA>; $_ = <DATA>;

while (<DATA>) {
/.*\s(\d+)/;
$comparison{$1} = 'a';
}

open(text, "< C:\\tapestoeject1.txt") || die "ERROR\n"; #opens filelist created by vertices
$_ = <text>;

while (<text>){

map {$comparison{$_}.= 'b'; push(@orderb, $_)}split(':', $text);

}

# Find the matches
my @union = grep {$comparison{$_} eq 'ab'} keys %comparison;

# No matches?
unless (scalar @union) {
print "Ahhh crap! Didn't find anything\n";
}

# listb and not in lista - unordered
#my $cleaned_listb = join(':', grep {$comparison{$_} eq 'b'} keys %comparison);
# listb and not in lista - ordered
my $cleaned_listb = join(':', grep {$comparison{$_} eq 'b'} @orderb);

print "success", $cleaned_listb, "\n";

 
Ok so I am a complete idiot..but thats already been proven before soo i will not go any further. Okay what I would like to be able to get out of this script is just the numbers that match up on both lists. I tried tweeking around with the script but i couldnt get it to do what i want. I am gonna look around a lil more, but if someone could help..I'll be very appreciative.
 
maybe like this?

Code:
my $list_b = qq~000314:002035:002046:002095:002144:002153:002157:002176:002177:002194:002202:002214
:002226:002234:002246:002253:002294:002344:002713:002743:002744:002745:002746:002748:002753:002760
:002762:002765:002771:002775:002782:002792:002794:002804:002875:002880:002882:002886:002887:002889
:002892:002893:002894:002897:002898:002900:002905:002906:002907:002908:002910:002911:002913:002914
:002940:002941:002942:002943:002944:002945:002946:002947:002948:002949~;

my %list_b = map { $_=>$_ } split(/:/,$list_b);
# Chew through the headers
$_ = <DATA>; $_ = <DATA>;
my @list_a = map {(split(/\s+/))[3]} <DATA>;
my $total = 0;
foreach (@list_a) {
   $total++ if delete $list_b{$_};
}
if ($total>0) {
   $list_b = join(':', sort {$a <=> $b}  keys %list_b);
   # print $list_b to disk or whatever
   print "$total elements deleted from  list B";
}
else {
   print "Nothing deleted";
}
 
	
__DATA__
Slot    Tape  Barcode     
====    ====  ============
  1     Yes  000314       
  2     Yes  002042       
  3     Yes  001876       
  4     Yes  002714       
  5     Yes  000747       
  6     Yes  001853       
  7     Yes  002365       
  8     Yes  000871       
  9     Yes  000062       
 10     Yes  000986       
 11     Yes  000217       
 12     Yes  002853       
 13     Yes  002306       
 14     Yes  000610       
 15     Yes  002662       
 16     Yes  000705       
 17     Yes  000988       
 18     Yes  003043       
 19     Yes  001890

assumes $list_b is one continuous string with no newlines, unlike in the above code. I had to break it so the display would not stretch out too much.
 
If you want to print the 'none found' or the remaining list if something was found, try using this:

Code:
# Find the matches
my @intersect = grep {$comparison{$_} eq 'ab'} keys %comparison;

# Check for no matches
unless (scalar @intersect) {
    print "Ahhh crap! Didn't find anything\n";
} else {
    my $cleaned_listb = join(':', grep {$comparison{$_} eq 'b'} @orderb);
    print "Success: $cleaned_listb\n";
}

The items that matched between the two lists are going to be stored in @intersect, if you print that instead, you'll have just your matches.
 
Thanks rharsh you have been a great help. Hey If your in the upstate NY area let me know and I'll buy you a drink or two
 
Ok So I tried modifying the script so that I could you text input files to pull the data from. I know I missing something small in my code. Could someone just take a quick look and hint me in the right direction as to what I may be missing? Sorry for asking for so much


# Simple Perl File
# Project : PerlProject45
# Generated by Visual Perl from a template in C:\Program Files\ActiveState Visual Perl\Wizards\PerlSimpleWiz\Templates\1033
#

use strict;

my (@lista, @listb, %comparison, @orderb);

# Chew through the headers

my $DATA= "C:\\vmcheckxxx.txt";
open (DATA, "$DATA") or die "Can't open $DATA: $!\n";
while (<DATA>)
{chomp;
/.*\s(\d+)/;
$comparison{$1} = 'a';
}

my $TEXT= "C:\\tapestoeject.txt";
open (TEXT, "$TEXT") or die "Can't open $DATA: $!\n";
while (<text>)
{
map {$comparison{$DATA} .= 'b'; push(@orderb, $DATA)} split(':', $TEXT)};

# Find the matches
my @intersect = grep {$comparison{$DATA} eq 'ab'} keys %comparison;

# No matches?
unless (scalar @intersect) {
print "Ahhh crap! Didn't find anything\n";
} else {
my $cleaned_listb = join(':', grep {$comparison{$DATA} eq 'ab'} @intersect);
print "Success: $cleaned_listb\n";
}
close(TEXT) || die qq(Can't close input file "Tapelog.txt".\n);
close(DATA) || die qq(Can't close output file "Tapes_To_Be_Pulled.csv".\n);

 
Thanks for the drinks, I think I'll have to take a raincheck. There's the slight problem of my being on the wrong coast.

It looks like there might be a bit of confusion with the map and grep functions, you might want to take a look at them in the docs.

Code:
my $DATA= "C:\\vmcheckxxx.txt";
open (DATA, "$DATA") or die "Can't open $DATA: $!\n";
while (<DATA>)
 {chomp;
 /.*\s(\d+)/;
    $comparison{$1} = 'a';
}

my $TEXT= "C:\\tapestoeject.txt";
open (TEXT, "$TEXT") or die "Can't open [b][red]$TEXT[/red][/b]: $!\n";
while ([b][red]my $line = <TEXT>[/red][/b])
{
[b][red]chomp;[/red][/b]
map {$comparison{[b][red]$_[/red][/b]} .= 'b'; push(@orderb, [b][red]$_[/red][/b])} split(':', [b][red]$line[/red][/b])[b][red];
}[/red][/b]

# Find the matches
my @intersect = grep {$comparison{[b][red]$_[/red][/b]} eq 'ab'} keys %comparison;

# No matches?
unless (scalar @intersect) {
    print "Ahhh crap! Didn't find anything\n";
} else {
    my $cleaned_listb = join(':', grep {$comparison{[b][red]$_[/red][/b]} eq 'ab'} @intersect);
    print "Success: $cleaned_listb\n";
}
 
Yeah I noticed that and was able to fix that error. The script works great now. Thanks a lot.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top