Converting numbers to K/M/G/T and days/hours/min? - perl

Is there an easy way to convert numbers like these
123 -> 123B
1234 -> 1.2K
12345 -> 12.2K
123456 -> 123.4K
1234567 -> 1.2M
12345678 -> 12.3M
123456789 -> 123.4M
...
and ideally also large numbers into days/hours/min. ?

This was discussed on Stackoverflow using Time::Piece. One of the answers comes close to calculating days hours minutes. From what I've read about this question before, I think you can easily code it up like this:
sub dhms {
my $seconds = shift;
my $days = int $seconds / 86400;
$seconds %= 86400;
my $hours = int $seconds / 3600;
$seconds %= 3600;
my $mins = int $seconds / 60;
my $secs = $seconds % 60;
return $days, $hours, $mins, $secs;
}
Update: daxim's answer using DateTime::Format::Duration does this as well

Suffixing is quite simple actually, once we understand the relationship between the letters K, M, G, T and the factors they present:
K = 10^3 = 10^3^1
M = 10^6 = 10^3^2
G = 10^9 = 10^3^3
T = 10^12 = 10^3^4
The next important thing to realize is that 10^0 = 1.
We want to select the largest suffix whose value is smaller than the value we want to transform. To do that, we put the suffixes into an array:
my #suffixes = qw/ B K M G T /;
so that
$suffixes[$i] == 10**3**$i # conceptually
Now it's just a matter of looping over the indices (probably in reverse) and stopping as soon as the $val >= 10**3**$i.

Related

How to isolate leftmost bytes in integer

This has to be done in Perl:
I have integers on the order of e.g. 30_146_890_129 and 17_181_116_691 and 21_478_705_663.
These are supposedly made up of 6 bytes, where:
bytes 0-1 : value a
bytes 2-3 : value b
bytes 4-5 : value c
I want to isolate what value a is. How can I do this in Perl?
I've tried using the >> operator:
perl -e '$a = 330971351478 >> 16; print "$a\n";'
5050222
perl -e '$a = 17181116691 >> 16; print "$a\n";'
262163
But these numbers are not on the order of what I am expecting, more like 0-1000.
Bonus if I can also get values b and c but I don't really need those.
Thanks!
number >> 16 returns number shifted by 16 bit and not the shifted bits as you seem to assume. To get the last 16 bit you might for example use number % 2**16 or number & 0xffff. To get to b and c you can just shift before getting the last 16 bits, i.e.
$a = $number & 0xffff;
$b = ($number >> 16) & 0xffff;
$c = ($number >> 32) & 0xffff;
If you have 6 bytes, you don't need to convert them to a number first. You can use one the following depending on the order of the bytes: (Uppercase represents the most significant byte.)
my ($num_c, $num_b, $num_a) = unpack('nnn', "\xCC\xcc\xBB\xbb\xAA\xaa");
my ($num_a, $num_b, $num_c) = unpack('nnn', "\xAA\xaa\xBB\xbb\xAA\xaa");
my ($num_c, $num_b, $num_a) = unpack('vvv', "\xcc\xCC\xbb\xBB\xaa\xAA");
my ($num_a, $num_b, $num_c) = unpack('vvv', "\xaa\xAA\xbb\xBB\xcc\xCC");
If you are indeed provided with a number 0xCCccBBbbAAaa), you can convert it to bytes then extract the numbers you want from it as follows:
my ($num_c, $num_b, $num_a) = unpack('xxnnn', pack('Q>', $num));
Alternatively, you could also use an arithmetic approach like you attempted.
my $num_a = $num & 0xFFFF;
my $num_b = ( $num >> 16 ) & 0xFFFF;
my $num_c = $num >> 32;
While the previous two solutions required a Perl built to use 64-bit integers, the following will work with any build of Perl:
my $num_a = $num % 2**16;
my $num_b = ( $num / 2**16 ) % 2**16;
my $num_c = int( $num / 2**32 );
Let's look at ( $num >> 16 ) & 0xFFFF in detail.
Original number: 0x0000CCccBBbbAAaa
After shifting: 0x00000000CCccBBbb
After masking: 0x000000000000BBbb

Calculating Factorials using QBasic

I'm writing a program that calculates the Factorial of 5 numbers and output the results in a Tabular form but I keep getting Zeros.
Factorial Formula:. n! = nĂ—(n-1)!
I tried:
CLS
DIM arr(5) AS INTEGER
FOR x = 1 TO 5
INPUT "Enter Factors: ", n
NEXT x
f = 1
FOR i = 1 TO arr(n)
f = f * i
NEXT i
PRINT
PRINT "The factorial of input numbers are:";
PRINT
FOR x = 1 TO n
PRINT f(x)
NEXT x
END
and I'm expecting:
Numbers Factorrials
5 120
3 6
6 720
8 40320
4 24
You did some mistakes
FOR i = 1 TO arr(n)
where is n defined
you also never stored actual values into arr
PRINT f(x)
here you take from array f that is also not defined in your code
Possible solution to calculate arrays of factorials:
CLS
DIM arr(5) AS INTEGER
DIM ans(5) AS LONG
FOR x = 1 TO 5
INPUT "Enter Factors: ", arr(x)
f& = 1
FOR i = 1 TO arr(x)
f& = f& * i
NEXT i
ans(x) = f&
NEXT x
PRINT
PRINT "The factorial of input numbers are:";
PRINT
PRINT "Numbers", "Factorials"
FOR x = 1 TO 5
PRINT arr(x), ans(x)
NEXT x
END
I don't have a BASIC interpreter right in front of me, but I think this is what you're looking for:
CLS
DIM arr(5) AS INTEGER
DIM ans(5) AS LONG 'You need a separate array to store results in.
FOR x = 1 TO 5
INPUT "Enter Factors: ", arr(x)
NEXT x
FOR x = 1 to 5
f& = 1
FOR i = 1 TO arr(x)
f& = f& * i
NEXT i
ans(x) = f&
NEXT x
PRINT
PRINT "The factorial of input numbers are:";
PRINT
PRINT "Numbers", "Factorials"
FOR x = 1 TO 5
PRINT STR$(arr(x)), ans(x)
NEXT x
END
Just a comment though: In programming, you should avoid reusing variables unless you are short on memory. It can be done right, but it creates many opportunities for hard to find bugs in larger programs.
Possible solution to calculate arrays of factorials and square roots:
CLS
PRINT "Number of values";: INPUT n
DIM arr(n) AS INTEGER
DIM ans(n) AS LONG
FOR x = 1 TO n
PRINT "Enter value"; x;: INPUT arr(x)
f& = 1
FOR i = 1 TO arr(x)
f& = f& * i
NEXT i
ans(x) = f&
NEXT x
PRINT
PRINT "The factorial/square root of input numbers are:";
PRINT
PRINT "Number", "Factorial", "Squareroot"
FOR x = 1 TO n
PRINT arr(x), ans(x), SQR(arr(x))
NEXT x
END

Convert epoch difference to number of days

I computed the difference of two ISO 8601 dates after coverting them to epoch.
How can I get the difference of them in number of days?
My code is
my $ResolvedDate = "2014-06-04T10:48:07.124Z";
my $currentDate = "2014-06-04T06:03:36-04:00"
my $resolved_epoch = &convert_time_epoch($ResolvedDate);
my $current_epoch = &convert_time_epoch($currentDate);
if (($resolvedDate - $currentDate) > $noOfDays) {
print "Difference in greater than x\n";
$built = 0;
return ($built);
} else {
print "Difference in smaller than x \n";
$built = 1;
return ($built);
}
sub convert_time_epoch {
my $time_c = str2time(#_);
my #time_l = localtime($time_c);
my $epoch = strftime("%s", #time_l);
return($epoch);
}
Here in addition to $built I also want to return exact number of days, Resolved date is greater than Current date.
"number of days" is awkward, because this is localtime and DST exists (or at least, may exist).
By simply dividing by 86400 you can easily obtain the number of 24-hour periods, which may be sufficient for your purposes.
If you want the true number of times that the mday field has changed, this may be slightly different from the value obtained by this simple division, however.
If the dates are in epoch seconds, take the difference and divide it by the number of seconds in a day (which is 86400). Like so:
my $days_difference = int(($time1 - $time2) / 86400);
If you use DateTime then
my $duration = $dt1->delta_days($dt2); #$dt1 and $dt2 are DateTime objects.
print $duration->days;
use DateTime::Format::ISO8601 qw( );
my $ResolvedDate = "2014-06-04T10:48:07.124Z";
my $currentDate = "2014-06-04T06:03:36-04:00";
my $format = DateTime::Format::ISO8601->new();
my $dt_resolved = $format->parse_datetime($ResolvedDate);
my $dt_current = $format->parse_datetime($currentDate);
my $dur = $dt_resolved->delta_days($dt_current);
my $days = $dur->in_units('days');

Randomly selecting letters by frequency of use

After feeding few Shakespeare books to my Perl script I have a hash with 26 english letters as keys and the number of their occurences in texts - as value:
%freq = (
a => 24645246,
b => 1409459,
....
z => 807451,
);
and of course the total number of all letters - let's say in the $total variable.
Is there please a nice trick to generate a string holding 16 random letters (a letter can occur several times there) - weighted by their frequency of use?
To be used in a word game similar to Ruzzle:
Something elegant - like picking a random line from a file, as suggested by a Perl Cookbook receipt:
rand($.) < 1 && ($line = $_) while <>;
The Perl Cookbook trick for picking a random line (which can also be found in perlfaq5) can be adapted for weighted sampling too:
my $chosen;
my $sum = 0;
foreach my $item (keys %freq) {
$sum += $freq{$item};
$chosen = $item if rand($sum) < $freq{$item};
}
Here, $sum corresponds to the line counter $. and $freq{$item} to the constant 1 in the Cookbook version.
If you're going to be picking a lot of weighted random samples, you can speed this up a bit with some preparation (note that this destroys %freq, so make a copy first if you want to keep it):
# first, scale all frequencies so that the average frequency is 1:
my $avg = 0;
$avg += $_ for values %freq;
$avg /= keys %freq;
$_ /= $avg for values %freq;
# now, prepare the array we'll need for fast weighted sampling:
my #lookup;
while (keys %freq) {
my ($lo, $hi) = (sort {$freq{$a} <=> $freq{$b}} keys %freq)[0, -1];
push #lookup, [$lo, $hi, $freq{$lo} + #lookup];
$freq{$hi} -= (1 - $freq{$lo});
delete $freq{$lo};
}
Now, to draw a random weighted sample from the prepared distribution, you just do this:
my $r = rand #lookup;
my ($lo, $hi, $threshold) = #{$lookup[$r]};
my $chosen = ($r < $threshold ? $lo : $hi);
(This is basically the Square Histogram method described in Marsaglia, Tsang & Wang (2004), "Fast Generation of Discrete Random Variables", J. Stat. Soft. 11(3) and originally due to A.J. Walker (1974).)
I have no clue about Perl syntax so I'll just write pseudo-code. You can do something like that
sum <= 0
foreach (letter in {a, z})
sum <= sum + freq[letter]
pick r, a random integer in [0, sum[
letter <= 'a' - 1
do
letter <= letter + 1
r <= r - freq(letter)
while r > 0
letter is the resulting value
The idea behind this code is to make a stack of boxes for each letter. The size of each box is the frequency of the letter. Then we choose a random location on this stack and see which letter's box we landed.
Example :
freq(a) = 5
freq(b) = 3
freq(c) = 3
sum = 11
| a | b | c |
- - - - - - - - - - -
When we choose a 0 <= r < 11, we have the following probabilities
Pick a 'a' = 5 / 11
Pick a 'b' = 3 / 11
Pick a 'c' = 3 / 11
Which is exactly what we want.
You can first built a table of the running sum of the frequency. So if you have the following data:
%freq = (
a => 15,
b => 25,
c => 30,
d => 20
);
the running sum would be;
%running_sums = (
a => 0,
b => 15,
c => 40, # 15 + 25
d => 70, # 15 + 25 + 30
);
$max_sum = 90; # 15 + 25 + 30 + 20
To pick a single letter with the weighted frequency, you need to select a number between [0,90), then you can do a linear search on the running_sum table for the range that includes the letter. For example, if your random number is 20 then the appropriate range is 15-40, which is for the letter 'b'. Using linear search gives a total running time of O(m*n) where m is the number of letters we need and n is the size of the alphabet (therefore m=16, n=26). This is essentially what #default locale do.
Instead of linear search, you can also do a binary search on the running_sum table to get the closest number rounded down. This gives a total running time of O(m*log(n)).
For picking m letters though, there is a faster way than O(m*log(n)), perticularly if n < m. First you generate m random numbers in sorted order (which can be done without sorting in O(n)) then you do a linear matching for the ranges between the list of sorted random numbers and the list of running sums. This gives a total runtime of O(m+n). The code in its entirety running in Ideone.
use List::Util qw(shuffle);
my %freq = (...);
# list of letters in sorted order, i.e. "a", "b", "c", ..., "x", "y", "z"
# sorting is O(n*log(n)) but it can be avoided if you already have
# a list of letters you're interested in using
my #letters = sort keys %freq;
# compute the running_sums table in O(n)
my $sum = 0;
my %running_sum;
for(#letters) {
$running_sum{$_} = $sum;
$sum += $freq{$_};
}
# generate a string with letters in $freq frequency in O(m)
my $curmax = 1;
my $curletter = $#letters;
my $i = 16; # the number of letters we want to generate
my #result;
while ($i > 0) {
# $curmax generates a uniformly distributed decreasing random number in [0,1)
# see http://repository.cmu.edu/cgi/viewcontent.cgi?article=3483&context=compsci
$curmax = $curmax * (1-rand())**(1. / $i);
# scale the random number $curmax to [0,$sum)
my $num = int ($curmax * $sum);
# find the range that includes $num
while ($num < $running_sum{$letters[$curletter]}) {
$curletter--;
}
push(#result, $letters[$curletter]);
$i--;
}
# since $result is sorted, you may want to use shuffle it first
# Fisher-Yates shuffle is O(m)
print "", join('', shuffle(#result));

Perl recursion help

I'm trying to write a program that will calculate the dividends of stocks. I did this without a subroutine. Right now, I'm trying to modify it so it can run using a recursive routine. Any help with this? Because I'm not so good at this.
Here's the original script + a pathetic attempt.
print "A stock xyz's price is now $100. It has 3.78% dividend. You have 1000 of it and reinvest the dividend into the stock.\n";
my %hash;
#stocknum = 1000;
#dividend = 6780;
while ($#dividend != 20) {
$a = $dividend[-1];
$stock = $stocknum[-1];
$div_total= $stock*100*0.0678;
$stock_total = $stock + int($a/100);
push (#stocknum, $stock_total);
push (#dividend, $div_total);
if ($#dividend == 20) {
last;
}
}
shift (#dividend);
$stock_num = $stocknum[-1];
$div = $stock_num*100*0.0678;
push (#dividend, $div);
#hash{#stocknum} = #dividend;
foreach $key(sort keys %hash) {
print "Stock number: $key\t"."Dividend: $hash{$key}\n";
}
$dividend=0.0378;
I don't think you want recursion. I think you just want to loop over the number of cycles of payouts that you're after. It looks like you're getting all mixed up with arrays for some reason.
print <<'HERE';
A stock xyz's price is now $100. It has 6.78% dividend.
You have 1000 of it and reinvest the dividend into the stock.
HERE
my $shares = 1000;
my $price = 100;
my $dividend = 6.78 / 100;
my $cycles = $ARGV[0] || 20;
foreach ( 1 .. $cycles ) {
local $cycle = $_;
local $payout = $shares * $dividend * $price;
local $new_shares = $payout / $price;
write();
$shares += $new_shares;
}
format STDOUT =
#### #####.###### ######.####### ###.###### #####.######
$cycle, $shares, $payout, $new_shares, $shares+$new_shares,
.
format STDOUT_TOP =
###.####%
$dividend
Cycle Shares Payout New Shares Total Shares
----------------------------------------------------------------
.
This gives me the output:
A stock xyz's price is now $100. It has 6.78% dividend.
You have 1000 of it and reinvest the dividend into the stock.
0.0678%
Cycle Shares Payout New Shares Total Shares
----------------------------------------------------------------
1 1000.000000 6780.0000000 67.800000 1067.800000
2 1067.800000 7239.6840000 72.396840 1140.196840
3 1140.196840 7730.5345752 77.305346 1217.502186
4 1217.502186 8254.6648194 82.546648 1300.048834
5 1300.048834 8814.3310942 88.143311 1388.192145
6 1388.192145 9411.9427423 94.119427 1482.311572
7 1482.311572 10050.0724603 100.500725 1582.812297
8 1582.812297 10731.4673731 107.314674 1690.126971
9 1690.126971 11459.0608610 114.590609 1804.717579
10 1804.717579 12235.9851873 122.359852 1927.077431
11 1927.077431 13065.5849830 130.655850 2057.733281
12 2057.733281 13951.4316449 139.514316 2197.247597
13 2197.247597 14897.3387104 148.973387 2346.220985
14 2346.220985 15907.3782750 159.073783 2505.294767
15 2505.294767 16985.8985220 169.858985 2675.153752
16 2675.153752 18137.5424418 181.375424 2856.529177
17 2856.529177 19367.2678194 193.672678 3050.201855
18 3050.201855 20680.3685775 206.803686 3257.005541
19 3257.005541 22082.4975671 220.824976 3477.830517
20 3477.830517 23579.6909021 235.796909 3713.627426
Don't worry about my use of format; I've had that on the brain this weekend since I rewrote some perlfaq stuff about it then also turned it into Use formats to create paginated, plaintext reports. You could just as easily created the output with printf:
print <<'HERE';
A stock xyz's price is now $100. It has 6.78% dividend.
You have 1000 of it and reinvest the dividend into the stock.
Cycle Shares Payout New Shares Total Shares
----------------------------------------------------------------
HERE
my $shares = 1000;
my $price = 100;
my $dividend = 6.78 / 100;
my $cycles = $ARGV[0] || 20;
foreach ( 1 .. $cycles ) {
my $payout = $shares * $dividend * $price;
my $new_shares = $payout / $price;
printf "%4d %12.6f %12.6f %10.6f %12.6f\n",
$_, $shares, $payout, $new_shares, $shares + $new_shares;
$shares += $new_shares;
}
As a side note, you really don't ever want recursion, and especially not in Perl if you can help it. Other languages get away with it because they know how to unroll your recursion to turn it into an iterative process. Perl, being a dynamic language, can't really do that because it doesn't know if the subroutine will have the same definition on the next go around. It's nice as a computer science topic because it makes the programming marginally easier and they know it all works out in the end. I think I talk about this in Mastering Perl somewhere, but Mark Jason Dominus covers it extensively in Higher-Order Perl. Basically, instead of recursion you use a queue, which is a better skill to practice anyway.