How can I highlight a moving bar in an animation of a bar chart?

Question

I wrote the following code, but I don't know how to highlight the moving bar.

bsort[list_] := 
 Module[{A = list, tmp}, 
  tmp = Reap[
     Do[If[A[[j]] > A[[j + 1]], 
       Sow[A]; {A[[j + 1]], A[[j]]} = {A[[j]], A[[j + 1]]}], {i, 
       Length@A}, {j, Length@A - i}]][[2, 1]];
  Append[tmp, A]]

d = bsort@RandomSample@Range@10;
ListAnimate[
 BarChart[#, ChartLabels -> Placed[Style[#, 15] & /@ #, Above]] & /@ d]

I want it to look like this:

Answer 1

dTagged =
  MapAt[
    Style[#, Red] &,
    Rest @ d,
    Position[Differences @ d, _Integer?Positive]
  ] ~Prepend~ First[d];

ListAnimate[
  BarChart[#, ChartLabels -> Placed[Style[#, 15] & /@ #, Above]] & /@ 
   dTagged
]

Answer 2

Modifying bsort to include style changes during Sowing:

bsort2[list_] :=  Module[{A = Style[#, GrayLevel[.6]] & /@ list, tmp}, 
 tmp = Reap[Do[If[First /@ (A[[j]] > A[[j + 1]]),
    Sow[ A /. (A[[j]] -> (A[[j]] /. GrayLevel[.6] -> Red))];
      {A[[ j + 1]], A[[j]]} = {A[[j]], A[[j + 1]]}],
   {i, Length@A}, {j, Length@A - i}]][[2, 1]]; Append[tmp, A]];
d2 = bsort2@RandomSample@Range[20];
opts = {ChartBaseStyle -> EdgeForm[White], BaseStyle -> (FontSize -> 14),
  AspectRatio -> 1, Frame -> False, Axes -> False, PlotRangePadding -> 2};

Using ListAnimate:

 ListAnimate[BarChart[Labeled[#, #, Above] & /@ #, opts] & /@ d2]

Using Clock:

Dynamic[BarChart[Labeled[#, #, Above] & /@ d2[[Clock[{1, Length[d2], 1}, 5, 1]]], opts]]

Answer 3

Dynamic content is already automatically generated when BarChart is rendered with the default PerformanceGoal->Quality so rather than reinvent the wheel you can modify the output.

d = RandomSample@Range@10;
tmp = BarChart[d, ChartLabels -> Placed[Style[#, 15] & /@ d, Above]]

Rather than use animators you can mouse over.

tmp /. x_EdgeForm :> FaceForm[RGBColor[1, 0, 0]]

or if you want to keep the edge form

tmp /. DynamicBox[{_, x_}] :> 
  DynamicBox[
   Flatten@{If[
      CurrentValue["MouseOver"], {FaceForm[RGBColor[1, 0, 0]], 
       EdgeForm[{GrayLevel[0.5`], AbsoluteThickness[1.5`], 
         Opacity[0.66`]}]}, {}, {}], x}]

..and if you want to automatically animate it all then:

ListAnimate@
 Table[With[{n = n}, 
   tmp /. DynamicBox[{_, x : RectangleBox[_, {_, z_}, ___]}] :> 
     DynamicBox[
      Flatten@{If[
         n == z, {FaceForm[RGBColor[1, 0, 0]], 
          EdgeForm[{GrayLevel[0.5`], AbsoluteThickness[1.5`], 
            Opacity[0.66`]}]}, {}, {}], x}]], {n, d}]