Market Profile perl script

I posted ages ago on a ASX stockmarket forum that I had developed a perl script to display a market profile.
What is a market profile?

1. Here are links to the CBOT education site with another link to Market Profile 101
2. In a nutshell, a market profile seeks to show the distribution of prices intraday from tick or trade-by-trade data.
3. It is simple to draw, which allowed floor traders to draw (before portable devices)
4. It can reveal a difference trading pattern to what the standard OHLC price bar suggests.
   

I have access to historical tick data from the ASX and so was using perl to test various theories I had thought up about the market. Developing the market profile script was more of a challenge.

Anyway I still get requests for perl script via email even though that post was back in 2001.

As part of the move away from perl to SQL for other stuff, I am going to load my tick data into my OracleXE database and I should be able to rewrite the perl script as SQL then rewrite as a function.

If you want a copy of the perl script, email me. roobaron-/*?at*?/-yahoo.com. Take out the regex breaking bit.
or
Cut and paste the script from here

Have Fun

Paul

### CUT HERE ###

# Market Profile
# Paul Moen 05/12/2001
# Explanation:
# Takes csv file from Weblink and converts into market profile
# Traditionally market profile was split on 30 minute increments
# Each 1/2 hour is given a letter starting at A
# Range is determined by Price based on ASX tick movements
# i.e <> 1.00 increments 0.01
# So. each TP (time point) will be 5 ticks. eg price > $1.00 TP = 0.05
# Program logic based on manual procedure. i.e as data arrives time is checked
# and price is checked to see if resides with existing TP or needs a new TP
# Read the attached readme_market_profile.txt for more info on the program logic.


# Read csv file piped via sort (sorting on price)

# $title = ;

# Format of file is expected to be like this
# No, Date, Time, price, volume, sale, C Code
# Therefore @line[3] (4th element) is the price.

# Set variables

$tpr_flag = 0;
$last_price = 0;
$period_change_flag = 0;
$tp_list = '';
@mp_list = '';

while ($line = ) {
chop($line);
@line = split(/,/,$line); # split line into array elements.

# grab the date from 2nd element
$date = @line[1];
# Grab the time and determine what letter it is
# Note: Any time before 10am is ignored and time after 4.30pm is ignored
# Letter increment by 1/2 hour

# Now grab the price
$price = @line[3];
# We are going to calculate the tpr only once so check to see if it set already
if ($tpr_flag != 1){
# tpr is the time price range
if ($price > 1.00){
# tick is 0.01, tpr is 0.05
$tpr = 0.05;
$tpr_flag = 1;
} elsif ($price <> 0.10){
# tick is 0.005, tpr is 0.025
$tpr = 0.025;
$tpr_flag = 1;
} elseif ($price < tpr =" 0.005;" tpr_flag =" 1;" time =" @line[2];" period =" 'A';" period =" 'B';" period =" 'C';" period =" 'D';" period =" 'E';" period =" 'F';" period =" 'G';" period =" 'H';" period =" 'I';" period =" 'J';" period =" 'K';" period =" 'L';" period =" 'M';" period =" 'N/A';" period_change_flag =" 1;" period_change_flag =" 0;" last_price ="="" tp_list =" $price;" mp_length =" push(@mp_list,$tp_list);" last_price =" $price;" price_ge =" $last_price" price_le =" $last_price" the =","> or <> $price_le) {
# Price is within tpr and no change to , so no change to list
} elsif ( $price > $price_ge ) {
# price is greater than the price + tpr
$tp_list = $price_ge; # Price is in new tpr
$tp_list .= ' ';
$tp_list .= $period;
# push tp_list onto the top of mp_list (main list)
# @mp_list[length -1] becomes the last point.
$mp_length = push(@mp_list,$tp_list);
$last_price = $price;
# Calculate the timepoint range tpr
$price_ge = $price_ge + $tpr;
$price_le = $price_le - $tpr;
} elsif ($price < $price_le) { # price is less than price - tpr $tp_list = $price_le; # Price is in new tpr $tp_list .= ' '; $tp_list .= $period; # shift tp_list onto the bottom of the mp_list (main list) # @mp_list[0] becomes the start. $mp_length = shift(@mp_list,$tp_list); $last_price = $price; # Calculate the timepoint range tpr $price_ge = $price_ge + $tpr; $price_le = $price_le - $tpr; } else { print "something is wrong\n"; } } else { # Period is not equal to A need to work with list of scalars if (($price < $price_ge && $price > $price_le) {
# Price is in current tpr but the period is different, there should be
# a tp already in existence which requires an additional tp to be added.

} # period A check
} # everything else
$current_period = $period;
} # end of while
# end of market_profile.pl

### CUT HERE ###