Copying an Array, with Modifications
It is often necessary to make changes to the elements of an array while copying it to a new variable. You might be making a regular expression substitution on each element, or only copying elements that match a certain pattern. In this column I’ll show you three different approaches to this problem, in the spirit of Perl’s motto, "There’s More Than One Way To Do It" (TMTOWTDI):
- Using a foreach loop with push():
@oldarray = qw(Alpha BETA gaMMa); my @newarray; foreach my $element (@oldarray) { push(@newarray, ucfirst(lc($element))); } print "Old: @oldarray\n"; print "New: @newarray\n";This will translate each element of @oldarray into first letter uppercase, the rest lowercase. "Alpha" will be uneffected, but "BETA" will become "Beta" and "gaMMa" will become "Gamma". However as you will see by the output of the "print" statements, @oldarray is not modified. This technique using push() is a standard Perl idiom for copying arrays. But be careful here: if you modify the value of $element, it will change the value in @oldarray! The foreach() mechanism is "call by reference" so modifying the loop variable might have undesirable effects.
- Using map:
@oldarray = qw(Alpha BETA gaMMa); my @maparray = map { ucfirst lc } @oldarray; # "ucfirst lc" is the same as "ucfirst(lc($_))" print "Map: @maparray\n";This is equivalent to the loop above! The map function takes a block of code and a list of values as inputs, and executes that block of code once for each of the inputs, with $_ set to that value. Note that $_ can be omitted in many situations, since functions like lc() use $_ as input if no string is given. The resulting list is then returned by map, and assigned to @maparray. Here’s another example:
@oldarray = qw(Alpha BETA gaMMa); my @maparray2 = map { split(/[aeiou]/i) } @oldarray; print "Map2: @maparray2\n";This is a somewhat silly example, but it shows the fact that if the code block you give to map returns a list of items, each item in that list will be added to the return value. In this case, the return value is ("", "lph", "B", "T", "g", "MM"), because we did a split() wherever a vowel is found. The split() function, like lc(), will operate on $_ if no string is passed.
- Using grep:
@oldarray = qw(zero one two three four five); my @greparray = grep { /e$/ } @oldarray; print "Grep: @greparray\n";The grep function, like the Unix command of the same name, can be used to apply a regular expression and return the items that it matches. But in Perl, instead of applying to the lines of a file, it works on the elements of an array. And also unlike the Unix command, it can do more than just regular expressions! Here’s one that returns values that are less than four characters long:
@oldarray = qw(zero one two three four five); my @greparray = grep { length() < 4 } @oldarray; print "Grep: @greparray\n";As you may have guessed, grep assigns $_ to an element of the input list, just like map does. But instead of returning the value of the expression as map does, it returns the input value if and only if the expression is true. Like the lc() and split() examples above, length() uses $_ if no other string is passed (but the parentheses are required, for obscure syntax reasons). So this returns "one" and "two". The equivalent foreach/push loop would be:
@oldarray = qw(zero one two three four five); my @looparray; foreach my $string (@oldarray) { push @looparray, $string if length($string) < 4; } print "Loop: @looparray\n";Hopefully this article has made your life a little easier. Perl’s foreach, map, and grep features are quite a bit different than the equivalent (usually much more complex) expressions in most programming languages, but they can be very powerful tools for manipulating lists and arrays.
how to concatenate two 2d array
Comment by sakthi — January 24, 2007 @ 9:18 am
Concatenating two 2-D arrays is a different kind problem. You can do it fairly easy like this:
my @first = ( [1, 2, 3], [4, 5, 6] );
my @second = ( [7, 8, 9], [10, 11, 12] );
my @both = (@first, @second);
This produces an array of four elements: ( [1, 2, 3], [4, 5, 6], [7, 8, 9], [10, 11, 12] )
Is that what you mean?
Comment by William Ward — January 24, 2007 @ 1:39 pm
#!c:/perl/bin/perl
open(FH,”config.txt”);
@source_config=;
close(FH);
chop(@source_config);
$a=0;
foreach $source_config(@source_config)
{
@vari=split(/=/,$source_config);
$variable[$a]=($vari[1]);
$a++;
push(@variable,$variable[$a]);
}
print @variable,”";
my %color_hash=( 0=>0xf00000,1=>0×008800,2=>0×000088,3=>0×008080,4=>0×3333ff,5=>0×3300ff,6=>0xaabbcc,7=>0xffeedd,8=>0×111122);
use CGI qw/:standard/;
my $input = param(’input type’);
my @checked=param(’directory’);
use lib “E:/chart/chart/lib”;
use Perlchartdir;
print header;
print start_html(-BGColor=>”AABBCCDD”,-text=>”FFFFEEEE”);
print “$input values”;
if ($input eq “consolidated” )
{
foreach $checked (@checked)
{
$open_dir = $variable[1] . $checked;
$dirx = $open_dir . “\/db\/”;
opendir(DH, $dirx) || die “Cannot open dir$! “;
my @files = sort(grep/txt$/, readdir(DH));
my (%hash);
closedir(DH);
my (%hash, %new, $key, $value);
foreach my $file (@files)
{
my $position = rindex($file,”_”) + 1;
$value = substr($file,$position,7);
$key = substr($file, 0, $position - 1);
%hash=($key=>$value);
if(exists $new{$key})
{
$new{$key}=”$new{$key},$hash{$key}”;
$td++;
}
else
{
%new=(%new,%hash);
}
}
foreach my $keys (sort keys %new)
{
push(@uniquekeys,$keys);
}
print $#uniquekeys,”";
$k=0,$x=0,$a=0;
for ($i=0;$i$value);
if ($uniquekeys[$i] eq $key)
{
$a++;
open (SOURCE, “$dirx$file” ) || die “cannot open file $!”;
@contents=;
close (SOURCE);
@total_no_process=split(/,/,$contents[0]);
$no_process=$#total_no_process/2;
$dbprocess[$no_process][$#contents+1];
$h=0,$w=0;
foreach $record (@contents)
{
@tt=split(/ /,$record);
$time[$k]=($tt[3]) .” “. ($tt[1]) .” “. ($tt[2]);
$r=1;
for (;$h”;
print $a,”";
&db_consolidated();
$k=0,$a=0,$x=0;
}
my $td = 1;
my (%hash, %new, $key, $value);
foreach my $file (@files)
{
my $position = rindex($file,”_”) + 1;
$value = substr($file,$position,7);
$key = substr($file, 0, $position - 1);
%hash=($key=>$value);
if(exists $new{$key})
{
$new{$key}=”$new{$key},$hash{$key}”;
$td++;
}
else
{
%new=(%new,%hash);
}
}
print “”;
my ($extra, $column);
foreach my $keys (sort keys %new)
{
$image = $keys;
print “”;
print th( $keys );
print “\n”;
print “” ;
print “consolidated ” ;
if(-e “C:/Program Files/Apache Software Foundation/Apache2.2/htdocs/$checked/consolidated/db-$keys\_consolidated.jpeg”)
{
print “”;
}
print “\n”;
}
print “”;
print “BACK“;
print “”;
print “”;
}
}
else
{
foreach $checked (@checked)
{
$open_dir = $variable[1] . $checked;
$dirx = $open_dir . “\/db\/”;
opendir(DH, $dirx) || die “Cannot open dir$! “;
my @files = sort(grep/txt$/, readdir(DH));
closedir(DH);
foreach $no_files (@files)
{
$out = $no_files;
$out =~ s/\.(.*?)$//ig;
open (SOURCE, “$dirx$no_files” ) || die “cannot open file $!”;
@contents=;
close(SOURCE);
@total_no_record=split(/,/,$contents[0]);
$no_row=$#total_no_record/2;
$process[$no_row][$#contents+1];
$i=0,$h=0,$w=0,$a=0;
foreach $elements (@contents)
{
@time_interval=split(/ /,$elements);
$time[$i]=($time_interval[3]);
$r=1;
for (;$h$value);
if(exists $new{$key})
{
$new{$key}=”$new{$key},$hash{$key}”;
$td++;
}
else
{
%new=(%new,%hash);
}
}
print “”;
my ($extra, $column);
foreach my $keys (sort keys %new)
{
$image = $keys;
print “”;
print th( $keys );
print “\n”;
$column = 0;
foreach my $values (split/,/,$new{$keys})
{
$column++;
print “” ;
print “$values ” ;
if(-e “C:/Program Files/Apache Software Foundation/Apache2.2/htdocs/$checked/dbimages/mul-$keys\_$values.png”)
{
print “”;
}
}
$extra = $column;
print “\n”;
}
print “”;
print “BACK“;
print “”;
print “”;
}
end_html;
}
sub dbgraph
{
# The data for the muilt-line chart
# my $data1 = [@process1];
my $labels = [@time];
my $c = new XYChart(600, 400, 0xEEEEFF, 0×000000, 1);
$c->setRoundedFrame();
$c->setPlotArea(55, 55, 550, 250, 0xffffff, -1, -1, 0xdddddd, 0xcccccc);
$c->addLegend(50, 20, 0, “arialbd.ttf”, 9)->setBackground($perlchartdir::Transparent);
$c->addTitle(”DB COUNT”, “timesbi.ttf”, 15)->setBackground(0xccccff, 0×000000, perlchartdir::glassEffect());
$c->yAxis()->setTitle(”MBytes per hour”);
$c->xAxis()->setLabels($labels)->setFontAngle(45);
$c->xAxis()->setLabelStep(1);
$c->xAxis()->setTitle(”TIME INTERVAL”);
my $layer = $c->addLineLayer2();
$layer->setLineWidth(2);
for ($i=0,$j=2;$iaddDataSet([@{$process[$i]}],$color_hash{$i}, $db_values[$j]);
$j=$j+2;
@{$process[$i]}=” “;
}
$c->makeChart(”C:/Program Files/Apache Software Foundation/Apache2.2/htdocs/$checked/dbimages/mul-$out.png”);
@process=” “;
@time=” “;
}
sub db_consolidated
{
my $labels = [@time];
my $c = new XYChart(600, 400, 0xEEEEFF, 0×000000, 1);
$c->setRoundedFrame();
$c->setPlotArea(55, 55, 550, 250, 0xffffff, -1, -1, 0xdddddd, 0xcccccc);
$c->addLegend(50, 20, 0, “arialbd.ttf”, 9)->setBackground($perlchartdir::Transparent);
$c->addTitle(”DB COUNT”, “timesbi.ttf”, 15)->setBackground(0xccccff, 0×000000, perlchartdir::glassEffect());
$c->yAxis()->setTitle(”MBytes per hour”);
$c->xAxis()->setLabels($labels)->setFontAngle(45);
$c->xAxis()->setLabelStep(4 * $a);
$c->xAxis()->setTitle(”@date “);
my $layer = $c->addLineLayer2();
$layer->setLineWidth(2);
for ($i=0,$j=2;$iaddDataSet([@{$dbprocess[$i]}],$color_hash{$i}, $db_values[$j]);
$j=$j+2;
@{$dbprocess[$i]}=” “;
}
$c->makeChart(”C:/Program Files/Apache Software Foundation/Apache2.2/htdocs/$checked/consolidated/db-$uniquekeys[$i]_consolidated.jpeg”);
@dbprocess=” “;
@time=” “;
}
==============================================
in this program see the line number 88 i want to push the 2d array values in to another array. by calling that value i have to draw the graph using chart director plz help me out plz study program first if u have any doubt plz ask
Comment by sakthivel — January 24, 2007 @ 9:06 pm
plz explain the last asked question
Comment by sakthivel — January 26, 2007 @ 9:22 am
I am trying to develop a perl script which will make a sorted list of all the words used in a large number of text files (namely 1000 movie reviews in .txt format).
I am currently using the File::Find function to iterate through each file and, after some basic regex, creating an array where each element is an array of the line being read (AoA). Then I am writing each array to a seperate file creating a list of every word used. I am then reading this file back to a new array - as each word is a now a new line it is easy to split() in order to sort etc creating the final list.
If that was’t too confusing I would like to miss out the step of having to write to a file (OUTWORDS) and be able to read each word of each file to the next element of the original array so that I can sort etc without the need to use a seperate file.
Thank you.
Here is the basic part of the code:
sub process #Reads each review file and creates list of words
{
my @outLines; #Data that is going to output
my $line; #Data that is read line by line
if ( $File::Find::name =~ /\.txt$/ ) #Find .txt files
{
open ( REVIEWFILE, $File::Find::name ) or die “Cannot open file: $!”; #Open .txt file
# print $File::Find::name . “\n”;
while ( $line = )
{
$line =~ s/[’]+//g; #Remove ‘ from words
$line =~ s/[^a-z]/\n/g; #All non alphabet to newline
$line =~ s/\n+/\n/g; #Squeeze newlines
push(@outLines, $line); #Place each line into array
}
close ( REVIEWFILE );
open ( OUTWORDS, “>>$outFile”) || die “Cannot open file: $!”;
print ( OUTWORDS @outLines ); #print array to file
close ( OUTWORDS );
undef( @outLines );
}
Comment by Benjamin Clare — February 14, 2007 @ 1:35 pm
I would do the split() as I am reading it, and push the result onto an array then. Something like this:
my @all_words;
sub process #Reads each review file and creates list of words
{
if ( $File::Find::name =~ /\.txt$/ ) #Find .txt files
{
open ( REVIEWFILE, $File::Find::name ) or die “Cannot open file: $!”; #Open .txt file
while (defined(my $line = <REVIEWFILE> ))
{
$line =~ s/[’]+//g; #Remove ‘ from words
push(@all_words, split(/[^a-z]+/, $line)); #Place each word into array
}
close ( REVIEWFILE );
}
I combined two of your substitution regexes into a split argument. Now I haven’t tested this but I think it should work unless I overlooked something… the key is using push() with a list as the second argument.
Comment by William Ward — February 14, 2007 @ 2:03 pm
Thanks for that, you have certainly pushed my in the right direction. However, having modified it slightly I still get an array of array.
I can sort each sub-array but then end up with multiple sorted lists. I would then like to remove duplicates etc but this only works on each individual list.
I am currently testing on three files and this is the code and output:-
sub process #Reads each review file and creates list of words
{
my @outLines; #Data that is going to output
my $outLines;
my $line; #Data that is read line by line
my @wordList; #Sorted array
my $wordList;
if ( $File::Find::name =~ /\.txt$/ ) #Find .txt files
{
open ( REVIEWFILE, $File::Find::name ) or die “Cannot open file: $!”; #Open .txt file
while (defined($line = ))
{
$line =~ s/[’]+//g; #Remove ‘ from words
push(@outLines, split(/[^a-z]+/, $line)); #Place each word into array
}
close ( REVIEWFILE );
}
@outLines = sort(@outLines);
print “@outLines\n”;
}
Reading files.
a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a about about about…..
a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a about acceptable action…..
a a a a a a a a a a a a a a a a a a about about about about absurdist acting…..
All files read.
Comment by Benjamin Clare — February 14, 2007 @ 3:26 pm
The problem is your variable @outLines is local to the subroutine. Since the subroutine is called once for each file, the array is reset each time. My solution had the array outside the subroutine, and it was being continually added to.
Comment by William Ward — February 14, 2007 @ 5:20 pm
You are a star, thank you!
I have finally managed to get it to work properly. All of the problems stemmed from calling the array from inside the sub which I probably would never have worked out.
Thanks again
Ben
Comment by Benjamin Clare — February 15, 2007 @ 9:55 am
Glad I could help.
Comment by William Ward — February 15, 2007 @ 11:00 am
How to concatenate two 2D array, but put the 2nd array at the end of each row, instead of adding additional rows?
Example
my @first = ( [1, 2, 3], [4, 5, 6] );
my @second = ( [7, 8, 9], [10, 11, 12] );
I need a output of:
@new = ([1, 2, 3, 7, 8, 9], [4, 5, 6, 10, 11, 12]);
How to get there?
thanks!
Comment by Chunyu — April 25, 2007 @ 10:06 am
Here is the subroutine that will do the trick of merging two 2-D array, assuming they have equal number of rows.
Call it by: @combined2D = merge2D(\@AoA, \@addIn2DAoA);
sub merge2D {
my ($arr1, $arr2) = @_;
my @AoA1 = @{$arr1};
my @AoA2 = @{$arr2};
my $rownum1 = @AoA1;
my $rownum2 = @AoA2;
my @combined = ();
if ($rownum1 != $rownum2){ # end the program, return an empty 2D array
return @combined;
}
my @newrow = ();
for (my $i = 0; $i < $rownum1; $i++){
@newrow = (@{$AoA1[$i]}, @{$AoA2[$i]});
push @combined, [@newrow];
}
return @combined;
}
Comment by Chunyu — June 7, 2007 @ 1:35 pm
I don’t think you need @AoA1 and @AoA2. You should be able to use $arr1 and $arr2 directly. Using @AoA1 and @AoA2 copies the contents of those original arrays unnecessarily; only an issue if they are large of course, but still worthy of remembering. Here’s my version:
use strict;
use warnings;
use Data::Dumper;
my @AoA = ([ 1, 2, 3], [10, 20, 30]);
my @addIn2DAoA = ([ 4, 5 ], [40, 50, 60, 70]);
my @combined2D = merge2D(\@AoA, \@addIn2DAoA);
print Dumper \@AoA, \@addIn2DAoA, \@combined2D;
sub merge2D {
my ($arr1, $arr2) = @_;
my $rownum1 = @$arr1;
my $rownum2 = @$arr2;
my @combined = ();
if ($rownum1 != $rownum2)
{ # end the program, return an empty 2D array
return @combined;
}
my @newrow = ();
for (my $i = 0; $i < $rownum1; $i++)
{
@newrow = (@{$arr1->[$i]}, @{$arr2->[$i]});
push @combined, [@newrow];
}
return @combined;
}
Comment by William Ward — June 7, 2007 @ 2:33 pm