This code works but it prints in ascending order. Do I need to change my whole formula?
print "Enter an integer \n";
my $root = <STDIN>;
my #nums = (100..200);
my $i = 0;
# code in while loop executes as long as condition is true
while ( $i < $#nums )
{
print "$nums[$i]\n",if($nums[$i] % $root == 0); $i++;
}
Just set $i to $#nums instead of 0 and decrement it -- instead of incrementing. You'll need to change the loop condition to $i >= 0 (it should be $i <= $#nums in your code, otherwise it skips 200 when 10 was entered).
#!/usr/bin/perl
use warnings;
use strict;
print "Enter an integer \n";
my $root = <>;
my #nums = (100 .. 200);
my $i = $#nums;
while ( $i >= 0 ) {
print "$nums[$i]\n" if $nums[$i] % $root == 0;
--$i;
}
There are more than a few ways to do it ... not all equally good:
#!/usr/bin/env perl
use strict;
use warnings;
run(#ARGV);
sub run {
my $root = $_[0] // get_root();
my #nums = (100 .. 200);
my #functions = (
sub {
my ($root, $nums) = #_;
my $i = #$nums;
while ($i--) {
print "$nums->[$i]\n" unless $nums->[$i] % $root;
}
return;
},
sub {
my ($root, $nums) = #_;
for my $n ( reverse #$nums ) {
print "$n\n" unless $n % $root;
}
return;
},
sub {
my ($root, $nums) = #_;
my $i;
while ($i++ < #$nums) {
print "$nums->[#$nums - $i]\n" unless $nums->[#$nums - $i] % $root;
}
return;
},
sub {
my ($root, $nums) = #_;
my #multiples = reverse grep !($_ % $root), #$nums;
print "$_\n" for #multiples;
return;
},
);
for my $i ( 0 ... $#functions ) {
print "=== Function $i ===\n";
$functions[$i]->($root, \#nums);
}
}
sub get_root {
return scalar <STDIN>;
}
print "Enter an integer \n";
my $root = <STDIN>;
my #nums = (100..200);
#nums = reverse #nums; #Just reverse the arrays
my $i = 0;
# code in while loop executes as long as condition is true
while ( $i < $#nums )
{
print "$nums[$i]\n",if($nums[$i] % $root == 0); $i++;
}
May be it will helps you.
for (my $i = $#nums; $i >= 0; --$i) { ... }
for (my $i = #nums; $i--; ) { ... }
for my $i (reverse 0 .. $#nums) { ... }
for (1 .. #nums) { my $i = -$_; ... } # Or: my $i = #nums-$_;
for my $num (reverse #nums) { ... }
Related
This is supposed to put the contents of nums into decreasing order, however sort does not change the contents of nums. Many sites I read have said to pass by reference, but I don't think I'm dereferencing the argument correctly. Bear with me, this is my first Perl program :)
#! /usr/bin/env perl
sub sort {
my #arr = #_;
my $len = scalar #arr;
for (my $i = 1; $i < $len-1; $i = $i + 1) {
my $max = $i;
for (my $j = $i + 1; $j < $len; $j = $j + 1) {
if ($arr[$j] > $arr[$max]) {
$max = $j
}
}
$temp = $arr[$max];
$arr[$max] = $arr[$i];
$arr[$i] = $temp;
}
}
print "Enter 10 numbers: ";
my $numbers = <STDIN>;
my #nums = split ' ', $numbers;
print "Unsorted: #nums\n";
sort \#nums;
print "Sorted: #nums\n";
#Matt Jacob helped me out with this one. This is what I was looking for.
#! /usr/bin/env perl
sub selection_sort {
my $arr = shift;
my $len = scalar #$arr;
for (my $i = 0; $i < $len-1; $i++) {
my $max = $i;
for (my $j = $i + 1; $j < $len; $j++) {
if (#$arr[$j] > #$arr[$max]) {
$max = $j
}
}
my $temp = #$arr[$max];
#$arr[$max] = #$arr[$i];
#$arr[$i] = $temp;
}
}
print "Enter 10 numbers: ";
my $input = <STDIN>;
my #integers = split ' ', $input;
print "Unsorted: #integers\n";
selection_sort \#integers;
print "Sorted: #integers\n";
I'm trying to write a program that can read from a file then put into a heap sort then output in a tree along with the sorted list. But I got stuck, instead of having the put be the numbers used in the heap sort, it just post 1-10 on one line then 1-9 on the next line. I'm really confused and I barely understand this language as it is. I put a example of the out below alone with the output I am hoping to have it draw.
#!/usr/bin/perl
use 5.006;
use strict;
use warnings;
use Tree::DAG_Node;
process_data(read_file('testing.txt'));
process_data((3,1,4,1,5,9,2,6,5,3,6));
sub read_file{
my($filename)=#_;
my #data=();
my #words;
open(my $fh, "<", $filename)
or die "Could not open file: $!\n";
while(<$fh>){
chomp;
#words = split(' ');
foreach my $word(#words){
push #data, $word;
}
}
close $fh;
return #data;
}
sub heap_sort {
my ($a) = #_;
my $n = #$a;
for (my $i = ($n - 2) / 2; $i >= 0; $i--) {
down_heap($a, $n, $i);
}
for (my $i = 0; $i < $n; $i++) {
my $t = $a->[$n - $i - 1];
$a->[$n - $i - 1] = $a->[0];
$a->[0] = $t;
down_heap($a, $n - $i - 1, 0);
}
}
sub down_heap {
my ($a, $n, $i) = #_;
while (1) {
my $j = max($a, $n, $i, 2 * $i + 1, 2 * $i + 2);
last if $j == $i;
my $t = $a->[$i];
$a->[$i] = $a->[$j];
$a->[$j] = $t;
$i = $j;
}
sub max {
my ($a, $n, $i, $j, $k) = #_;
my $m = $i;
$m = $j if $j < $n && $a->[$j] > $a->[$m];
$m = $k if $k < $n && $a->[$k] > $a->[$m];
return $m;
}
}
sub draw_tree{
my(#data)=#_;
my $root = Tree::DAG_Node->new;
$root->name($_[0]);
$root->new_daughter->name($_) for (1..10);
my #names = #data;
my $count = 50;
for my $n ($root->daughters) {
for (split //, $names[$count++]) {
$n->new_daughter->name($_)
}
}
print map "$_\n", #{$root->draw_ascii_tree};
}
sub process_data{
my(#data)=#_;
my #a = #data;
print "#a\n";
print "\n";
heap_sort(\#a);
draw_tree(#a);
print "\n";
print "#a\n";
print "\n";
}
here is the output I get
CMD output of my code
Output I am expecting:
(using example data)
1 1 9 4 5
1
|
1 ----- 9
|
/\
4 5
1 1 4 5 9
When ever I run this bit of code. it doesn't display any output. Anyone see anything wrong?
I am trying to display this in the out put:
A
AA
AAA
AAAB
AAABA
AAABAA
AAABAAA
AAABAAAB
etc.
#!/usr/local/bin/perl
$A = 3;
$B = 1;
$i = 1;
$output = "";
$j = 1;
while ($i <= $ARGV[0]) {
while ($j <= $i) {
if ($A == 0 && $B == 0) {
$A = 3;
$B = 1;
}
if ($A > 0) {
$output.= "A";
$A--;
}
else {
$output.= "B";
$B--;
}
$j++;
}
print($output . "\n");
$i++;
}
It works for me when I run it with a numeric argument (number of lines).
An idea how to simplify the code:
#!/usr/bin/perl
use warnings;
use strict;
my $count = shift;
my $A = 3;
my $B = 1;
my $string = q();
$string .= ('A' x $A) . ('B' x $B) while $count > length $string;
print substr($string, 0, $_), "\n" for 1 .. $count;
It uses a different algorithm - it creates the longest possible string, and then outputs parts of it.
if there is no #ARGV, while ($i <= $ARGV[0]) never runs.
#ARGV is an array of the command line arguments provided when the script is executed. you did not provide any command line arguments. if you had use warnings in effect, you would be warned that $ARGV[0] is uninitialized.
As from ikegami comment. You cann't pass the input at when the program is compile. For example, consider your file name is algo.pl. Can you run your program with
perl algo.pl 10
Here 10 is the input value of the program. In program value is retrieve by the $ARGV[0]
so in your program looks like while ($i <= $ARGV[0]).
If you want pass the several values like perl filename.pl 12 data1 data2In your data retrieve by $ARGV[0] $ARGV[1] $ARGV[2] for more information see here.
If you want pass the input at the time of execution used STDIN
use warnings;
use strict;
my $A = 3;
my $B = 1;
my $i = 1;
my $output = "";
my $j = 1;
print "Enter the value: ";
chomp(my $value = <STDIN>);
while ($i <= $value) {
while ($j <= $i) {
if ($A == 0 && $B == 0) {
$A = 3;
$B = 1;
}
if ($A > 0) {
$output.= "A";
$A--;
}
else {
$output.= "B";
$B--;
}
$j++;
}
print($output . "\n");
$i++;
}
The problem with the following code is only in one function of the code. The problem function is with a comment head and close. This is my first post to StackOverflow so bear with me. The following script has some modules and other functions that I know work by testing them with the problem function commented out but I just cannot seem to get that one function to work. When ran, the script runs until the enviroment kills the execution.
Basically what this program does is takes a PDB file, copies everything out of the PDB file and creates a new one and pastes all of the original input file content into the new file and appends the cavities(coordinates of center of the cavity and the specified probe radius) that the program is supposed to find.
The problem function within the code is supposed to distinguish between a void space within a bound box of the structure and a cavity. Cavities are considered to be a closed space somewhere within the structure. A void space is any space or coordinate within the bounding box of max and min coorindates where there isn't an atom.The cavity must be large enough to fit into a specified probe radius. There is also a specified resolution when searching through the 3D hashtable of coordinates.
Can anyone tell me why my code isn't working. Anything immediate. I have tested and tested and cannot seem to find the error.
Thank you.
#!/usr/bin/perl
# Example 11-6 Extract atomic coordinates from PDB file
use strict;
use warnings;
use BeginPerlBioinfo; # see Chapter 6 about this module
#open file for printing
open(FH,">results.pdb");
open(PDB,"oneAtom.pdb");
while(<PDB>) { print FH $_; }
close(PDB);
# Read in PDB file
my #file = get_file_data('oneAtom.pdb');
# Parse the record types of the PDB file
my %recordtypes = parsePDBrecordtypes(#file);
# Extract the atoms of all chains in the protein
my %atoms = parseATOM ( $recordtypes{'ATOM'} );
#define some variables and get the atom indices stored in atom_numbers array
my #atom_numbers = sort {$a <=> $b} keys %atoms;
my $resolution = 4.;
my $lo = 1000;
my $hi = -1000;
my $p_rad = 1;
my %pass;
#set the grid boundaries
foreach my $l ( #atom_numbers ) {
for my $i (0..2) {
if ( $atoms{$l}[$i] < $lo ) { $lo = $atoms{$l}[$i]; }
if ( $atoms{$l}[$i] > $hi ) { $hi = $atoms{$l}[$i]; }
}
}
$lo = $lo - 2* $resolution;
$hi = $hi + 2* $resolution;
#compute min distance to the pdb structure from each grid point
for ( my $i = $lo ; $i <= $hi ; $i = $i + $resolution ) {
for ( my $j = $lo ; $j <= $hi ; $j = $j + $resolution ) {
for ( my $k = $lo ; $k <= $hi ; $k = $k + $resolution ) {
my $min_dist = 1000000;
foreach my $l ( #atom_numbers ) {
my $distance = sqrt((($atoms{$l}[0]-($i))*($atoms{$l}[0]-($i))) + (($atoms{$l}[1]-($j))*($atoms{$l}[1]-($j))) + (($atoms{$l}[2]-($k))*($atoms{$l}[2]-($k))));
$distance = $distance - ( $p_rad + $atoms{$l}[3] );
if ( $distance < $min_dist ) {
$min_dist = $distance;
}
}
$pass{$i}{$j}{$k} = $min_dist;
if ( $pass{$i}{$j}{$k} > 0 ) {
$pass{$i}{$j}{$k} = 1;
} else { $pass{$i}{$j}{$k} = 0;
}
}
}
}
#define a starting point on the outside of the grid and place first on list of points
#my #point = ();
my $num_cavities = 0;
#define some offsets used to compute neighbors
my %offset = (
1 => [-1*$resolution,0,0],
2 => [1*$resolution,0,0],
3 => [0,-1*$resolution,0],
4 => [0,1*$resolution,0],
5 => [0,0,-1*$resolution],
6 => [0,0,1*$resolution],
);
##########################################################
#function below with problem
##########################################################
my #point = ();
push #point,[$hi,$hi,$hi];
=pod
#do the following while there are points on the list
while ( #point ) {
foreach my $vector ( keys %offset ) { #for each offset vector
my #neighbor = (($point[0][0]+$offset{$vector}[0]),($point[0][1]+$offset{$vector}[1]),($point[0][2]+$offset{$vector}[2])); #compute neighbor point
if ( exists $pass{$neighbor[0]}{$neighbor[1]}{$neighbor[2]} ) { #see if neighbor is in the grid
if ( $pass{$neighbor[0]}{$neighbor[1]}{$neighbor[2]} == 1 ) { #if it is see if its further than the probe radius
push #point,[($point[0][0]+$offset{$vector}[0]),($point[0][1]+$offset{$vector}[1]),($point[0][2]+$offset{$vector}[2])]; #if it is push it onto the list of points
}
}
}
$pass{$point[0][0]}{$point[0][1]}{$point[0][2]} = 0; #eliminate the point just tested from the pass array
shift #point; #move to the next point in the list
}
=cut
##############################################################
# end of problem function
##############################################################
my $grid_ind = $atom_numbers[$#atom_numbers];
for ( my $i = $lo ; $i <= $hi ; $i = $i + $resolution ) {
for ( my $j = $lo ; $j <= $hi ; $j = $j + $resolution ) {
for ( my $k = $lo ; $k <= $hi ; $k = $k + $resolution ) {
if ( $pass{$i}{$j}{$k} == 1 ) {
$grid_ind = $grid_ind + 1;
my $n = sprintf("%5d",$grid_ind);
my $x = sprintf("%7.3f",$i);
my $y = sprintf("%7.3f",$j);
my $z = sprintf("%7.3f",$k);
my $w = sprintf("%6.3f",1);
my $p = sprintf("%6.3f",$p_rad);
print FH "ATOM $n MC CAV $n $x $y $z $w $p \n";
}
}
}
}
close(FH);
exit;
#do the following while there are points on the list
for ( my $i = $lo ; $i <= $hi ; $i = $i + $resolution ) {
for ( my $j = $lo ; $j <= $hi ; $j = $j + $resolution ) {
for ( my $k = $lo ; $k <= $hi ; $k = $k + $resolution ) {
if ( $pass{$i}{$j}{$k} == 1 ) {
push #point,[$i,$j,$k];
$num_cavities++;
while ( #point ) {
foreach my $vector ( keys %offset ) { #for each offset vector
my #neighbor = (($point[0][0]+$offset{$vector}[0]),($point[0][1]+$offset{$vector}[1]),($point[0][2]+$offset{$vector}[2])); #compute neighbor point
if ( exists $pass{$neighbor[0]}{$neighbor[1]}{$neighbor[2]} ) { #see if neighbor is in the grid
if ( $pass{$neighbor[0]}{$neighbor[1]}{$neighbor[2]} == 1 ) { #if it is see if its further than the probe radius
push #point,[($point[0][0]+$offset{$vector}[0]),($point[0][1]+$offset{$vector}[1]),($point[0][2]+$offset{$vector}[2])]; #if it is push it onto the list of points
}
}
}
$pass{$point[0][0]}{$point[0][1]}{$point[0][2]} = 0; #eliminate the point just tested from the pass array
shift #point; #move to the next point in the list
}
}
}
}
}
#print the results
print "\nthe structure has " . $num_cavities . " cavities.\n\n";
#print the point that are left over (these correspond to the cavities)
#for ( my $i = -10 ; $i <= 10 ; $i = $i + $resolution ) {
# for ( my $j = -10 ; $j <= 10 ; $j = $j + $resolution ) {
# for ( my $k = -10 ; $k <= 10 ; $k = $k + $resolution ) {
# print $i . "\t" . $j . "\t" . $k . "\t" . $pass{$i}{$j}{$k} . "\n";
# }
# }
#}
###################################################
# function
###################################################
sub parseATOM {
my($atomrecord) = #_;
use strict;
use warnings;
my %results = ( );
# Turn the scalar into an array of ATOM lines
my(#atomrecord) = split(/\n/, $atomrecord);
foreach my $record (#atomrecord) {
my $number = substr($record, 6, 5); # columns 7-11
my $x = substr($record, 30, 8); # columns 31-38
my $y = substr($record, 38, 8); # columns 39-46
my $z = substr($record, 46, 8); # columns 47-54
my $r = substr($record, 60, 6); # columns 47-54
#my $element = substr($record, 76, 2); # columns 77-78
# $number and $element may have leading spaces: strip them
$number =~ s/\s*//g;
#$element =~ s/\s*//g;
$x =~ s/\s*//g;
$y =~ s/\s*//g;
$z =~ s/\s*//g;
$r =~ s/\s*//g;
# Store information in hash
#$results{$number} = [$x,$y,$z,$element];
$results{$number} = [$x,$y,$z,$r];
}
# Return the hash
return %results;
}
Here's one thing that is almost certainly slowing things down:
$x =~ s/\s*//g;
$y =~ s/\s*//g;
$z =~ s/\s*//g;
$r =~ s/\s*//g;
It is possible for \s* to match an empty string, so you are replacing empty strings with empty strings, for each empty string in the target string.
Change to:
$x =~ s/\s+//g;
$y =~ s/\s+//g;
$z =~ s/\s+//g;
$r =~ s/\s+//g;
You have the following definitions:
my $lo = 1000;
my $hi = -1000;
So when you get to your first for loop, you will set $i to 1000, and then fail the check to see if it is less than -1000.
I am working on something for learning purposes where I have tackled Collatz using recursion. If you see below I make use of #_ and $_ to keep the for alive.
#!/usr/bin/env perl
sub collatz {
my ($num, $count) = #_;
$count++;
if ($num == 1) {
return $count;
} elsif ($num % 2 == 0) {
return collatz($num/2, $count);
} else {
return collatz($num*3 + 1, $count);
}
}
my $max = 0;
my $saved = 0;
for (1..1000) {
my $length = collatz($_, 0);
print "Num: " . $_ . " Length: " . $length . "\n";
if ($length > $max) {
$max = $length;
$saved = $_;
}
}
print "The longest sequence starts with " . $saved . "\n";
I am trying to use iteration instead of recursion but I just can't think of how to tackle this. I am not after the code in the question, I just want some tips / hints on how to tackle this to get the same result.
I suspect I will need to use a while or an until field.
Any help would be appreciated, again I don't want the exact answer.
Update
Here is my second attempt, which is giving me an error of
Can't return outside a subroutine at answer2.pl line 38.
my $number = 0;
my $counter = 0;
while ($number != 1000) {
$counter++;
if ($number == 1) {
return $counter;
}
elsif ($number % 2 == 0) {
return ($number / 2, $counter);
}
else {
return ($number * 3 + 1, $counter);
}
$number++;
}
print "number" . $number . "counter" . $counter . "\n";
Basically you have tail recursion, which is nice and simple to eliminate.
Instead of collatz calling itself to generate the next step in the sequence, you simply change the variables in-place and loop back to the top.
In its crudest form this would be
sub collatz2 {
my ($num, $count) = #_;
NEXT:
$count++;
if ($num == 1) {
return $count;
}
elsif ($num % 2 == 0) {
$num = $num / 2;
}
else {
$num = $num * 3 + 1;
}
goto NEXT;
}
but it should be written much more nicely than that.
I ended up with this
sub collatz {
my ($num) = #_;
my $count = 1;
while ($num > 1) {
$num = $num % 2 ? $num * 3 + 1 : $num / 2;
++$count;
}
$count;
}
Consider adding the logic that returns when the condition is met in the while.
Spoiler:
my $iter = 0;
while($num != 1){ #do stuff; $iter++ }
Just use a for or while loop with the end condition that your number == 1.
Spoiler:
use strict;
use warnings;
my $max_num = 0;
my $max_steps = 0;
for my $num (1..1000) {
my $steps = 0;
for (my $i = $num; $i != 1; $steps++) {
$i = $i % 2 ? 3 * $i + 1 : $i / 2;
}
print "Num: " . $num . " Length: " . $steps . "\n";
if ($steps > $max_steps) {
$max_num = $num;
$max_steps = $steps;
}
}
print "The longest sequence starts with " . $max_num . "\n";