use strict;
use warnings;
use Text::CSV qw(csv);
use List::BinarySearch;

my $maxInValue     = 255;                            # Generate 8 bit 
+ADC values
my $minResistance  = 300;
my $maxResistance  = 100e3;
my %unitMul        = (kOhms => 1.0e3, Ohms => 1.0,);
my $rFileName      = 'resistorSeries.csv';
my @rows           = @{csv(in => $rFileName, headers => "auto")};
my @resistorValues = @rows;
my %rowByValue;

# Pull out resistor values
for my $rowIdx (0 .. $#rows) {
    my $row = $rows[$rowIdx];
    my ($resistance, $units) = split ' ', $row->{Resistance};

    die "Can't scale by $units\n" if !exists $unitMul{$units};
    $resistorValues[$rowIdx] = $resistance * $unitMul{$units};
    $rowByValue{$resistorValues[$rowIdx]} //= $row;
}

# Make sure we only have one instance of each resistor value
my %unique = map {$_ => 1} @resistorValues;

@resistorValues = keys %unique;
@resistorValues =
    grep {$_ >= $minResistance && $_ < $maxResistance} @resistorValues
+;
@resistorValues = sort {$a <=> $b} @resistorValues;

# Target values 0 and 255 are special cases so exclude those.
my @targets       = map {{target => $_, pairs => []}} 1 .. $maxInValue
+ - 1;
my %targetByValue = map {$targets[$_]->{target} => $_} 0 .. $#targets;
my %usedCounts;
my $worstBestErr = 0.0;

# Find all the ways we can get close to each target value
for my $wanted (@targets) {
    my $values     = $wanted->{pairs}      //= [];
    my $usedValues = $wanted->{usedValues} //= {};

    # $ratio = Vin / Vout = 255 / target
    my $ratio = $maxInValue / $wanted->{target};

    for my $r2 (@resistorValues) {
        my $tryR1 = ($ratio - 1) * $r2;

        next if $tryR1 < $resistorValues[0];
        last if $tryR1 > $resistorValues[-1];

        my $r1       = nearestR($tryR1);
        my $actValue = 255 * $r2 / ($r2 + $r1);
        my $err      = abs($wanted->{target} - $actValue);

        push @$values, {r1 => $r1, r2 => $r2, err => $err, value => $a
+ctValue};
        $usedValues->{$r1} = $values->[-1];
        $usedValues->{$r2} = $values->[-1];
    }

    # Sort values by error
    @$values      = sort {$a->{err} <=> $b->{err}} @$values;
    $worstBestErr = $values->[0]{err} if $worstBestErr < $values->[0]{
+err};
}

# Count number of uses of each resistor value used
for my $target (@targets) {
    my $values = $target->{pairs};

    # Eliminate any pairings with a worse error than $worstBestErr
    @$values = grep {$_->{err} <= $worstBestErr} @$values;

    for my $value (@$values) {
        ++$usedCounts{$value->{r1}};
        ++$usedCounts{$value->{r2}};
    }
}

# Select resistor pairings
my $valuesCount      = keys %usedCounts;
my %missingTargetIdx = map {$_ => 1} 0 .. $maxInValue - 2;
my @rByCount = sort {$usedCounts{$b} <=> $usedCounts{$a}} keys %usedCo
+unts;
my %usedR;
my %targetPairs;

while (keys %missingTargetIdx) {
    if (!@rByCount) {
        die "Can't generate pairings for: @{[keys %missingTargetIdx]}\
+n";
    }

    my $targetR = shift @rByCount;
    my @matches;

    # Find all target values that use the current target resistor
    for my $targetIdx (keys %missingTargetIdx) {
        my $target = $targets[$targetIdx];
        my $value  = $target->{target};

        for my $pair (@{$target->{pairs}}) {
            next if $pair->{r1} != $targetR && $pair->{r2} != $targetR
+;

            push @matches,
                {targetIdx => $targetIdx, r1 => $pair->{r1}, r2 => $pa
+ir->{r2}};
            $targetPairs{$target->{target}} =
                [$pair->{r1}, $pair->{r2}, $pair->{value}, $pair->{err
+}];
            last;
        }
    }

    next if !@matches;

    # Remove targets we've just found from %missingTargets and add bot
+h
    # resistors in each target pair to %usedR
    for my $match (@matches) {
        ++$usedR{$match->{r1}};
        ++$usedR{$match->{r2}};
        delete $missingTargetIdx{$match->{targetIdx}};
    }

    # See if there are any other targets that are satisfied by %usedR 
+values
    for my $targetIdx (keys %missingTargetIdx) {
        my $target = $targets[$targetIdx];
        my $used   = $target->{usedValues};

        for my $pairKey (keys %$used) {
            next
                if !exists $usedR{$used->{$pairKey}{r1}}
                || !exists $usedR{$used->{$pairKey}{r2}};

            $targetPairs{$target->{target}} = [
                $used->{$pairKey}{r1},    $used->{$pairKey}{r2},
                $used->{$pairKey}{value}, $used->{$pairKey}{err}
                ];
            ++$usedR{$used->{$pairKey}{r1}};
            ++$usedR{$used->{$pairKey}{r2}};
            delete $missingTargetIdx{$targetIdx};
            last;
        }
    }
}

# BOM report
my $bomCount  = keys %usedR;
my @bomValues = sort {$a <=> $b} keys %usedR;

print "$bomCount values used excluding 0 Ohm and 'DNF'\n";

for my $value (@bomValues) {
    my $row = $rowByValue{$value};

    printf "%5d: %15s\n", $value, $row->{"Manufacturer Part Number"};
}

# Resistor pairings report
my $maxZ = 0;
my $minR = 100000;

for my $pair (sort {$a <=> $b} keys %targetPairs) {
    my $r1        = $targetPairs{$pair}[0];
    my $r2        = $targetPairs{$pair}[1];
    my $r1t       = 1.001 * $targetPairs{$pair}[0];
    my $r1b       = 0.999 * $targetPairs{$pair}[0];
    my $r2t       = 1.001 * $targetPairs{$pair}[1];
    my $r2b       = 0.999 * $targetPairs{$pair}[1];
    my $topValue1 = 255 * $r2t / ($r2t + $r1b);
    my $botValue1 = 255 * $r2b / ($r2b + $r1t);
    my $topValue2 = 255 * $r2b / ($r2b + $r1b);
    my $botValue2 = 255 * $r2t / ($r2t + $r1t);
    my $topValue  = $topValue1 > $topValue2 ? $topValue1 : $topValue2;
    my $botValue  = $botValue1 < $botValue2 ? $botValue1 : $botValue2;
    my $span      = $topValue - $botValue;
    my $z         = 1 / (1 / $r1 + 1 / $r2);
    my $r         = $r1 + $r2;

    $maxZ = $z if $maxZ < $z;
    $minR = $r if $minR > $r;

    printf
        "%3d: R1 %5d, R2 %5d = %6.2f (err %5.3f: %6.2f - %6.2f = %4.2f
+), z = %.0f\n",
        $pair, @{$targetPairs{$pair}}, $botValue, $topValue, $span, $z
+;
}

printf "Max Z: %.0f, min R: %.0f\n", $maxZ, $minR;


sub nearestR {
    my ($target) = @_;
    my $insertPoint = List::BinarySearch::binsearch_pos {$a <=> $b}
    $target, @resistorValues;

    if ($insertPoint > 0) {
        my ($prev, $next) = @resistorValues[$insertPoint - 1, $insertP
+oint];

        if ($target - $prev < $next - $target) {
            --$insertPoint;
        }
    }

    return $resistorValues[$insertPoint];
}
[download]