Perl ABC- Perl ›
- Subroutine ›
- here
Subroutine exercises
Here are some examples to help you learn with concrete examples of subroutine.
Convert a csv format string to an array of arrays
This is an example to convert string in csv format to an array of arrays.
use strict;
use warnings;
# Name, age, origin
my $text = <<'EOS';
tora, 24, Japan
rika,12,USA
kenta, 25, Chinese
EOS
print "1: Convert a csv format string to an array of arrays.\n";
my $people = parse ($text);
require Data::Dumper;
print Data::Dumper->Dump([$persons], ['$perlsons']);
sub parse {
my $text = shift;
my @lines = split("\n", $text);
my $items_list = [];
for my $line (@lines) {
my @items = split(',', $line);
push @$items_list, [@items];
}
wantarray? return @$items_list: $items_list;
}
Conversion image
| - -- -- -- -- -- - |
| tora, 24, Japan |
| rika,12,USA |
| kenta, 25, Chinese |
| - -- -- -- -- -- - |
↓
[
[tora, 24, Japan],
[rika, 12, USA],
[kenta, 25, Chinese],
]
- Converts text to an array of arrays.
(1) For those who do not understand here documents.
my $text = <<'EOS'; tora, 24, Japan rika,12,USA kenta, 25, Chinese EOS
See Here Document.
(2) Subroutine call
my $people = parse ($text);
Pass an argument called $text to a subroutine called parse. This will cause a parse to be executed and its return value will be assigned to $person.
(3) How to create an array of arrays
push @$items_list, [@items];
push function requires an array as the first argument. Dereference and pass an array with @$items_list.
The push function requests a list after the second argument, but do not pass an array as @items. And finally,
[tora, 24, Japan, rika, 12, USA, kenta, 25, Chinese]
Will be created. Create a reference to the array as [@items] and push it.
(4) Selectively return the return value
wantarray? return @$items_list: $items_list;
You can use wantarray function to return the return value depending on the context. (Currently I don't recommend want array)
Convert csv format string to hash array
This is an example to convert a csv format string to an array of hash.
use strict;
use warnings;
# Name, age, origin
my $text = <<'EOS';
tora, 24, Japan
rika,12,USA
kenta, 25, Chinese
EOS
print "1: Convert a csv format string to an array of hashes.\n";
my $headers = ['name', 'age', 'country'];
my $people = parse ($text, $headers);
require Data::Dumper;
print Data::Dumper->Dump([$persons], ['$perlsons']);
sub parse {
my ($text, $headers) = @_;
my @lines = split("\n", $text);
my $items_hash_list = [];
foreach my $line (@lines) {
my @items = split(',', $line);
my %items_hash = ();
@items_hash {@$headers} = @items;
push @$items_hash_list, {%items_hash};
}
wantarray? return @$items_hash_list: $items_hash_list;
}
Conversion image
| - -- -- -- -- -- - |
| tora, 24, Japan |
| rika,12,USA |
| kenta, 25, Chinese |
| - -- -- -- -- -- - |
↓
[
{
'country' =>'Japan',
'name' =>'tora',
'age' => '24'
},
{
'country' =>'USA',
'name' =>'rika',
'age' => '12'
},
{
'country' =>'Chinese',
'name' =>'kenta',
'age' => '25'
}
]
Converts text to an array of arrays.
(1) Subroutine call
my $people = parse ($text, $headers);
Pass the arguments $text and $header to a subroutine called parse. By passing the header together, you don't have to write the header name in the subroutine.
If you write the header name in the subroutine, the subroutine and the header name will be tightly coupled and the versatility of the subroutine will be lost. By giving the header name as an argument, this subroutine can be used for any csv format string.
(2) How to create an array of hashes
for my $line (@lines) {
my @items = split(',', $line);
my %items_hash = ();
@items_hash {@$headers} = @items;
push @$items_hash_list, {%items_hash};
}
Use hash slice to create the hash corresponding to the header.
@items_hash {@$headers} = @items;
# Same meaning as below
@items_hash {('name', 'age', 'country') = ('tora', 24, 'Japan');
# When disassembled
$items_hash{name} = 'tora';
$items_hash{age} = 24;
$items_hash{contry} = 'Japan';
Using hash slice in this way eliminates the need to write iterations.
push @$items_hash_list, {%items_hash};
The push function requests a list after the second argument, but do not pass a hash as%items_hash. Then finally create a reference to the hash as {%items_hash} and push it.
Find the maximum and minimum values
This is an example to find the maximum and minimum values.
use strict;
use warnings;
my @nums = (1, 2, 3);
print "1: Subroutine for finding maximum and minimum values \n";
print "(". join(',', @nums). ")\n";
print "maximum value:". Max (@nums) . "\n";
print "Minimum:". Min (@nums) . "\n";
sub max {
my @nums = @_;
my $max_num;
for my $num (@nums) {
if (! defined $max_num) {
$max_num = $num;
}
else {
if ($num > $max_num) {
$max_num = $num;
}
}
}
return $max_num;
}
sub min {
my $min_num;
for my $num (@nums) {
if (! defined $min_num) {
$min_num = $num;
}
else {
if ($num < $min_num) {
$min_num = $num;
}
}
}
return $min_num;
}
(1) Algorithm for finding the maximum value
sub max {
my @nums = @_;
my $max_num;
for my $num (@nums) {
if (! defined $max_num) {
$max_num = $num;
}
else {
if ($num > $max_num) {
$max_num = $num;
}
}
}
return $max_num;
}
A subroutine that takes an array as input and outputs the maximum value. The one that is assumed to be the maximum value is assigned to the variable and left. You can see that the last remaining $max_num is the maximum value. It is a unique way of thinking about programming that is different from mathematics.
Initially, $max_num is an undefined value, so if it is an undefined value, $num is assigned to $max_num without comparison.
Bubble sort
This is an example for bubble sort. Sorting is done using while statement and for statement.
use strict;
use warnings;
my @nums = (5, 2, 7, 3, 4);
print "1: Subroutine that sorts in ascending order by bubble sort\n";
print join(',', @nums). "(Initial state)\n";
my @sorted_nums_ascend = bubble_sort_ascend (@nums);
print join(',', @sorted_nums_ascend). "(Last state)\n\n";
print "2: Subroutine that sorts in descending order by bubble sort\n";
print join(',', @nums). "(Initial state)\n";
my @sorted_nums_descend = bubble_sort_descend (@nums);
print join(',', @sorted_nums_descend). "(Last state)\n";
# Bubble sort subroutine. (Ascending order)
sub bubble_sort_ascend {
my @nums = @_;
if (@nums <2) {
return @nums;
}
my $change_cnt = @nums - 1;
# If you have an array a with n elements
# At first, do n - one exchange.
# a [0] and a [1], a [1] and a [2], ...., a [n-2] and a [n-1]
# 2nd time, n - 2 exchanges
# a [0] and a [1], a [1] and a [2], ...., a [n-3] and a [n-2]
# Finally
# Swap a [0] and a [1].
# In bubble sort, the maximum value is set every time the exchange goes around.
# It will be confirmed, so every time the exchange goes around
# Decrease the number of exchanges by 1.
while ($change_cnt > 0) {
for my $i (0 .. $change_cnt - 1) {
# If you are bigger than the next number, replace it,
# If you are smaller, do nothing.
# By doing this, the last element becomes the maximum.
if ($nums[$i]> $nums[$i + 1]) {
($nums[$i], $nums[$i + 1]) = ($nums[$i + 1], $nums[$i]);
print join(',', @nums). "(Snap)\n";
}
}
$change_cnt-;
}
return @nums;
}
# Bubble sort subroutine. (Descending order)
sub bubble_sort_descend {
my @nums = @_;
if (@nums <2) {
return @nums;
}
my $change_cnt = @nums - 1;
while ($change_cnt > 0) {
for my $i (0 .. $change_cnt - 1) {
if ($nums[$i] <$nums[$i + 1]) {
($nums[$i], $nums[$i + 1]) = ($nums[$i + 1], $nums[$i]);
print join(',', @nums). "(Snap)\n";
}
}
$change_cnt-;
}
return @nums;
}
What is bubble sort?
Bubble sort is an algorithm that compares adjacent numbers, swaps if you are greater than the next number, and finally sorts. (In ascending order)
Bubble sort process (for 5,4,3,2,1)
# 1st week
5 , 4 , 3,2,1 (5 and 4 are exchanged.)
4, 5 , 3 , 2,1 (5 and 3 are exchanged)
4,3, 5 , 2 , 1 (5 and 2 are exchanged)
4,3,2, 5 , 1 (5 and 1 are exchanged)
4,3,2,1, 5 (5 is fixed to the maximum value, next is the same for the previous 4 Exchange.)
# 2nd week
4 , 3 , 2,1, 5
3, 4 , 2 , 1, 5
3,2, 4 , 1 , 5
3,2,1, 4 5 (4 is fixed to the maximum value, and next, the same exchange is performed with the previous three.)
# 3rd week and below
Select descending order and ascending order to sort bubbles
By devising the previous bubble sort, it is possible to select descending order or ascending order. I also added error handling.
use strict;
use warnings;
my @nums = (5,2,7,3,4);
print "1: Subroutine that selects descending order and ascending order and sorts bubbles\n";
print join(',', @nums). "(Initial state)\n";
my @sorted_nums_ascend = bubble_sort(\@nums, {order =>'ascend'});
my @sorted_nums_descend = bubble_sort(\@nums, {order =>'descend'});
if (@sorted_nums_ascend) {
print join(',', @sorted_nums_ascend). "(Ascending order)\n";
}
else {
print "\@sorted_nums_ascend is an empty list.\n";
}
if (@sorted_nums_descend) {
print join(',', @sorted_nums_descend). "(Descending)\n\n";
}
else {
print "\@sorted_nums_descend is an empty list.\n\n";
}
# Subroutine that selects descending order and ascending order to sort bubbles
sub bubble_sort {
my ($nums, $opt) = @_;
# Error handling
my @nums;
# Check if $nums is an array reference.
if (defined $nums) {
if (ref $nums eq 'ARRAY') {
@nums = @$nums
}
else {return}
}
else {return}
my $order = 'ascend';
# Check if $opt is a hash reference
if (defined $opt) {
if (ref $opt eq 'HASH') {
# Substitute if $opt->{order} is a true value.
$order = $opt->{order} if $opt->{order};
unless ($order eq 'ascend' || $order eq 'descend') {
return;
}
}
else {return}
}
# This process
if (@nums <2) {
return @nums;
}
my $change_cnt = @nums - 1;
while ($change_cnt > 0) {
for my $i (0 .. $change_cnt - 1) {
# To select ascending or descending order, you only have to rewrite this part from the last time.
my $is_change;
if ($order eq 'ascend') {
# In ascending order, exchange if $nums[$i]> $nums[$i + 1]
$is_change = $nums[$i]> $nums[$i + 1];
}
elsif ($order eq 'descend') {
# In descending order, exchange if $nums[$i] <$nums[$i + 1]
$is_change = $nums[$i] <$nums[$i + 1];
}
if ($is_change) {
($nums[$i], $nums[$i + 1]) = ($nums[$i + 1], $nums[$i]);
}
}
$change_cnt-;
}
return @nums;
}
(1) Explanation of arguments (options are passed as a reference to the hash)
my @sorted_nums_ascend = bubble_sort(\@nums, {order =>'ascend'});
I want to pass an array and a hash, so I'll use a reference. In actual programming, options are often passed in hash reference.
(2) Error handling
my @nums;
if (defined $nums) {
if (ref $nums eq 'ARRAY') {
@nums = @$nums;
}
else {return}
}
else {return}
If the first argument is not defined, return will end the process. If the first argument is defined but the first argument is not a reference to the array, return ends the process.
If the variable has an invalid state, do not continue processing. For fatal errors, you may want to use die function to throw an exception.
(3) Set the default value
my $order = 'ascend';
$order = $opt->{order} if $opt->{order};
If $opt->{order} is not specified, it is a kind way to specify the default value instead of returning it with an error. Overwrite only if $opt->{order} exists.
(4) Select ascending and descending algorithms
# Last bubble sort
if ($nums[$i] <$nums[$i + 1]) {
($nums[$i], $nums[$i + 1]) = ($nums[$i + 1], $nums[$i]);
print join(',', @nums). "(Snap)\n";
}
# This bubble sort
my $is_change;
if ($order eq 'ascend') {
$is_change = $nums[$i]> $nums[$i + 1];
}
elsif ($order eq 'descend') {
$is_change = $nums[$i] <$nums[$i + 1];
}
if ($is_change) {
($nums[$i], $nums[$i + 1]) = ($nums[$i + 1], $nums[$i]);
}
In the case of ascend, the judgment is $nums[$i]> $nums[$i + 1], and in the case of descend, the judgment is $nums[$i] <$nums[$i + 1]. It's good.
Rather than thinking about such an algorithm all at once from the beginning, it is easier to see if it is made separately and modified by focusing only on the differences as in this case.