Visual Thinking

Counting and Categorizing with Mathematica 6

Christopher Haydock

Applied New Science LLC

With[{starttime=AbsoluteTime["Sat 13 Oct 2007 13:30:00"],endtime=AbsoluteTime["Sat 13 Oct 2007 14:00:00"],ϵ=1/10},With[{g=Graphics[#,PlotRange->{{-1-ϵ,1+ϵ},{-1-ϵ,1+ϵ}},AspectRatio->1,ImageSize->64]&,f={Style[Disk[],Cyan],Style[Text[#,{0,-ϵ}],36,FontFamily->"Helvetica",Bold,Pink]}&},
Dynamic[Refresh[Which[AbsoluteTime[]-starttime≤0,g[f["BT"]],AbsoluteTime[]-endtime<0,g[{Red,Disk[{0,0},1,{Pi/2,Pi/2+((AbsoluteTime[]-starttime)/(endtime-starttime))2Pi}]}],True,g[f["AT"]]],UpdateInterval->10]]]]

Set Containing Itself

rule90periodNKSbookpage951[n_Integer]:=2^MultiplicativeOrder[2,n,{1,-1}]-1;
normalizedmarketpricesNKSbookpage432[initial_?(Union[#]==={0,1}&)]:=Module[{markettrades,marketpricechanges,normalizedmarketpricechanges},markettrades=CellularAutomaton[90,initial,rule90periodNKSbookpage951[Length[initial]]-1]/. 0->-1;
marketpricechanges=Apply[Plus,markettrades,{1}];
normalizedmarketpricechanges=marketpricechanges-Plus@@marketpricechanges/Length[marketpricechanges];
FoldList[Plus,0,Most[normalizedmarketpricechanges]]]/;initial===CellularAutomaton[90,initial,{{{rule90periodNKSbookpage951[Length[initial]]}}}];
Grid[{{With[{initialmarkettradesNKSbookpage432 = {1,0,1,0,1,1,1,0,1,0,0,0,0,1,1,1,0,1,0,1,0,0,0,1,0,1,0,0,0,0,1,0,0,0,1}},
With[{marketprices=normalizedmarketpricesNKSbookpage432[initialmarkettradesNKSbookpage432/.{1->0,0->1}],numberfouriertermspreserved=512},
With[{timeseries=FourierDST[PadRight[Take[FourierDST[marketprices/100],numberfouriertermspreserved],Length[marketprices],0],3]},
DynamicModule[{step=0},
Dynamic[step=step+1;
iconSRP[step,timeseries]],Initialization:>(iconSRP[step_,timeseries_]:=Grid[{{Magnify[Framed[Graphics[{Black,Thickness[Large],Apply[{Opacity[#1],Circle[{0,0},#2]}&,selfreferentialpredicate[timeseries[[Mod[step,Length[timeseries],1]]],0.3,1.5,0,2],{1}]},PlotRange->Exp[1],ImageSize->64]],6.8]},{Graphics[Style[Text[Dynamic[step]],36,FontFamily->"Courier"],ImageSize->{Automatic,36}]}}];selfreferentialpredicate[logarithmmagnification_,interobjectseparation_,opacityhalfwidth_,opacityoffset_,opacityexponent_]:=Module[{objects,opacitypeakposition,opacityleftpiece,opacityrightpiece},objects=interobjectseparation* Range[Ceiling[(-opacityhalfwidth-logarithmmagnification)/interobjectseparation],Floor[(opacityhalfwidth-logarithmmagnification)/interobjectseparation]]+logarithmmagnification;
(* The opacity offset should be in the range ±1. *)
opacitypeakposition=opacityhalfwidth*opacityoffset;
opacityleftpiece=opacityhalfwidth*(opacityoffset+1);
opacityrightpiece=opacityhalfwidth*(1-opacityoffset);
(* The objects are output as ordered pairs of opacity and radius. *)
objects={(1-If[#≥opacitypeakposition,(#-opacitypeakposition)/opacityrightpiece,(opacitypeakposition-#)/opacityleftpiece])^opacityexponent,Exp[#]}&/@objects])]]]],With[{starttime=AbsoluteTime["Sat 13 Oct 2007 13:30:00"],endtime=AbsoluteTime["Sat 13 Oct 2007 14:00:00"],ϵ=1/10},With[{g=Graphics[#,PlotRange->{{-1-ϵ,1+ϵ},{-1-ϵ,1+ϵ}},AspectRatio->1,ImageSize->64]&,f={Style[Disk[],Cyan],Style[Text[#,{0,-ϵ}],36,FontFamily->"Helvetica",Bold,Pink]}&},
Dynamic[Refresh[Which[AbsoluteTime[]-starttime≤0,g[f["BT"]],AbsoluteTime[]-endtime<0,g[{Red,Disk[{0,0},1,{Pi/2,Pi/2+((AbsoluteTime[]-starttime)/(endtime-starttime))2Pi}]}],True,g[f["AT"]]],UpdateInterval->10]]]]}}]

Russell’s Paradox

The predicates x ∈ x and x ∉ x play a central role in Russell’s Paradox.  How might these be represented visually?  The  x ∉ x predicate is easy.  This is represented as an open circle, possibly inside this circle are more open circles representing other sets that are elements of the set (or class) x.  The  x ∈ x predicate perhaps invites a bit more whimsical picture.  Because the x in x ∈ x is both on the left side the element within itself and on the right side the set containing itself, it seems plausible to suppose that the left x must contain yet another “copy” of itself and the right x must be an element of still yet another “copy” of itself.  Symbolically this looks like the transformation:

	x ∈ x    ⟶    x ∈ x ∈ x ∈ x,

where the original predicate is indicated in bold and the added predicates on each end are show in gray.  The repetition of this transformation adds more copies of the these predicates at each end of the growing expression and can be indicated with ellipses:

	x ∈ x ∈ x ∈ x    ⟶    …  x ∈ x ∈ x ∈ x …    ⟶    … .

This is the idea behind the dynamic visual representation of the  x ∈ x predicate.

NKS Financial System

Grid[{{With[{initialmarkettradesNKSbookpage432 = {1,0,1,0,1,1,1,0,1,0,0,0,0,1,1,1,0,1,0,1,0,0,0,1,0,1,0,0,0,0,1,0,0,0,1}},With[{stepmodulus=64,stepoffset=1,pricemodulus=250,priceoffsetdoublenegativehack=150,diskradius=0.05,numberpricepointssmooth=8},
With[{coordinatefunction={Mod[(#1-stepoffset)/stepmodulus,1],Mod[(#2+priceoffsetdoublenegativehack)/pricemodulus,1]}&},
DynamicModule[{step=0,total=0,cellblock=CellularAutomaton[90,initialmarkettradesNKSbookpage432,numberpricepointssmooth-1],marketprice},
Magnify[Grid[{{Dynamic[Refresh[ArrayPlot[Transpose[Last[{step,total,cellblock}={step+1,total+Plus@@(First[cellblock]/. 0->-1),Append[Rest[cellblock],CellularAutomaton[90,Last[cellblock]]]}]]],TrackedSymbols->{step}]],Graphics[Rotate[Style[Text[Dynamic[Round[marketprice=N[total+Dot[Range[Length[cellblock],1,-1],Apply[Plus,cellblock/. 0->-1,{1}]]/Length[cellblock]]]]],18,FontFamily->"Courier"],π/2],ImageSize->{18,Automatic}],Graphics[{Rectangle[],White,Rectangle[{0.02,0.02},{0.98,0.98}],Black,Opacity[1/3],Dynamic[Disk[coordinatefunction@@{step+(numberpricepointssmooth-1)/2,marketprice},diskradius]],Opacity[1],PointSize[Medium],Dynamic[Point[Apply[coordinatefunction,Transpose[{Range[step,step+numberpricepointssmooth-1],Rest[FoldList[Plus,total,Apply[Plus,cellblock/. 0->-1,{1}]]]}],{1}]]]},PlotRange->{{0,1},{0,1}},ImageSize->215]},
{Null,Null,Graphics[Style[Text[Dynamic[step]],18,FontFamily->"Courier"],ImageSize->{Automatic,18}]}}],2.0]]]]],With[{starttime=AbsoluteTime["Sat 13 Oct 2007 13:30:00"],endtime=AbsoluteTime["Sat 13 Oct 2007 14:00:00"],ϵ=1/10},With[{g=Graphics[#,PlotRange->{{-1-ϵ,1+ϵ},{-1-ϵ,1+ϵ}},AspectRatio->1,ImageSize->64]&,f={Style[Disk[],Cyan],Style[Text[#,{0,-ϵ}],36,FontFamily->"Helvetica",Bold,Pink]}&},
Dynamic[Refresh[Which[AbsoluteTime[]-starttime≤0,g[f["BT"]],AbsoluteTime[]-endtime<0,g[{Red,Disk[{0,0},1,{Pi/2,Pi/2+((AbsoluteTime[]-starttime)/(endtime-starttime))2Pi}]}],True,g[f["AT"]]],UpdateInterval->10]]]]}}]

Spikes Remain after Randomness Removed

The simple NKS financial market model is described in the NKS book on page 432 and in Jason Cawley’s lecture “NKS Time Series,” see http://www.wolframscience.com/conference/2007/presentations/materials/cawley.nb .  The period (q) of a rule 90 cellular automata with n = 35 cells and cyclic boundary conditions is given by the formula on page 951 of the NKS book notes for the Chapter 6 section Systems of Limited Size and Class 2 Behavior:
	q[n] = 2^MultiplicativeOrder[2, n, {1, –1}] – 1
It is possible that the initial cellular automata state will never repeat and this fact can cause considerable confusion if an attempt is made to verify the period by searching for the first repetition of the initial state.  For the initial state in the NKS book it turns out that the complement of the initial state is repeated rather than the initial state itself.  Note also that this causes an oddball total for the initial state.

NKS Financial System

rule90periodNKSbookpage951[n_Integer]:=2^MultiplicativeOrder[2,n,{1,-1}]-1;
normalizedmarketpricesNKSbookpage432[initial_?(Union[#]==={0,1}&)]:=Module[{markettrades,marketpricechanges,normalizedmarketpricechanges},markettrades=CellularAutomaton[90,initial,rule90periodNKSbookpage951[Length[initial]]-1]/. 0->-1;
marketpricechanges=Apply[Plus,markettrades,{1}];
normalizedmarketpricechanges=marketpricechanges-Plus@@marketpricechanges/Length[marketpricechanges];
FoldList[Plus,0,Most[normalizedmarketpricechanges]]]/;initial===CellularAutomaton[90,initial,{{{rule90periodNKSbookpage951[Length[initial]]}}}];
Grid[{{With[{initialmarkettradesNKSbookpage432 = {1,0,1,0,1,1,1,0,1,0,0,0,0,1,1,1,0,1,0,1,0,0,0,1,0,1,0,0,0,0,1,0,0,0,1}},With[{stepmodulus=64,stepoffset=1,pricemodulus=250,priceoffsetdoublenegativehack=150,diskradius=0.05,numberantialiased=20,marketprices=normalizedmarketpricesNKSbookpage432[initialmarkettradesNKSbookpage432/.{1->0,0->1}],numberfouriertermspreserved=512},
With[{marketpriceperiod=Length[marketprices],approximatemarketprices=FourierDST[PadRight[Take[FourierDST[marketprices],numberfouriertermspreserved],Length[marketprices],0],3],coordinatefunction={Mod[(#1-stepoffset)/stepmodulus,1],Mod[(#2+priceoffsetdoublenegativehack)/pricemodulus,1]}&,opacityfunctionfront=Opacity[(#+7#^10)/16]&,opacityfunctionback=Opacity[1-(#+7#^10)/16]&,modulustimesquotientplusoffset=(stepmodulus*Quotient[#,stepmodulus,stepoffset]+stepoffset)&},
With[{roundedapproxmarketprices=Round[approximatemarketprices],pointfunction=Function[{step,select},Disk[coordinatefunction@@{#,marketprices[[Mod[#,marketpriceperiod,1]]]},0.01]&/@Range[#+select*stepmodulus,#+(select+1)*stepmodulus-1]&[modulustimesquotientplusoffset[step]]],
opacitydiskfunction={opacityfunctionfront[First[#2]/numberantialiased],Disk[coordinatefunction[#1,approximatemarketprices[[Mod[#1,marketpriceperiod,1]]]],diskradius]}&,lastopacityfunction=opacityfunctionfront[With[{n=Min[numberantialiased,stepmodulus],i=Mod[#-stepoffset,stepmodulus]},Piecewise[{{1-i/n,i≤n},{0,n<i}}]]]&,
thisopacityfunction=opacityfunctionback[With[{n=Min[numberantialiased,Quotient[stepmodulus,2]],i=Mod[#-stepoffset,stepmodulus]},Piecewise[{{1-i/n,i≤ n},{0,n<i<stepmodulus-n},{1-(stepmodulus-i)/n,stepmodulus-n≤i}}]]]&,
nextopacityfunction=opacityfunctionfront[With[{n=Min[numberantialiased,stepmodulus],i=Mod[#-stepoffset,stepmodulus]},Piecewise[{{0,i≤stepmodulus-n},{1-(stepmodulus-i)/n,stepmodulus-n<i}}]]]&},
DynamicModule[{step=stepoffset,lastpriceset,thispriceset,nextpriceset,blink=0},Magnify[Grid[{{Graphics[Rotate[Style[Text[Dynamic[roundedapproxmarketprices[[Mod[step,marketpriceperiod,1]]]]],21,FontFamily->"Courier"],π/2],ImageSize->{21,Automatic}],Graphics[{Rectangle[],White,Rectangle[{0.02,0.02},{0.98,0.98}],Black,Dynamic[MapIndexed[opacitydiskfunction,Range[step-numberantialiased+1,step]]],Dynamic[lastopacityfunction[step]],Dynamic[Refresh[blink;
lastpriceset=pointfunction[step,-1],TrackedSymbols->{blink}]],Dynamic[thisopacityfunction[step]],Dynamic[Refresh[blink;thispriceset=pointfunction[step,0],TrackedSymbols->{blink}]],Dynamic[nextopacityfunction[step]],Dynamic[Refresh[blink;nextpriceset=pointfunction[step,1],TrackedSymbols->{blink}]]},PlotRange->{{0,1},{0,1}},ImageSize->255],Invisible[Dynamic[Refresh[If[Mod[step=step+1,stepmodulus,stepoffset]==stepoffset,blink=blink+1,blink=blink],TrackedSymbols->{},UpdateInterval->1/10]]]},{Null,Graphics[Style[Text[Dynamic[step]],21,FontFamily->"Courier"],ImageSize->{Automatic,21}],Null}},Spacings->{0,1/2}],1.75]]]]]],With[{starttime=AbsoluteTime["Sat 13 Oct 2007 13:30:00"],endtime=AbsoluteTime["Sat 13 Oct 2007 14:00:00"],ϵ=1/10},With[{g=Graphics[#,PlotRange->{{-1-ϵ,1+ϵ},{-1-ϵ,1+ϵ}},AspectRatio->1,ImageSize->64]&,f={Style[Disk[],Cyan],Style[Text[#,{0,-ϵ}],36,FontFamily->"Helvetica",Bold,Pink]}&},
Dynamic[Refresh[Which[AbsoluteTime[]-starttime≤0,g[f["BT"]],AbsoluteTime[]-endtime<0,g[{Red,Disk[{0,0},1,{Pi/2,Pi/2+((AbsoluteTime[]-starttime)/(endtime-starttime))2Pi}]}],True,g[f["AT"]]],UpdateInterval->10]]]]}}]

Time Antialiasing

Time antialiasing is applied to both the original market price time series (small dots) and the smoothed version of this time series (medium size disk).  The original time series is only updated after a complete screenful of time steps has been smoothed, but the smoothed time series is show as a moving disk whose position is updated after every time step.  The time antialiasing fades in and out entire screenfuls.  The time antialiasing of the smoothed series leaves a fading trial of disks streaking across the screen.  It's as if the tendency of visual perception to blur fast moving objects has been amplified so that even relatively slow moving objects are blurred.

Mobile Pappus Chain

PappusChainGraphic[r_?(0<#<1&),h_]:=With[{maximuminscribedcircleinnerangle=7Pi/8},Module[{maximumimagecircleheight=(2 Tan[maximuminscribedcircleinnerangle/2])/r,imagecirclediameter=2(1-r)/r,imageheights},
imageheights=Range[Mod[h,imagecirclediameter,-maximumimagecircleheight],maximumimagecircleheight,imagecirclediameter];
Graphics[{Thickness[Small],Circle[{1,0},1],Circle[{r,0},r],Circle[{(4 (1+r))/(4+#^2 r),(4 # r)/(4+#^2 r)},(4-4 r)/(4+#^2 r)]&/@imageheights},ImageSize->360]]];
Grid[{{Animate[PappusChainGraphic[r,h],{{r,2/3,"Radius"},1/8,7/8,Appearance->"Labeled"},{{h,0,"Height"},-2,2,Appearance->"Labeled"},AnimationDirection->ForwardBackward,AnimationRunning->False,SaveDefinitions->True],With[{starttime=AbsoluteTime["Sat 13 Oct 2007 13:30:00"],endtime=AbsoluteTime["Sat 13 Oct 2007 14:00:00"],ϵ=1/10},With[{g=Graphics[#,PlotRange->{{-1-ϵ,1+ϵ},{-1-ϵ,1+ϵ}},AspectRatio->1,ImageSize->64]&,f={Style[Disk[],Cyan],Style[Text[#,{0,-ϵ}],36,FontFamily->"Helvetica",Bold,Pink]}&},
Dynamic[Refresh[Which[AbsoluteTime[]-starttime≤0,g[f["BT"]],AbsoluteTime[]-endtime<0,g[{Red,Disk[{0,0},1,{Pi/2,Pi/2+((AbsoluteTime[]-starttime)/(endtime-starttime))2Pi}]}],True,g[f["AT"]]],UpdateInterval->10]]]]}}]

Archimedes Arbelos

The  ancient Greek mathematician Archimedes was the first to identify the Arbelos and some of its properties.  The trick for efficiently computing the positions of pairwise tangent inscribed circles, or a Pappus Chain, is a modern invention:

ArbelosInversionGraphic[r_?(0<#<1&),h_]:=With[{
imagecirclecenter={(1+r)/r,h},
imagecircleradius=(1-r)/r,
imagediameterendpoints=If[h==0,{{2,0},{2/r,0}},{{((1+r) (h^3 r^2+h (1+r)^2-Sqrt[h^2 (-1+r)^2 (1+2 r+(1+h^2) r^2)]))/(h r (1+2 r+(1+h^2) r^2)),(h^3 r^2+h (1+r)^2-Sqrt[h^2 (-1+r)^2 (1+2 r+(1+h^2) r^2)])/(1+2 r+(1+h^2) r^2)},{((1+r) (h^3 r^2+h (1+r)^2+Sqrt[h^2 (-1+r)^2 (1+2 r+(1+h^2) r^2)]))/(h r (1+2 r+(1+h^2) r^2)),(h^3 r^2+h (1+r)^2+Sqrt[h^2 (-1+r)^2 (1+2 r+(1+h^2) r^2)])/(1+2 r+(1+h^2) r^2)}}],
inscribedcirclecenter={(4 (1+r))/(4+h^2 r),(4 h r)/(4+h^2 r)},
inscribedcircleradius=(4-4 r)/(4+h^2 r),
inscribedcircleendpoints=If[h==0,{{2,0},{2r,0}},{{(4 h r (1+r))/(h^3 r^2+h (1+r)^2-Sqrt[h^2 (-1+r)^2 (1+2 r+(1+h^2) r^2)]),(4 h^2 r^2)/(h^3 r^2+h (1+r)^2-Sqrt[h^2 (-1+r)^2 (1+2 r+(1+h^2) r^2)])},{(4 h r (1+r))/(h^3 r^2+h (1+r)^2+Sqrt[h^2 (-1+r)^2 (1+2 r+(1+h^2) r^2)]),(4 h^2 r^2)/(h^3 r^2+h (1+r)^2+Sqrt[h^2 (-1+r)^2 (1+2 r+(1+h^2) r^2)])}}],
innercircletangentpoint={(8 r)/(4+h^2 r^2),(4 h)/(h^2+4/r^2)},
outercircletangentpoint={8/(4+h^2),(4 h)/(4+h^2)},
ϵ=1/10},
Graphics[{
(* x axis, y axes, and origin *)
Style[Line[{{{-1/ϵ,0},{1/ϵ,0}},{{0,-1/ϵ},{0,1/ϵ}}}],Thin],Style[Point[{0,0}],PointSize[Medium]],
(* Inversion reference circle *)
Style[Circle[{0,0},2],Dotted,Thickness[Medium]],
(* Arbelos circles *)
Circle[{1,0},1],Point[{1,0}],Circle[{r,0},r],Point[{r,0}],
(* Arbelos circles’ inversion images *)
Line[{{2,-1/ϵ},{2,1/ϵ}}],Line[{{2/r,-1/ϵ},{2/r,1/ϵ}}],
(* x axis lables *)
Inset[Style["0",12,FontFamily->"Helvetica"],{0,0},{0,3/2},Background->RGBColor[1,1,1,1/2]],
Inset[Style["r",12,FontFamily->"Helvetica"],{r,0},{0,3/2},Background->RGBColor[1,1,1,1/2]],
Inset[Style["1",12,FontFamily->"Helvetica"],{1,0},{0,3/2},Background->RGBColor[1,1,1,1/2]],
Inset[Style["2r",12,FontFamily->"Helvetica"],{2 r,0},{0,3/2},Background->RGBColor[1,1,1,1/2]],
Inset[Style["2",12,FontFamily->"Helvetica"],{2,0},{0,3/2},Background->RGBColor[1,1,1,1/2]],
Inset[Style["2/r",12,FontFamily->"Helvetica"],{2/r,0},{0,3/2},Background->RGBColor[1,1,1,1/2]],
(* Inscribed circle’s inversion image and height *)
Circle[imagecirclecenter,imagecircleradius],Point[imagecirclecenter],
Style[Line[{{2-ϵ,h},{2/r+ϵ,h}}],Thin],
Inset[Style["h",12,FontFamily->"Helvetica"],{2/r,h},{-3/2,0}],
(* Inscribed circle *)
Circle[inscribedcirclecenter,inscribedcircleradius],Point[inscribedcirclecenter],
(* Diameter secant line *)
Style[Line[{{0,0},imagediameterendpoints[[Sign[h]/.{1->2,0->2,-1->1}]]}],Blue],
Style[Point[Join[imagediameterendpoints,inscribedcircleendpoints]],PointSize[Medium],Blue,Opacity[2/3]],
(* Tangent points *)
Style[Line[{{{0,0},{2/r,h}},{{r,0},inscribedcirclecenter}}],Blue,Opacity[1/3]],
Style[Point[{{2/r,h},innercircletangentpoint}],PointSize[Medium],Blue,Opacity[1/3]],
Style[Line[{{{0,0},{2,h}},{{1,0},outercircletangentpoint}}],Blue,Opacity[1/3]],
Style[Point[{{2,h},outercircletangentpoint}],PointSize[Medium],Blue,Opacity[1/3]]},PlotRange->{{-ϵ,4+ϵ},{-2-ϵ,2+ϵ}},ImageSize->511]];
Manipulate[ArbelosInversionGraphic[r,h],{{r,2/3,"r"},1/8,7/8,Appearance->"Labeled"},{{h,3/2,"h"},-3,3,Appearance->"Labeled"},SaveDefinitions->True]

Workshop Method Lite

How do you use or see yourself using Mathematica for visual thinking?

Grid[{{With[{numbercards=32},
DynamicModule[{p=Table[{0,0},{numbercards}]},Graphics[Table[With[{i=i},{Locator[Dynamic[p[[i]]],None],Inset[InputField["",String,FieldSize->{{2,8},{1,Infinity}},BaseStyle->{Black,Bold,Medium,FontFamily->"Helvetica"}],Dynamic[p[[i]]]]}],{i,numbercards}],PlotRange->1,ImageSize-> 470]]],With[{starttime=AbsoluteTime["Sat 13 Oct 2007 13:30:00"],endtime=AbsoluteTime["Sat 13 Oct 2007 14:00:00"],ϵ=1/10},With[{g=Graphics[#,PlotRange->{{-1-ϵ,1+ϵ},{-1-ϵ,1+ϵ}},AspectRatio->1,ImageSize->64]&,f={Style[Disk[],Cyan],Style[Text[#,{0,-ϵ}],36,FontFamily->"Helvetica",Bold,Pink]}&},
Dynamic[Refresh[Which[AbsoluteTime[]-starttime≤0,g[f["BT"]],AbsoluteTime[]-endtime<0,g[{Red,Disk[{0,0},1,{Pi/2,Pi/2+((AbsoluteTime[]-starttime)/(endtime-starttime))2Pi}]}],True,g[f["AT"]]],UpdateInterval->10]]]]}}]

({{, BTAT}})

Timer Demonstration

With[{timecheck=DateList[]},With[{starttime=AbsoluteTime[timecheck/.{ymdhm__,s_}:>{ymdhm,s+1.2}],endtime=AbsoluteTime[timecheck/.{ymdhm__,s_}:>{ymdhm,s+11.2}],ϵ=1/10},
With[{g=Graphics[#,PlotRange->{{-1-ϵ,1+ϵ},{-1-ϵ,1+ϵ}},AspectRatio->1,ImageSize->64]&,f={Style[Disk[],Cyan],Style[Text[#,{0,-ϵ}],36,FontFamily->"Helvetica",Bold,Pink]}&},Dynamic[Refresh[Which[AbsoluteTime[]-starttime≤0,g[f["BT"]],AbsoluteTime[]-endtime<0,g[{Red,Disk[{0,0},1,{Pi/2,Pi/2+((AbsoluteTime[]-starttime)/(endtime-starttime))2Pi}]}],True,g[f["AT"]]],UpdateInterval->1]]]]]