#!/usr/bin/perl
# Filename:	diamond
# Author:	David Ljung Madison <DaveSource.com>
# See License:	http://MarginalHacks.com/License
# Description:	Look up diamond info!
use strict;

##################################################
# Setup the variables
##################################################
my $PROGNAME = $0;
$PROGNAME =~ s|.*/||;

# Defaults
my $COLOR="E";
my $CLARITY="SI1";
my $CARAT="1.0";
# Cut?  Ideal is 10-20% more?

##################################################
# Tables
##################################################

# First the indexes
#########################
# Colors
my @COLORS=('D'..'H');
# Clarity (list and hash)
my @CLARITY = qw(IF VVS1 VVS2 VS1 VS2 SI1 SI2 SI3 I1 I2 I3);
my %CLARITY; for(my $t=0;$t<=$#CLARITY;$t++) { $CLARITY{$CLARITY[$t]}=$t; };
# Carat steps (grid)
my @CARATS = qw(.02 .055 .11 .16 .20 .26 .335 .415 .475 .595 .795 .945 1.245 1.745 2.495 3.495 4.495 5.595);

# Then the actual price data
#########################
# Price Data (per point) (Rapaport, Rounds, 11/5/99, www.diamonds.net)
# IF=VVS1=VVS2, VS1=VS2 until .30 carats
# D=E=F, G=H until .30 carats
my $PRICE = [
	# .02 (.01-.03)
	{
	'D' => [9.0, 9.0, 9.0, 7.9, 7.9, 7.2, 6.6, 6.0, 5.5, 4.4, 2.2],
	'E' => [9.0, 9.0, 9.0, 7.9, 7.9, 7.2, 6.6, 6.0, 5.5, 4.4, 2.2],
	'F' => [9.0, 9.0, 9.0, 7.9, 7.9, 7.2, 6.6, 6.0, 5.5, 4.4, 2.2],
	'G' => [7.9, 7.9, 7.9, 7.3, 7.3, 6.8, 6.3, 5.6, 5.0, 4.0, 2.0],
	'H' => [7.9, 7.9, 7.9, 7.3, 7.3, 6.8, 6.3, 5.6, 5.0, 4.0, 2.0],
	},
	# .055
	{
	'D' => [9.1, 9.1, 9.1, 8.0, 8.0, 7.4, 6.8, 6.1, 5.6, 4.4, 2.2],
	'E' => [9.1, 9.1, 9.1, 8.0, 8.0, 7.4, 6.8, 6.1, 5.6, 4.4, 2.2],
	'F' => [9.1, 9.1, 9.1, 8.0, 8.0, 7.4, 6.8, 6.1, 5.6, 4.4, 2.2],
	'G' => [8.0, 8.0, 8.0, 7.4, 7.4, 7.0, 6.5, 5.7, 5.1, 4.0, 2.0],
	'H' => [8.0, 8.0, 8.0, 7.4, 7.4, 7.0, 6.5, 5.7, 5.1, 4.0, 2.0],
	},
	# .11
	{
	'D' => [10.0, 10.0, 10.0, 8.8, 8.8, 8.0, 7.6, 6.7, 6.0, 4.7, 2.5],
	'E' => [10.0, 10.0, 10.0, 8.8, 8.8, 8.0, 7.6, 6.7, 6.0, 4.7, 2.5],
	'F' => [10.0, 10.0, 10.0, 8.8, 8.8, 8.0, 7.6, 6.7, 6.0, 4.7, 2.5],
	'G' => [8.5, 8.5, 8.5, 8.0, 8.0, 7.6, 6.9, 6.3, 5.5, 4.3, 2.3],
	'H' => [8.5, 8.5, 8.5, 8.0, 8.0, 7.6, 6.9, 6.3, 5.5, 4.3, 2.3],
	},
	# .16
	{
	'D' => [11.5, 11.5, 11.5, 11.0, 11.0, 9.0, 8.2, 7.2, 6.4, 5.0, 2.7],
	'E' => [11.5, 11.5, 11.5, 11.0, 11.0, 9.0, 8.2, 7.2, 6.4, 5.0, 2.7],
	'F' => [11.5, 11.5, 11.5, 11.0, 11.0, 9.0, 8.2, 7.2, 6.4, 5.0, 2.7],
	'G' => [10.0, 10.0, 10.0, 9.0, 9.0, 8.5, 7.7, 6.7, 6.1, 4.7, 2.5],
	'H' => [10.0, 10.0, 10.0, 9.0, 9.0, 8.5, 7.7, 6.7, 6.1, 4.7, 2.5],
	},
	# .20
	{
	'D' => [15.0, 15.0, 15.0, 13.0, 13.0, 12.0, 10.5, 9.5, 8.0, 6.3, 3.7],
	'E' => [15.0, 15.0, 15.0, 13.0, 13.0, 12.0, 10.5, 9.5, 8.0, 6.3, 3.7],
	'F' => [15.0, 15.0, 15.0, 13.0, 13.0, 12.0, 10.5, 9.5, 8.0, 6.3, 3.7],
	'G' => [13.0, 13.0, 13.0, 11.8, 11.8, 11.0, 10.0, 9.0, 7.7, 6.0, 3.3],
	'H' => [13.0, 13.0, 13.0, 11.8, 11.8, 11.0, 10.0, 9.0, 7.7, 6.0, 3.3],
	},
	# .26
	{
	'D' => [23.0, 23.0, 23.0, 18.5, 18.5, 14.5, 12.0, 10.5, 8.6, 7.2, 4.6],
	'E' => [23.0, 23.0, 23.0, 18.5, 18.5, 14.5, 12.0, 10.5, 8.6, 7.2, 4.6],
	'F' => [23.0, 23.0, 23.0, 18.5, 18.5, 14.5, 12.0, 10.5, 8.6, 7.2, 4.6],
	'G' => [18.5, 18.5, 18.5, 15.5, 15.5, 13.0, 11.2, 10.0, 8.3, 7.0, 4.2],
	'H' => [18.5, 18.5, 18.5, 15.5, 15.5, 13.0, 11.2, 10.0, 8.3, 7.0, 4.2],
	},
	# .335
	{
	'D' => [45, 40, 37, 34, 31, 23, 19, 17, 14, 11, 8],
	'E' => [40, 37, 35, 32, 29, 22, 18, 17, 13, 10, 7],
	'F' => [37, 35, 32, 30, 27, 21, 17, 16, 12, 9, 7],
	'G' => [35, 32, 30, 27, 24, 19, 16, 15, 11, 9, 6],
	'H' => [29, 26, 24, 22, 20, 17, 15, 14, 10, 8, 6],
	},
	# .415
	{
	'D' => [47, 42, 39, 35, 32, 25, 22, 20, 16, 12, 9],
	'E' => [42, 39, 37, 33, 30, 24, 21, 19, 15, 11, 8],
	'F' => [39, 37, 34, 31, 28, 23, 20, 18, 15, 11, 8],
	'G' => [37, 34, 32, 29, 26, 22, 19, 17, 14, 10, 7],
	'H' => [31, 29, 27, 25, 23, 20, 18, 16, 13, 10, 7],
	},
	# .475
	{
	'D' => [54, 49, 46, 41, 34, 27, 24, 22, 18, 13, 10],
	'E' => [49, 46, 42, 39, 32, 26, 23, 21, 17, 12, 9],
	'F' => [46, 41, 38, 35, 30, 25, 22, 20, 16, 12, 9],
	'G' => [41, 39, 35, 32, 28, 24, 21, 19, 15, 11, 8],
	'H' => [34, 32, 30, 27, 25, 22, 19, 18, 14, 11, 8],
	},
	# .595
	{
	'D' => [76, 61, 57, 50, 46, 40, 33, 29, 22, 16, 11],
	'E' => [61, 55, 51, 48, 45, 38, 31, 27, 21, 15, 10],
	'F' => [55, 50, 48, 45, 41, 35, 29, 25, 20, 14, 10],
	'G' => [50, 46, 44, 41, 36, 31, 26, 23, 18, 13, 9],
	'H' => [44, 40, 37, 35, 31, 28, 23, 21, 17, 12, 9],
	},
	# .795
	{
	'D' => [90, 72, 67, 60, 56, 52, 48, 38, 30, 19, 12],
	'E' => [72, 67, 60, 56, 53, 50, 46, 36, 29, 18, 12],
	'F' => [66, 60, 56, 53, 50, 47, 43, 35, 28, 17, 11],
	'G' => [60, 55, 53, 50, 47, 43, 39, 34, 27, 17, 10],
	'H' => [53, 49, 47, 45, 43, 39, 36, 31, 25, 16, 10],
	},
	# .945
	{
	'D' => [102, 82, 77, 70, 64, 61, 54, 44, 34, 24, 14],
	'E' => [82, 77, 70, 64, 61, 58, 52, 42, 33, 23, 13],
	'F' => [77, 70, 64, 61, 59, 55, 50, 41, 32, 22, 13],
	'G' => [70, 63, 60, 58, 56, 52, 47, 39, 31, 21, 12],
	'H' => [62, 59, 57, 55, 53, 47, 43, 36, 29, 20, 12],
	},
	# 1.245
	{
	'D' => [167, 111, 99, 83, 75, 67, 60, 48, 41, 28, 16],
	'E' => [110, 99, 83, 77, 72, 65, 58, 47, 39, 27, 15],
	'F' => [98, 83, 77, 74, 69, 63, 55, 45, 37, 26, 14],
	'G' => [82, 76, 72, 69, 65, 59, 52, 43, 36, 25, 13],
	'H' => [72, 69, 66, 63, 60, 55, 49, 41, 34, 24, 13],
	},
	# 1.745
	{
	'D' => [184, 126, 116, 100, 94, 85, 72, 58, 45, 30, 17],
	'E' => [126, 116, 100, 96, 90, 82, 69, 55, 42, 29, 16],
	'F' => [116, 100, 96, 91, 87, 79, 66, 53, 41, 28, 15],
	'G' => [99, 92, 88, 85, 81, 72, 61, 51, 40, 27, 14],
	'H' => [84, 80, 77, 74, 71, 65, 56, 47, 38, 26, 14],
	},
	# 2.495
	{
	'D' => [265, 196, 172, 139, 112, 96, 79, 63, 50, 33, 18],
	'E' => [195, 172, 139, 122, 109, 94, 77, 61, 47, 32, 17],
	'F' => [171, 139, 122, 111, 105, 91, 75, 59, 46, 31, 16],
	'G' => [136, 122, 110, 105, 99, 86, 71, 57, 45, 30, 16],
	'H' => [114, 101, 95, 90, 84, 74, 63, 53, 42, 29, 15],
	},
	# 3.495
	{
	'D' => [407, 289, 246, 191, 156, 127, 94, 79, 68, 38, 20],
	'E' => [288, 246, 191, 156, 139, 119, 89, 75, 63, 37, 19],
	'F' => [245, 191, 156, 139, 130, 111, 85, 71, 59, 35, 18],
	'G' => [189, 155, 139, 130, 114, 99, 80, 67, 56, 33, 17],
	'H' => [151, 133, 124, 112, 98, 83, 74, 62, 52, 32, 17],
	},
	# 4.495
	{
	'D' => [438, 318, 271, 212, 177, 145, 105, 88, 74, 42, 22],
	'E' => [317, 272, 212, 177, 157, 135, 99, 83, 69, 41, 21],
	'F' => [272, 212, 177, 157, 147, 125, 95, 78, 65, 39, 20],
	'G' => [212, 177, 157, 147, 127, 110, 90, 73, 61, 37, 19],
	'H' => [163, 148, 134, 121, 105, 92, 81, 68, 57, 35, 19],
	},
	# 5.595
	{
	'D' => [566, 396, 341, 283, 233, 196, 134, 107, 81, 47, 24],
	'E' => [396, 341, 281, 243, 213, 176, 129, 101, 76, 45, 22],
	'F' => [341, 281, 246, 218, 188, 156, 124, 97, 73, 43, 21],
	'G' => [280, 246, 216, 188, 165, 142, 115, 92, 69, 41, 20],
	'H' => [231, 205, 181, 160, 141, 119, 98, 82, 64, 39, 19],
	},
	];

##################################################
# Code code code
##################################################
sub check_price {
  for (my $i=0; $i<=$#$PRICE; $i++) {
    my $last_color;
    foreach my $color ( @COLORS ) {
      next print "$CARATS[$i] $color\n"
        unless ($#{$PRICE->[$i]{$color}}+1 == (scalar keys %CLARITY));
#      print "CHECK Carats: $CARATS[$i] Color: $color\n";
      my $last_clarity;
      foreach my $clarity ( @CLARITY ) {
        print "Price went backwards for clarity? $CARATS[$i] $color $clarity to $last_clarity: ".
          "[$PRICE->[$i]{$color}[$CLARITY{$clarity}] > $PRICE->[$i]{$color}[$CLARITY{$last_clarity}]]\n"
          if ($last_clarity && $PRICE->[$i]{$color}[$CLARITY{$clarity}] > $PRICE->[$i]{$color}[$CLARITY{$last_clarity}]);
        print "Price went backwards for color? $CARATS[$i] $color to $last_color ($clarity): ".
          "[$PRICE->[$i]{$color}[$CLARITY{$clarity}] > $PRICE->[$i]{$last_color}[$CLARITY{$clarity}]]\n"
          if ($last_color && $PRICE->[$i]{$color}[$CLARITY{$clarity}] > $PRICE->[$i]{$last_color}[$CLARITY{$clarity}]);
        $last_clarity=$clarity;
      }
      $last_color=$color;
    }
  }
  print "Done checking price array\n";
  exit;
}
#check_price();

sub usage {
  print STDERR <<END_USAGE;

Usage1: $PROGNAME [color(s)] [clarity(ies)] [carat]
  Lists prices for a set of diamond specifications,
  Default specifications:  $COLOR $CLARITY $CARAT
  Example:  $PROGNAME D-E IF-VS1 .75
    (Shows average cost for .75 carat D,E diamonds from IF to VS1)

Usage2: $PROGNAME <price> [color(s)] [clarity(ies)]
  Show closest carat weight under a given price
  Default is all color/clarities
  Example:  $PROGNAME 2000 D-E IF-VS1
    (Shows carat size for D,E diamonds from IF to VS1 under \$2000)

  Colors:    @COLORS  (or a list: $COLORS[0]-$COLORS[2])
  Clarities: @CLARITY  (or a list: $CLARITY[0]-$CLARITY[2])

END_USAGE
  exit -1;
}

sub match {
  my $arg=shift(@_);
  my $def=shift(@_);
  return defined $def ? $def : @_ unless (defined $arg);
  return @_ if ($arg eq "*");

  # Is it a range?
  my ($from,$to)=($arg,$arg);
  ($from,$to) = ($1,$2) if ($arg =~ /^(.+)-(.+)$/);

  my @list;
  foreach ( @_ ) {
    push(@list,$_) if (/^$from$/i || @list);
    return @list if (/^$to$/i);
  }
  usage();
}

sub parse_args {
  my (@colors,@clarities,@carats,$price);

  print STDERR "	[Try '$PROGNAME -h' for usage]\n" unless @ARGV;

  # First arg is a price
  if ($ARGV[0] =~ /^\$?(\d+)$/) {
    $price=$1;  shift(@ARGV);
    @colors=match(shift(@ARGV),undef,@COLORS);
    @clarities=match(shift(@ARGV),undef,@CLARITY);

  # Default is to list price for given specs
  } else {
    @colors=match(shift(@ARGV),$COLOR,@COLORS);
    @clarities=match(shift(@ARGV),$CLARITY,@CLARITY);
    @carats=@ARGV ? (@ARGV) : ($CARAT); shift(@ARGV);
  }

  usage() if (@ARGV);
  (\@colors,\@clarities,\@carats,$price);
}

sub price_per_point {
  my ($color,$clarity,$carat) = @_;

  return "??" if ($carat =~ / /);

  # What is the closest point below the carat size?
  my $i;
  for ($i=0; $i<=$#CARATS; $i++) { last if ($carat<=$CARATS[$i]); }

  # Is it off the chart?
  die("Too many carats (>$CARATS[$#CARATS])\n") if ($i>$#CARATS);

  # Is it exactly that point?
  return $PRICE->[$i]{$color}[$CLARITY{$clarity}] if ($carat==$CARATS[$i]);

  # Interpolate between the two points
  my $bigdiff=$CARATS[$i]-$CARATS[$i-1];
  my $ltldiff=$carat-$CARATS[$i-1];
  my $hiprice=$PRICE->[$i]{$color}[$CLARITY{$clarity}];
  my $loprice=$PRICE->[$i-1]{$color}[$CLARITY{$clarity}];
  my $r=$ltldiff/$bigdiff;
  my $pricediff=$hiprice-$loprice;
  my $price=$loprice+$r*$pricediff;
  return int($price*100)/100;
}

sub max_carat {
  my ($price,$color,$clarity) = @_;
  
  $clarity=$CLARITY{$clarity};

  return "[0]" if ($PRICE->[0]{$color}[$clarity]*$CARATS[0]*100>$price);

  # What is the closest point below the carat size?
  my $i;
  for ($i=0; $i<=$#CARATS; $i++) {
    last if ($price<=$PRICE->[$i]{$color}[$clarity]*$CARATS[$i]*100);
  }
  # Is it off the chart?
  return "[too expensive] (>$CARATS[$#CARATS])" if ($i>$#CARATS);

  # Is it exactly that point?
  return $CARATS[$i] if ($price==$PRICE->[$i]{$color}[$clarity]*$CARATS[$i]*100);

  # Interpolate between the two points
  # (It's squared, not linear)
  my $hippp=$PRICE->[$i]{$color}[$clarity];
  my $loppp=$PRICE->[$i-1]{$color}[$clarity];
  my $hipoints=$CARATS[$i]*100;
  my $lopoints=$CARATS[$i-1]*100;
  my $hiprice=$hippp*$hipoints;
  my $loprice=$loppp*$lopoints;
  my $bigdiff=$hiprice-$loprice;
  my $ltldiff=$price-$loprice;

# $price (known)
# C=carat (unknown)
# ppp=priceperpoint (unknown)
# lc=locarat, hc=hicarat (known) (use lopoint)
# hppp=hipriceperpoint, lppp (known)
# hp=hiprice, lp=loprice (known)
# r=ratio: point-lpoint/hpoint-lpoint (point either carats or ppp)

# $price = $loprice+($hiprice-$loprice)*ratio
# ratio = (points-$lopoints)/($hipoints-$lopoints) or  r= (ppp-lppp)/(hppp-lppp)
# $price = $loprice+ ($hiprice-$loprice)(points-$lopoints)/($hipoints-$lopoints)
# ($price-$loprice)($hipoints-$lopoints) = points($hiprice-$loprice) - $lopoints($hiprice-$loprice)
# points = ( ($price-$loprice)*($hipoints-$lopoints)+$lopoints*($hiprice-$loprice) )/ ($hiprice-$loprice)

  my $points=( ($price-$loprice)*($hipoints-$lopoints)+$lopoints*($hiprice-$loprice) )/ ($hiprice-$loprice);
  my $carats= int($points*10)/1000;
  return $carats;
}

sub price_str {
  my ($p) = @_;

  $p=~/^([^\.]+)(\.(.{1,2}).*)?$/;
  my ($a,$b)=($1,$3);

  my $str;
  while ($a =~ /(...)$/) {
    $a=$`;
    $str=$str ? "$1,$str" : $1;
  }
  $str="$a,$str" if ($a);
  $str=sprintf("\$$str.%0.2d",$b);
}

sub main {
  my ($color_L,$clarity_L,$carat_L,$price) = parse_args();

  foreach my $color ( @{$color_L} ) {
    foreach my $clarity ( @{$clarity_L} ) {
      $carat_L= [ max_carat($price,$color,$clarity) ] if ($price);
      foreach my $carat ( @{$carat_L} ) {
        my $ppp=price_per_point($color,$clarity,$carat);
        my $price=$ppp*100*$carat;
        printf "$color %-5s %-7s %11s  (\$$ppp per point)\n",
               $clarity,$carat,price_str($price);
      }
    }
  }
} main();