2
$\begingroup$

How would I define a function to generate a Chernoff face in Mathematica without using the built in ChernoffFace[x]?

$\endgroup$
1
  • 5
    $\begingroup$ Do you mean ChernoffFace from this package? $\endgroup$
    – C. E.
    Apr 19, 2017 at 18:17

1 Answer 1

6
$\begingroup$

Here's a manipulate that implements a display of a face controllable with the sliders on the left. Move/shift the eyes with the mouse.

Manipulate[eyeMat = {{1/(eyeRadius - pupilRadius/2), 0}, {0, 
    1/(0.15 + eyes - pupilRadius/2)}}; 
 If[Norm[eyeMat.(pup - eyeCenter[[left]])] < 1, 
  pupNow = pup - eyeCenter[[left]];]; 
 If[Norm[eyeMat.(pup - eyeCenter[[right]])] < 1, 
  pupNow = pup - eyeCenter[[right]];]; 
 Graphics[{face, eye[left, eyes], eye[right, eyes], Blue, 
   pupil[left, pupNow, eyes], pupil[right, pupNow, eyes], Black, 
   browDraw[left, brows, eyes], browDraw[right, brows, eyes], 
   Inset[mouthDraw[mouth], {0, -0.5}]}, ImageSize -> {400, 450}],
 {{brows, {-Pi/20, 0}}, {-0.6, 0}, {0.6, 0.15}, 
  ControlPlacement -> Left},
 {{eyes, 0}, -0.07, 0.07, ControlPlacement -> Left, 
  ControlType -> VerticalSlider},
 {{mouth, 0.15}, -0.401, 0.4, 0.01, ControlPlacement -> Left, 
  ControlType -> VerticalSlider},
 {{pup, {0, 0}}, Locator, Appearance -> None}, 
 Initialization :> (face = Circle[{0, 0}, {1, 1.2}]; pupNow = {0, 0}; 
   left = 1; right = 2;
   eyeRadius = 0.18; eyeCenter = {{-0.4, 0.15}, {0.4, 0.15}}; 
   pupilRadius = 0.09;
   browUp = 0.25; browW = 0.2; browAng = Pi/20;
   eye[side_, eccen_] := {Black, 
     Circle[eyeCenter[[side]], {eyeRadius + 0.05, eyeRadius + eccen}]};
   pupil[side_, pup_, eccen_] := 
     {Disk[eyeCenter[[side]] + pup + {0, pup[[2]] eccen}, 
      pupilRadius + Max[0, eccen/3]], Black, 
     Disk[eyeCenter[[side]] + pup + {0, pup[[2]] eccen}, 0.03]};
   browDraw[side_, {browAng_, browLift_}, eccen_] := 
    Rotate[{Thickness[0.01], 
      Line[{{eyeCenter[[side]] + {-browW, browLift + browUp + 0.5 eccen}, 
         eyeCenter[[side]] + {browW, browLift + browUp + 0.5 eccen}}}]}, 
          2 (side - 1.5) browAng];
   mouthDraw[s_] := ParametricPlot[{Cos[u], -s Sin[u]}, {u, Pi/6, Pi - Pi/6}, 
     Axes -> False, PlotStyle -> {Red, Thickness[0.02]}, PlotRange -> All];)]

enter image description here

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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