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 => $actValue}; $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 %usedCounts; 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 => $pair->{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 both # 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, $insertPoint]; if ($target - $prev < $next - $target) { --$insertPoint; } } return $resistorValues[$insertPoint]; }