(*^ ::[paletteColors = 128; currentKernel; fontset = title, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, L3, e8, 24, "New York"; ; fontset = subtitle, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, e6, 18, "New York"; ; fontset = subsubtitle, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, e6, 14, "New York"; ; fontset = section, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, grayBox, M22, bold, a20, 14, "New York"; ; fontset = subsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, blackBox, M19, bold, a15, 12, "New York"; ; fontset = subsubsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, whiteBox, M18, bold, a12, 10, "New York"; ; fontset = text, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "New York"; ; fontset = smalltext, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 10, "New York"; ; fontset = input, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeInput, M42, N23, bold, 12, "Courier"; ; fontset = output, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, 12, "Courier"; ; fontset = message, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, R65535, 12, "Courier"; ; fontset = print, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, 12, "Courier"; ; fontset = info, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, 12, "Courier"; ; fontset = postscript, PostScript, formatAsPostScript, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeGraphics, M7, l34, w282, h287, 12, "Courier"; ; fontset = name, inactive, nowordwrap, nohscroll, noKeepOnOnePage, preserveAspect, M7, italic, B65535, 10, "Geneva"; ; fontset = header, inactive, noKeepOnOnePage, preserveAspect, M7, 10, "Times"; ; fontset = Left Header, inactive, 10, "Times"; ; fontset = footer, inactive, noKeepOnOnePage, preserveAspect, center, M7, 12, "Times"; ; fontset = Left Footer, inactive, center, 12, "Times"; ; fontset = help, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 10, "Geneva"; ; fontset = clipboard, inactive, noKeepOnOnePage, preserveAspect, M7, 12, "New York"; ; fontset = completions, inactive, nowordwrap, noKeepOnOnePage, preserveAspect, M7, 12, "New York"; ; fontset = special1, inactive, nowordwrap, noKeepOnOnePage, preserveAspect, M7, 12, "New York"; ; fontset = special2, inactive, nowordwrap, noKeepOnOnePage, preserveAspect, center, M7, 12, "New York"; ; fontset = special3, inactive, nowordwrap, noKeepOnOnePage, preserveAspect, right, M7, 12, "New York"; ; fontset = special4, inactive, nowordwrap, noKeepOnOnePage, preserveAspect, M7, 12, "New York"; ; fontset = special5, inactive, nowordwrap, noKeepOnOnePage, preserveAspect, M7, 12, "New York"; ;] :[font = title; inactive; dontPreserveAspect; ] Chernoff Faces :[font = text; inactive; dontPreserveAspect; center; ] by Cameron Smith ;[s] 1:0,0;17,-1; 1:1,17,12,New York,2,12,0,0,0; :[font = section; inactive; dontPreserveAspect; startGroup; ] Introduction :[font = text; inactive; dontPreserveAspect; ] In 1973 Herman Chernoff, a statistician at Stanford University, introduced a new way of representing multivariate data: he suggested that mapping data onto human facial features might make it easier to recognize trends and relationships in the data. Specifically, if we know the range of values for each dimension of a multivariate data set, we can associate the extreme values of each dimension with extremes of some facial feature (for example, a frowning or smiling mouth), and intermediate values with intermediate configurations. Since the human visual system recognizes faces more skillfully than any other shapes, it is reasonable to hope that once the data points have been mapped into faces we may be able to find patterns in the data by recognizing similarities or trends in the appearances of the faces. Chernoff put it this way: :[font = text; inactive; dontPreserveAspect; endGroup; ] This approach is an amusing reversal of a common one in artificial intelligence. Instead of using machines to discriminate between human faces by reducing them to numbers, we discriminate between numbers by using the machine to do the brute labor of drawing faces and leaving the intelligence to the humans, who are still more flexible and clever. ;[s] 1:0,0;349,-1; 1:1,17,12,New York,2,12,0,0,0; :[font = section; inactive; dontPreserveAspect; startGroup; ] Tools :[font = text; inactive; dontPreserveAspect; ] Two very useful tools for assembling and positioning graphical objects are scale and displace. ;[s] 5:0,0;75,1;80,0;85,1;93,0;97,-1; 2:3,17,12,New York,0,12,0,0,0;2,14,10,Courier,1,12,0,0,0; :[font = subsection; inactive; dontPreserveAspect; startGroup; ] scale :[font = input; dontPreserveAspect; endGroup; ] scale[x_,{a_,b_},{c_,d_}] := c + (d-c)(x-a)/(b-a) :[font = subsection; inactive; dontPreserveAspect; startGroup; ] displace :[font = input; dontPreserveAspect; ] displace[Point[x_],v_,s_] := Point[v + s x] displace[Line[l_],v_,s_] := Line[ (v+s#)& /@ l ] displace[Circle[c_,r_],v_,s_] := Circle[v + s c, s r] :[font = input; dontPreserveAspect; ] displace[x_,v_] := displace[x,v,1] :[font = input; dontPreserveAspect; endGroup; endGroup; ] displace[l_List,p_,r_] := displace[#,p,r]& /@ l :[font = section; inactive; dontPreserveAspect; startGroup; ] ChernoffFace :[font = text; inactive; dontPreserveAspect; ] ChernoffFace takes a data point (a list of four numbers) and returns a representation of the data face that depicts that data point. ;[s] 2:0,1;12,0;133,-1; 2:1,17,12,New York,0,12,0,0,0;1,14,10,Courier,1,12,0,0,0; :[font = input; dontPreserveAspect; ] ChernoffFace[datum_,{x_,y_},r_:1] := displace[ ChernoffFace[datum], {x,y}, r ] :[font = subsection; inactive; dontPreserveAspect; startGroup; ] Features :[font = subsubsection; inactive; dontPreserveAspect; startGroup; ] head :[font = text; inactive; dontPreserveAspect; ] The head can then serve as a framework in which to place the other features. The head is simply an ellipse, and the median value is a circle. :[font = input; dontPreserveAspect; ] ellipse[n_,r_] := If[ n<5, Circle[ {0,0}, { scale[n,{0,5},{r,1}], 1 } ], Circle[ {0,0}, { 1, scale[n,{5,10},{1,r}] } ] ] :[font = input; dontPreserveAspect; startGroup; ] head[n_] := ellipse[n,1.3] :[font = message; inactive; preserveAspect; endGroup; endGroup; ] General::spell1: Possible spelling error: new symbol name "head" is similar to existing symbol "Head". :[font = subsubsection; inactive; dontPreserveAspect; startGroup; ] nose :[font = input; dontPreserveAspect; endGroup; ] nose = Line[{ {0,.2}, {-.1,-.15}, {.1,-.15}, {0,.2} }]; :[font = subsubsection; inactive; dontPreserveAspect; startGroup; ] eyebrows :[font = text; inactive; dontPreserveAspect; ] The eyebrows are simply lines of a fixed length, rotated about their centers by different angles. This description can be translated almost directly into code. :[font = input; dontPreserveAspect; ] diameter[th_] := Module[ {t=N[th],p}, p = {Cos[t],Sin[t]}; Line[{-p,p}] ] :[font = input; dontPreserveAspect; endGroup; ] eyebrows[n_] := Module[ {angle = scale[n,{0,10},{-Pi/6,Pi/6}]}, { displace[diameter[angle],{-.4,.55},.18], displace[diameter[-angle],{.4,.55},.18] }] :[font = subsubsection; inactive; dontPreserveAspect; startGroup; ] eyes :[font = text; inactive; dontPreserveAspect; ] The eyes are ellipses like the head, which must be symmetrically placed like the eyebrows: :[font = input; dontPreserveAspect; ] eyecenters = { {.4,.25}, {-.4,.25} }; :[font = input; dontPreserveAspect; ] eyes[n_] := Module[ { eye = ellipse[n,1.5] }, { displace[eye,#,.15]& /@ eyecenters, Point /@ eyecenters } ] :[font = text; inactive; dontPreserveAspect; endGroup; ] The Point objects represent the pupils of the eyes, and the displaced ellipse objects represent the orbs. :[font = subsubsection; inactive; dontPreserveAspect; startGroup; ] mouth :[font = input; dontPreserveAspect; ] parabola[n_] := scale[n,{0,10},{-1,1}](x^2-1) :[font = text; inactive; dontPreserveAspect; ] This anchors the mouth at two points near the ends (points corresponding to x = 1 and x = -1, the two roots of x^2-1). With this parabola we can define the mouth: :[font = input; dontPreserveAspect; endGroup; endGroup; ] mouth[n_] := Module[{formula=parabola[n],points}, points=Table[{x,formula},{x,-1.25,1.25,.25}]; displace[Line[points],{0,-.5},.25] ] :[font = text; inactive; dontPreserveAspect; ] We now have all the parts we need to define our ChernoffFace function: ;[s] 3:0,0;48,1;60,0;71,-1; 2:2,17,12,New York,0,12,0,0,0;1,14,10,Courier,1,12,0,0,0; :[font = input; dontPreserveAspect; endGroup; ] ChernoffFace[{w_,x_,y_,z_}] := { head[w],eyes[x],mouth[y],eyebrows[z],nose } :[font = input; preserveAspect; ] u:=Random[]; :[font = input; preserveAspect; startGroup; ] ?ChernoffFace :[font = info; inactive; preserveAspect; endGroup; ] Global`ChernoffFace ChernoffFace[datum_, {x_, y_}, r_:1] := displace[ChernoffFace[datum], {x, y}, r] ChernoffFace[{w_, x_, y_, z_}] := {head[w], eyes[x], mouth[y], eyebrows[z], nose} :[font = input; preserveAspect; ] orbit[f_,x0_,time_]:=NestList[f,x0,time] :[font = subsubsection; inactive; preserveAspect; startGroup; ] Linear Mapping in 4D (R4 into itself) :[font = input; preserveAspect; ] f[x_]:= {{.3,0.4,-.5,.1}, {-.8,.4,0,.1}, {.3,.1,.4,.1}, {.3,.1,.4,.1}}.x :[font = input; preserveAspect; startGroup; ] numberOfFrames=15 :[font = output; output; inactive; preserveAspect; endGroup; ] 15 ;[o] 15 :[font = input; preserveAspect; ] faceValues=orbit[f,{1,1,1,1},numberOfFrames]; :[font = input; preserveAspect; startGroup; ] ?SetOptions :[font = info; inactive; preserveAspect; endGroup; ] SetOptions[s, name1->value1, name2->value2, ...] sets the specified default options for a symbol s. SetOptions[stream, ...] or SetOptions["name", ...] sets options associated with a particular stream. :[font = input; preserveAspect; ] SetOptions[Graphics,AspectRatio->1]; :[font = input; preserveAspect; ] faces=Map[Graphics,Map[ChernoffFace,faceValues]]; :[font = input; preserveAspect; startGroup; animationSpeed = 104; ] Map[Show,faces] :[font = postscript; PostScript; formatAsPostScript; output; inactive; preserveAspect; pictureLeft = 34; pictureWidth = 221; pictureHeight = 221; endGroup; endGroup; animationSpeed = 11; ] %! %%Creator: Mathematica %%AspectRatio: 1 MathPictureStart /Courier findfont 10 scalefont setfont % Scaling calculations 0.5 0.384025 0.5 0.47619 [ [ 0 0 0 0 ] [ 1 1 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath %%Object: Graphics [ ] 0 setdash 0 setgray gsave grestore 0 0 moveto 1 0 lineto 1 1 lineto 0 1 lineto closepath clip newpath gsave 0.004 setlinewidth newpath matrix currentmatrix 0.47619 0.47619 scale 1.05 1.05 1 0 365.73 arc setmatrix stroke gsave gsave newpath matrix currentmatrix 0.0806452 0.0714286 scale 8.10476 8.6667 1 0 365.73 arc setmatrix stroke newpath matrix currentmatrix 0.0806452 0.0714286 scale 4.29524 8.6667 1 0 365.73 arc setmatrix stroke grestore gsave 0.008 setlinewidth 0.65361 0.61905 Mdot 0.34639 0.61905 Mdot grestore grestore 0.37999 0.20833 moveto 0.40399 0.2619 lineto 0.428 0.30357 lineto 0.452 0.33333 lineto 0.476 0.35119 lineto 0.5 0.35714 lineto 0.524 0.35119 lineto 0.548 0.33333 lineto 0.572 0.30357 lineto 0.59601 0.2619 lineto 0.62001 0.20833 lineto stroke gsave 0.28324 0.79677 moveto 0.40954 0.72704 lineto stroke 0.59046 0.72704 moveto 0.71676 0.79677 lineto stroke grestore 0.5 0.59524 moveto 0.4616 0.42857 lineto 0.5384 0.42857 lineto 0.5 0.59524 lineto stroke grestore % End of Graphics MathPictureEnd ^*)