12
$\begingroup$

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:

enter image description here

$\endgroup$
2
  • $\begingroup$ Shouldn't bubbles go up ? $\endgroup$ – Artes Jan 10 '13 at 16:37
  • 1
    $\begingroup$ @Artes: Tilt head 90 degrees? $\endgroup$ – murray Jan 10 '13 at 19:01
14
$\begingroup$
dTagged =
  MapAt[
    Style[#, Red] &,
    Rest @ d,
    Position[Differences @ d, _Integer?Positive]
  ] ~Prepend~ First[d];

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

Mathematica graphics

$\endgroup$
8
$\begingroup$

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]

enter image description here

Using Clock:

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

enter image description here

$\endgroup$
0
0
$\begingroup$

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]]

enter image description here

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}]

enter image description here

..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}]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.