I have two arrays and I'm using list::compare module. The first array is
#log, "$each_line[3]|$each_line[14]"
The second array is
#log2 "$each_line2[3]|$each_line2[14]|$each_line2[37]"
Is there any way to make these arrays match and print this?
"$each_line[3]|$each_line[14]|$each_line2[37]"
Since you don't say how the matching is done, the example seems to imlpy it's basically an "or" of corresponding array elements.
As such
my #array1 = split(/\|/, $string1);
my #array2 = split(/\|/, $string2);
my $length1 = scalar(#array1);
my $length2 = scalar(#array2);
my #new = ();
my $max = $length1 < $length2 ? $length2 : $length1;
for (my $index = 0; $index < $max; $index++) {
push #new, $index < $length1 ? $array1[$index] : $array2[$index];
}
Related
I want to compare string in two 2D array but the size are not the same. So, I want to shift the element in one of the array to match with all of the element in another array but i run out of idea on how the looping should be.
This is my first time using perl language. I learned c language before.
#!/usr/intel/pkgs/perl/5.14.1/bin/perl
use Data::Dumper qw(Dumper);
#clk = (
'prescc_ux_aux_clk',
'prescc_ux_prim_clk',
'usb2_phy_side_clk',
'usb3_phy_side_clk',
'ux_prim_clk',
'ux_side_clk',
'ux_xtal_frm_refclk',
'uxd_aux_clk',
'uxd_pgcb_clk',
'uxd_prescc_aux_clk',
'uxd_prim_clk',
'uxd_side_clk',
'uxd_suspend_clk');
#clkack = (
'ccu_ux_xtal_frm_refclk_ack',
'ibbs_ux_prim_clkack',
'sbr_ux_side_clkack',
'uxd_aux_clkack',
'uxd_pgcb_clkack',
'uxd_prim_clkack',
'uxd_side_clkack');
foreach(#clk){
#clkline = map {[split /_/,$_]} #clk;
}
foreach(#clkack){
#clkackline = map{[split /_/,$_]} #clkack;
}
#print Dumper #clkline;
$match = 0;
$clkack_row = #clkackline; #no. of row in clkackline
$clk_row = #clkline;
for ($i=0; $i<$clkack_row; $i++){
$clkackcolumn = #{$clkackline[$i]};
for ($j=0; $j<$clkackcolumn; $j++){
for ($m=0; $m<$clk_row; $m++){
$clkcolumn = #{$clkline[$m]};
for ($n=0; $n<$clkcolumn; $n++){
if ($clkline[$i][$j] eq $clkacline[$m][$n]){
$match = $match + 1;
print "$match\n";
}
}
}
}
}
I expect it to loop the #clkackline array and compare it with the #clkline array. If it's matching then it will give how many match it have, hence the $match variable.
Edited:
I need to split it by '_' so that i can get the element divided by only the word inside another array.
Eg:
$clk[0] = ux_prim_clk will result in;
$clkline[0][0] = ux, $clkline[0][1] = prim, $clkline[0][2] = clk.
Then i need to compare with the #clkackline array element by element but in sequential order.
Eg:
$clkline[0][0] = $clkackline[0][0],
$clkline[0][1] = $clkackline[0][1],
$clkline[0][2] = $clkackline[0][2].
But another problem is i need to compare #clkline with all of the element in clkackline. But since the size will be the constraint, then i need to shift the #clkackline to match with #clkline or vice versa.
Eg:
First check:
$clkline[1][0] = $clkackline[0][0],
$clkline[1][1] = $clkackline[0][1],
$clkline[1][2] = $clkackline[0][2].
Second check:
$clkline[1][0] = $clkackline[0][1],
$clkline[1][1] = $clkackline[0][2],
$clkline[1][2] = $clkackline[0][3].
This is just an example of course, but you can see that i need it to delete the first column in $clkackline[0].
Then i need to calculate the percentage of how much it will match.
Eg:
ux_prim_clk vs uxd_prim_clkack will return 33.33%.
Then store the element with highest match inside another array (eg: #clknew)
I think you may be over complicating your problem, to answer your original question of comparing two lists I have a script that will compare two lists and tell you what doesn't exist in each. If this inst exactly what you need let me know and we can change it up to fit your use. As with just about anything in Perl there is probably a module that will do all this for you.
#!/usr/bin/env perl
use strict;
use warnings;
use List::Util qw(any);
my #list1 = ('prescc_ux_aux_clk',
'prescc_ux_prim_clk',
'usb2_phy_side_clk',
'usb3_phy_side_clk',
'ux_prim_clk',
'ux_side_clk',
'ux_xtal_frm_refclk',
'uxd_aux_clk',
'uxd_pgcb_clk',
'uxd_prescc_aux_clk',
'uxd_prim_clk',
'uxd_side_clk',
'uxd_suspend_clk'
);
my #list2 = ('ccu_ux_xtal_frm_refclk_ack',
'ibbs_ux_prim_clkack',
'sbr_ux_side_clkack',
'uxd_aux_clkack',
'uxd_pgcb_clkack',
'uxd_prim_clkack',
'uxd_side_clkack'
);
print "\n==== LIST 1 TO LIST 2 COMPARISON, Does not exist in list 2 ====\n";
foreach my $first (#list1) {
if ( any { $_ eq $first} #list2) { next; }
else { print $first . "\n"; }
}
print "\n==== LIST 2 TO LIST 1 COMPARISON, Does not exist in list 1 ====\n";
foreach my $first (#list2) {
if ( any {$_ eq $first} #list1) { next; }
else { print $first . "\n"; }
}
I use the following code to exclude elements in #{$x} at indexes in #{$index}. But I am not sure it is the most efficient way to implement this function. Does anybody have any better way to do.
sub arrayexclude {
my $x = shift;
my $index = shift;
my #keep_index = (0 .. (scalar(#{$x})-1));
delete #keep_index[#{$index}];
my $result=[];
for my $i (#keep_index) {
if(defined $i) {
push #{$result}, #{$x}[$i];
}
}
return $result;
}
You don't need anything beyond an array slice, so I'd avoid creating a sub just for this.
my #wanted = #array[#indices];
If you're working with array references, the same recipe applies:
my #wanted = #{$array}[#$indices];
Prepare a hash so to identify indices efficiently, then index into the original array with it.
my %ref_index;
#ref_index{ #ind_toss } = ();
#arr_filt = #arr_orig[ grep { !exists $ref_index{$_} } (0..$#arr_orig) ];
Final #arr_filt contains elements of the #arr_orig at indices other than those in #ind_toss.
See solution by ysth in this post for filtering array elements by another array in general.
Wrap it in a sub and run. Array with indices to exclude is #ind_toss, original array is #arr_orig.
use warnings;
use strict;
my #ind_toss = (1, 4, 5);
my #arr_orig = ('a', '1', 'b', 'c', '2', '6', 'd', 'e');
my #filtered = #{ filter_array_by_index(\#arr_orig, \#ind_toss) };
print "#filtered" . "\n";
sub filter_array_by_index {
my ($rarr, $rind) = #_;
my %ref_index;
#ref_index{ #$rind } = ();
return [ #$rarr[grep { !exists $ref_index{$_} } (0..$#$rarr)] ];
}
Prints
a b c d e
Notes
The return from the sub, as hinted in comment by Oleg V. Volkov, can also be written as
return [ map { !exists $ref_index{$_} ? $rarr->[$_] : () } (0..$#$rarr) ];
This avoids construction of a list by grep and a slice but rather indexes into the array conditionally.
Just to clean up a bit on zdim's answer (which is correct anyway):
sub filter_array_by_index {
my ( $rarr, $rind ) = #_;
my %ref_index = map { $_ => 1 } #ind_toss;
my #indices = grep { !$ref_index{$_} } (0..$#$rarr);
return #{$rarr}[#indices];
}
I have this code segment to put together a hash of parameters which I will pass to a function. The hash value containing the IP address is supposed to be an array reference, but the function I'm passing my parameters to thinks it's a scalar reference.
My code is:
my $paramList = "ldap_ip_addresses=['192.168.1.100']|ldap_port=389|ldap_protocol=ldap";
my #paramTuples = split(/\|/, $paramList);
my %nasProps;
foreach my $paramTuple (#paramTuples) {
my($key, $val) = split(/=/, $paramTuple, 2);
# SetProperties can also take hashes or arrays
my $eval_val = eval $val;
if (ref($eval_val) =~ /ARRAY/) {
$val = \$eval_val;
}
$nasProps{$key} = $val;
}
From the debugger, my parameter hash looks like this:
DB<18> x \%nasProps
0 HASH(0x303f8f0)
'ldap_authentication_type' => 'anonymous'
'ldap_ip_addresses' => REF(0x303fa70)
-> ARRAY(0x8284eb8)
0 '192.168.1.100'
'ldap_port' => 389
'ldap_protocol' => 'ldap'
It looks like a reference to an array so I'm not sure where I'm going wrong.
Since $eval_val is already a reference to an array, there is no need to make a reference to the reference. Change:
$val = \$eval_val;
to:
$val = $eval_val;
You are unnecessarily taking the reference to a reference with
$val = \$eval_val;
You have established on the previous line that $eval_val is a reference to an array, so you can use it as it is without taking a reference to it again.
In addition, you should ignore the result of ref $eval_val except to check that it is true — i.e. $eval_val is a reference of some sort.
Your code should look more like this. You need to fall back to the original $val value only if eval returns undef, usually meaning that the string wasn't compilable code.
Note also that you should reserve capital letters for global Perl variables, such as package names. Lexical variable identifiers should contain only lower-case letters, decimal digits and underscores.
use strict;
use warnings;
my $param_list = "ldap_ip_addresses=['192.168.1.100']|ldap_port=389|ldap_protocol=ldap";
my #param_tuples = split /\|/, $param_list;
my %nas_props;
for my $param_tuple (#param_tuples) {
my ($key, $val) = split /=/, $param_tuple, 2;
$nas_props{$key} = eval($val) // $val;
}
use Data::Dump;
dd \%nas_props;
output
{
ldap_ip_addresses => ["192.168.1.100"],
ldap_port => 389,
ldap_protocol => "ldap",
}
Here is a short alternative in functional style:
my %nasProps =
map /\[/ ? eval : $_,
split /[|=]/, $paramList;
However, it only works if you can guarantee that = is not included in any parameter values.
So all i want to do is pass a an array to a function (or subroutine) in PERL
So #Temp contains 2 arrays
[0] = {xx,xx,xx,xx,xx}
[1] = {xx,xx,xx,xx,xx}
#returns array containing two arrays
my #temp = $lineParser->parseLine($_);
#handOne = $cardFactory->createHand(#Temp[0]);
#handTwo = $cardFactory->createHand(#Temp[1]);
This is the createHand method wich is contained in a seperate class (or package or whatever)
sub createHand
{
my $self = shift;
my #temp = #_;
my #arrayOfCards;
foreach(#temp)
{
my $value = substr($_,0,1);
my $color = substr($_,1,1);
push(#arrayOfCards,new Card($value,$color));
}
return #arrayOfCards;
}
The problem i am having is that the array gets passed but is contains ARRAY(XXXXX) at the start of the array.
E.g. {0 ARRAY(xxxxxx), 0 'xx', 1 'xx', ...}
Why does this happen?
How can I manage to do this correctly?
If you turn on warnings, you will get the following one:
Scalar value #Temp[0] better written as $Temp[0]
If you want to pass the referenced array by value, you have to dereference it:
#handOne = $cardFactory->createHand( #{ $Temp[0] } );
sub createHand
{
my $self = shift;
my ($temp) = #_;
my #arrayOfCards;
foreach(#$temp)
{
my $value = substr($_,0,1);
my $color = substr($_,1,1);
push(#arrayOfCards,new Card($value,$color));
}
return #arrayOfCards;
}
Also take note that #temp[0] is array slice in case where scalar (array ref) is wanted, so it's better to state right intention:
#handOne = $cardFactory->createHand($temp[0]);
You are passing a reference instead of a value.
my #temp = $lineParser->parseLine($_);
#handOne = $cardFactory->createHand($Temp[0]);
#handTwo = $cardFactory->createHand($Temp[1]);
so in a nutshell change #temp[0] to $temp[0] when passing the argument
I am having an issue aain.
I think I am just tired, because my brain does not want to think anymore.
anyway.
I have multiple strings which I collect from a spreadsheet, each string has the same layout and I am searching for a specific part in the string. This is the easy part though. So the strings will look like this.
this is a string from Japan
this is a string from China
this is a string from America
this is a string from China
this is a string from England
this is a string from Japan
these strings are not local but I collect it from the excel sheet, so I am then calling to find the location of each string which is at the end, in this case I will take the viariable like this.
use Spreadsheet::Read;
my $book = ReadData ("INPUT.xlsx");
my #rows = Spreadsheet::Read::rows ($book->[1]);
my $count;
$count = 0;
my #clause_all;
foreach my $tab(#rows) {
$count ++;
my #row = Spreadsheet::Read::cellrow ($book->[1], $count);
print $row[5]; # $row[5] would be the location like "japan, china, america etc.
}
Here is the part I am struggling though, the loop is seeing $row[5] as a single term, I need to now remove duplication and need to somehow join each line's $row[5] in order to get an array and then throw out the duplicates. I tried doing this, but it does not work due to the singular form of each $row[5]
my %special = ();
foreach (#my_array)
{
$special{$_} = 1;
}
my #deduped = keys %special;
print "#deduped\n";
If I however create my own test array like this it works, besides for it throwing them out of the original order, anyway, so it MUST be a matter of getting locations $row[5] stored in array.
#my_test_array = ("Japan", "China", "America", "China", "England", "Japan")
my %special = ();
foreach (#my_test_array)
{
$special{$_} = 1;
}
my #deduped = keys %special;
print "#deduped\n";
Thanks in advance!
--------------------------------
Edit!
--------------------------------
Well, this did work, but not sure how neat this is. :)
use Spreadsheet::Read;
my $book = ReadData ("NSA_DB.xlsx");
my #rows = Spreadsheet::Read::rows ($book->[1]);
my $count;
$count = 0;
my #clause_all;
foreach my $tab(#rows) {
$count ++;
my #row = Spreadsheet::Read::cellrow ($book->[1], $count);
push #array, "$row[3]\n";
}
my %special = ();
foreach (#array)
{
$special{$_} = 1;
}
my #deduped = keys %special;
print "#deduped";
Thanks again.
It is not very clear from the question, but if you want to add only unique values to array in order these values appear in source spreadsheet:
my %added;
my #array;
for (whatever) {
push #array, $_ unless exists $added{$_};
$added{$_} = 1;
}
According to update on original question:
use Spreadsheet::Read;
my $book = ReadData ("NSA_DB.xlsx");
my #rows = Spreadsheet::Read::rows ($book->[1]);
my #array;
my %added;
for (my $count = 1; $count <= #rows; $count++) {
my #row = Spreadsheet::Read::cellrow ($book->[1], $count);
push #array, $row[3] unless $added{$row[3]};
$added{$row[3]} = 1;
}
print join("\n", #array), "\n";