Minimize distance between two lists

Question

Writing:

expectedresults = {4, 8, 5, 1, 4, 6, 4, 1, 9, 3};
achievedresults = {3, 6, 4, 2, 10, 7, 2, 4, 8, 4};
p1 = BarChart[expectedresults, ChartStyle -> Directive[Opacity[0.1], Blue]];
p2 = BarChart[achievedresults, ChartStyle -> Directive[Opacity[0.1], Red]];
Show[p1, p2]

I get:

On the other hand, if I write:

k = 0.83;
expectedresults = {4, 8, 5, 1, 4, 6, 4, 1, 9, 3};
achievedresults = {3, 6, 4, 2, 10, 7, 2, 4, 8, 4} k;
p1 = BarChart[expectedresults, ChartStyle -> Directive[Opacity[0.1], Blue]];
p2 = BarChart[achievedresults, ChartStyle -> Directive[Opacity[0.1], Red]];
Show[p1, p2]

I get:

where it is clear that, compared to the previous case, in some bars the gap has decreased and in others it has increased.

Question: How can I determine the best value of k to get the smallest possible gap?

---

Writing:

h = -0.35;
k = 0.83;
expectedresults = {4, 8, 5, 1, 4, 6, 4, 1, 9, 3};
achievedresults = h + k {3, 6, 4, 2, 10, 7, 2, 4, 8, 4};
p1 = BarChart[expectedresults, ChartStyle -> Directive[Opacity[0.1], Blue]];
p2 = BarChart[achievedresults, ChartStyle -> Directive[Opacity[0.1], Red]];
Show[p1, p2]

I get:

Question 2: is it possible to determine the pair of values h, k that minimize the gap?

Answer 1

Update: Using two parameters:

lmf2 = LinearModelFit[data, t, t];
Normal@lmf2

1.76563 + 0.546875 t

lmf2["BestFitParameters"]

{1.76563, 0.546875}

Fit[data, {1, t}, t]

1.76563 + 0.546875 t

ClearAll[h, k]
NMinimize[Total[Subtract[expectedresults, h + k achievedresults]^2], {h, k}]

{43.3594, {h -> 1.76562, k -> 0.546875}}

N @ LeastSquares[Thread[{1, achievedresults}], expectedresults]

{1.76563, 0.546875}

Original answer:

expectedresults = {4, 8, 5, 1, 4, 6, 4, 1, 9, 3};
achievedresults = {3, 6, 4, 2, 10, 7, 2, 4, 8, 4};
data = Transpose[{ achievedresults,expectedresults}];

You can use LinearModelFit or Fit or NMinimize or LeastSquares to get the value of k that minimizes the sum of squared distances between expectedresults and k achievedresults:

lmf = LinearModelFit[data, t, t, IncludeConstantBasis -> False]

Normal@lmf

0.828025 t

Normal @ LinearModelFit[{Transpose[{achievedresults}], expectedresults}]

0.828025 #1

Fit[data, {t}, t]

0.828025 t

ClearAll[k]
NMinimize[Total[Subtract[expectedresults, k achievedresults]^2], k]

{49.7134, {k -> 0.828025}}

N@LeastSquares[Thread[{achievedresults}], expectedresults]

{0.828025}

k = lmf["BestFitParameters"][[1]]

0.828025

p1 = BarChart[expectedresults, ChartStyle -> Directive[Opacity[0.1], Blue]];
p2 = BarChart[k achievedresults, ChartStyle -> Directive[Opacity[0.1], Red]];
Show[p1, p2]

BarChart[Transpose@{expectedresults, achievedresults,  k achievedresults}, 
 ChartStyle -> {Blue, Red, Green}, ChartLayout -> "Grouped", 
 ChartLegends -> {"expectedresults", "achievedresults", "k achievedresults"}]

Answer 2

{k, h} = PseudoInverse[{#, 1} & /@ achievedresults].expectedresults

{35/64, 113/64}