Get me back down to 1 rep!
Mathematica, 302 bytes

Golfed version:

Unprotect@Null;Null=0;f[1,_,_,_]={,,,,};f[r_,a_,n_,d_]:=(f[r,a,n,d]=l={∞,,,,};f[r,a,n,d]=#&amp;@@MinimalBy[{If[r&gt;74,{,,,,1}+f[r-50Min[⌈r/50⌉-1,10],a,n,d],l],If[r&gt;124,{,,1,,}+f[r-1,a,n,d+1],l],If[d&gt;0,{,,,1,}+f[r+1,a,n,d-1],l],If[a&gt;0,{,1,,,}+f[r-2,a-1,n+1,d],l],If[n&gt;0,{1,,,,}+f[r+2,a+1,n-1,d],l]},Tr])


Normal version:

Unprotect@Null; Null = 0;
f[1, _, _, _] = {, , , ,};
l = {\[Infinity], , , ,};
f[r_, a_, n_, d_] := (
  f[r, a, n, d] = l;
  f[r, a, n, d] = # &amp; @@ MinimalBy[{
      If[r &gt; 74, {, , , , 1} + 
        f[r - 50 Min[\[LeftCeiling]r/50\[RightCeiling] - 1, 10], a, n,
          d], l],
      If[r &gt; 124, {, , 1, ,} + f[r - 1, a, n, d + 1], l],(* 
      downvote one more *)
      If[d &gt; 0, {, , , 1,} + f[r + 1, a, n, d - 1], l],
      (* un-downvote *)
      If[a &gt; 0, {, 1, , ,} + f[r - 2, a - 1, n + 1, d], l],
      (* un-accept. -2 rep *)
      If[n &gt; 0, {1, , , ,} + f[r + 2, a + 1, n - 1, d], l]
      (* accept. +2 rep *)
      }, Tr]
  )


Note:


Test this on https://sandbox.open.wolframcloud.com/ - paste the code, press Shift+Enter, then enter f[101,3,2,10] for example for first test case, then press Shift+Enter.
Use Block[{Null=0}, ...] can save some bytes, but I haven't test that.
Sometimes $IterationLimit=$RecursionLimit=∞ is necessary to get correct result.
The function will return {∞,0,0,0,0} or similar (that is, the sum of elements in list is infinite) when it is impossible, and a list with format similar to that in the sample output when it is possible.