#!/usr/bin/perl -w

#
#   heat shrink tubing selector
#   estimator
#

use strict;
use POSIX;

# %TUBE_LIST
# IDBS: inner diameter before shrinkage
# WTBS: wall thickness before shrinkage
# ODAS: outer diameter after shrinkage
# WTAS: wall thickness after shrinkage

my %TUBE_LIST = (

    # SMITUBE(一部)
    # model           IDBS  WTBS  IDAS  WTAS
    'SUMITUBE C4' => [ 4.6 , 0.2 , 2.3, 0.4 ],
    'SUMITUBE C5' => [ 5.6 , 0.2 , 2.9, 0.4 ],
    'SUMITUBE C6' => [ 6.5 , 0.25, 3.5, 0.5 ],
    'SUMITUBE C8' => [ 8.5 , 0.25, 4.7, 0.5 ],
    'SUMITUBE C10'=> [ 10.5, 0.25, 6.0, 0.5 ],
    'SUMITUBE C12'=> [ 12.4, 0.3 , 7.6, 0.6 ],

    # SKYGOD(一部)
    # model         IDBS  WTBS  IDAS  WTAS
    'SKYGOD 4'  => [ 4.5 , 0.25, 2.0 , 0.46 ],
    'SKYGOD 4.5'=> [ 5.0 , 0.25, 2.25, 0.50 ],
    'SKYGOD 5'  => [ 5.5 , 0.25, 2.5 , 0.50 ],
    'SKYGOD 5.5'=> [ 6.0 , 0.25, 2.75, 0.50 ],
    'SKYGOD 6'  => [ 6.5 , 0.28, 3.0 , 0.56 ],
    'SKYGOD 6.5'=> [ 7.0 , 0.28, 3.25, 0.56 ],
    'SKYGOD 7'  => [ 7.5 , 0.30, 3.5 , 0.58 ],
    'SKYGOD 8'  => [ 8.5 , 0.30, 4.0 , 0.60 ],
    'SKYGOD 9'  => [ 9.5 , 0.30, 4.5 , 0.60 ],
    'SKYGOD 10' => [ 10.5, 0.30, 5.0 , 0.60 ],
    'SKYGOD 11' => [ 11.5, 0.30, 5.5 , 0.60 ],
    'SKYGOD 12' => [ 12.5, 0.30, 6.0 , 0.60 ],

    # シリコンチューブもいけるか?
    # IDBS, WTBSは適当
    'TUBE 3x6' => [ 4.5, 1.50, 3.0, 1.50 ],
    'TUBE 3x7' => [ 4.5, 2.00, 3.0, 2.00 ],
    'TUBE 4x6' => [ 5.0, 1.00, 4.0, 1.00 ],
    'TUBE 4x7' => [ 5.0, 1.50, 4.0, 1.50 ],
    'TUBE 5x7' => [ 6.0, 1.00, 5.0, 1.00 ],

);

sub min{
    my $a = shift;
    my $b = shift;
    $a <= $b? $a: $b;
}

sub sqr{
    my $a = shift;
    $a*$a;
}

# 収縮させたときの外径を求める。内径が決まっている場合。
# 長さ方向に変化しない、かつ密度が変化しないと仮定。
# つまり面積が変わらないとして計算する。
# shrinkage rate: 最も縮んだ状態を1とする
sub estimate_od{
    my $model = shift;
    my $id = shift;
    my $safe_factor = shift || [1, 1];
    my ($sf_l, $sf_u) = @$safe_factor; 
    my $spec = $TUBE_LIST{$model};
    if ( !$spec ) {
        warn "unknown model '$model'.";
        return ();
    }
    my( $id_before_shrinkage,
        $wall_thickness_before_shrinkage,
        $id_after_full_shrinkage,
        $wall_thickness_after_full_shrinkage ) = @$spec;
    if($id < $id_after_full_shrinkage*$sf_l
    || $id > $id_before_shrinkage*$sf_u ) {
        return ();
    }
    my $od_after_full_shrinkage =
        $id_after_full_shrinkage
        +2*$wall_thickness_after_full_shrinkage;
    my $od = sqrt(
        sqr($od_after_full_shrinkage)
        - sqr($id_after_full_shrinkage)
        + sqr($id));
    my $wall_thickness = ($od - $id) / 2;
    my $shrinkage_rate = $id / $id_after_full_shrinkage;
    return ($od, $wall_thickness, $shrinkage_rate) ;
}

# 収縮させたときの内径を求める。外径が決まっている場合。
# 長さ方向に変化しない、かつ密度が変化しないと仮定。
# つまり面積が変わらないとして計算する。
sub estimate_id{
    my $model = shift;
    my $od = shift;
    my $safe_factor = shift || [1, 1];
    my ($sf_l, $sf_u) = @$safe_factor; 
    my $spec = $TUBE_LIST{$model};
    if ( !$spec ) {
        warn "unknown model '$model'.";
        return ();
    }
    my( $id_before_shrinkage,
        $wall_thickness_before_shrinkage,
        $id_after_full_shrinkage,
        $wall_thickness_after_full_shrinkage ) = @$spec;
    my $od_after_full_shrinkage =
        $id_after_full_shrinkage
        +2*$wall_thickness_after_full_shrinkage;
    my $id = sqrt(
        sqr($od)
        - sqr($od_after_full_shrinkage)
        + sqr($id_after_full_shrinkage));
    if($id < $id_after_full_shrinkage*$sf_l
    || $id > $id_before_shrinkage*$sf_u ) {
        return ();
    }
    my $wall_thickness = ($od - $id) / 2;
    my $shrinkage_rate = $id / $id_after_full_shrinkage;
    return ($id, $wall_thickness, $shrinkage_rate) ;
}


#
# ID => 4, 
# OD => 7.5,
# tolerance => 0.05
# max_nesting_level => 3
# tube_selection => [],
# safe_factor_h => [ 1.2, 0.9 ],
# number_of_result => 5,
#
sub tube_selector{
    my $param = {@_};
    my $max_nesting_level = $param->{max_nesting_level} || 4;
    my $adapter_id = $param->{ID} || die"ID!";
    my $adapter_od_min = $param->{OD_MIN} || die "OD_MIN";
    my $adapter_od_max = $param->{OD_MAX} || die "OD_MAX";
    my $tube_selection = $param->{tube_selection} || die"tube_selection";
    my $safe_factor = $param->{safe_factor} || [1.2, 0.9];

    my @result = ();

    # 1段重ねたとき
    # 内側から計算する
    my $nesting;
    $nesting = sub{
        my $nesting_level = shift; # 重ね合わせ数
        my $id = shift; # フィットさせる内径
        my $combination = shift; # 重ね合わせたチューブの組み合わせ
        if ($nesting_level > $max_nesting_level) {
            return;
        }
        # spec
        for my $model (@$tube_selection) {
            my @r = estimate_od( $model, $id, $safe_factor );
            my ($od, $wt, $sr) = estimate_od( $model, $id, $safe_factor );
            if (!$od) {
                next;
            }
            my $new_combination = [@$combination,
                $model . sprintf(" (%3.1f)", $sr)
            ];
            if ($od >= $adapter_od_min && $od <= $adapter_od_max ) {
                push @result, [ $od, $new_combination ];
            }
            &$nesting( $nesting_level+1, $od, $new_combination );
        }
    };

    &$nesting( 1, $adapter_id, [] );

    @result = sort { $a->[0] <=> $b->[0] } @result;

    for my $e (@result) {
        print '  * ',
            sprintf("%4.2f", $e->[0]), ': ',
            join(', ', @{$e->[1]}), "\n";
    }

}

my $tube_selection = [

    'SUMITUBE C4',
    'SUMITUBE C5',
    'SUMITUBE C6',
    'SUMITUBE C8',
    'SUMITUBE C10',
    'SUMITUBE C12',

    'SKYGOD 4',
    'SKYGOD 4.5',
    'SKYGOD 5',
    'SKYGOD 5.5',
    'SKYGOD 6',
    'SKYGOD 7',
    'SKYGOD 8',
    'SKYGOD 9',
    'SKYGOD 10',
    'SKYGOD 11',
    'SKYGOD 12',
];

print "==== LUER(4mm) -> 1mL tip(7.5mm) ===\n";
tube_selector(
    ID => 4,
    OD_MIN => 7.45,
    OD_MAX => 7.55,
    tube_selection => $tube_selection,
    max_nesting_level => 4,
    safe_factor => [1.2, 0.9],
);

print "\n==== LUER(4mm) -> 200ul tip(5mm) ===\n";
tube_selector(
    ID => 4,
    OD_MIN => 4.8,
    OD_MAX => 5.2,
    tube_selection => $tube_selection,
    max_nesting_level => 2,
    safe_factor => [1.1, 0.9],
);

sub estimate_and_print{
    my $model = shift;
    my $id = shift;
    print "$model/id=$id => ";
    my ($od, $wt, $sr) = estimate_od( $model, $id );
    if (!$od ) {
        print "-\n";
    } else {
        print sprintf("od=%6.2f, wt=%6.2f, sr=%6.2f\n", $od, $wt, $sr);
    }
}

print "\n==== Tube 3x7 -> 4 ====\n";
estimate_and_print( 'TUBE 3x7', 4, );