(* ::Package:: *)

(************************************************************************)
(* This file was generated automatically by the Mathematica front end.  *)
(* It contains Initialization cells from a Notebook file, which         *)
(* typically will have the same name as this file except ending in      *)
(* ".nb" instead of ".m".                                               *)
(*                                                                      *)
(* This file is intended to be loaded into the Mathematica kernel using *)
(* the package loading commands Get or Needs.  Doing so is equivalent   *)
(* to using the Evaluate Initialization Cells menu command in the front *)
(* end.                                                                 *)
(*                                                                      *)
(* DO NOT EDIT THIS FILE.  This entire file is regenerated              *)
(* automatically each time the parent Notebook file is saved in the     *)
(* Mathematica front end.  Any changes you make to this file will be    *)
(* overwritten.                                                         *)
(************************************************************************)



(* :Name: PwM`Chap10Visualization` *)


(* :Book: Programming with Mathematica: An Introduction *)


(* :Author: Paul Wellin *)


(* :Summary: This package contains the functions defined in Chapter 10, Graphics and visualization. *)


(* :Context: PwM`Chap10Visualization` *)


(* :Package Version: 1.0 *)


(* :Copyright: Copyright 2012, Cambridge University Press *)


(* :History: Version 1.0 by Paul Wellin, Dec 2012 *)


(* :Keywords: Brownian music, space-filling plots, color wheel, plotting complex numbers, convex hull, 3D lattice, plotting paths, point in polygon, protein dot plot, simple closed paths, standard deviation, trend plots, triangle area,  *)


(* :Source: Chap10Visualization.nb *)


(* :Mathematica Version: 8.0.4 *)


Remove[TriangleArea,PathPlot]


BeginPackage["PwM`Chap10Visualization`",{"ComputationalGeometry`"}]


BrownianCompose::usage="BrownianCompose[\!\(\*
StyleBox[\"n\", \"TI\"]\)] generates an \!\(\*
StyleBox[\"n\", \"TI\"]\)-step (notes) random sound composition with, essentially a weighted random walk on the C major scale.";


ChemicalSpaceFillingPlot::usage="ChemicalSpaceFillingPlot[\!\(\*
StyleBox[\"chem\", \"TI\"]\)] generates a molecular space-filling plot for the chemical \!\(\*
StyleBox[\"chem\", \"TI\"]\).";


colorWheel::usage="colorWheel[\!\(\*
StyleBox[\"n\", \"TI\"]\)] displays a color wheel with \!\(\*
StyleBox[\"n\", \"TI\"]\) sectors.";


ComplexListPlot::usage="ComplexListPlot[\!\(\*
StyleBox[\"pts\", \"TI\"]\)] plots the complex points \!\(\*
StyleBox[\"pts\", \"TI\"]\) in the complex plane. ComplexListPlot inherits all the options of ListPlot.";


ComplexRootPlot::usage="ComplexRootPlot[\!\(\*
StyleBox[\"poly\", \"TI\"]\), \!\(\*
StyleBox[\"var\", \"TI\"]\)] plots the complex root of the polynomial \!\(\*
StyleBox[\"poly\", \"TI\"]\) in the complex plane.";


ConvexHullPlot::usage="ConvexHullPlot[\!\(\*
StyleBox[\"pts\", \"TI\"]\)] plots the convex hull of the set of points \!\(\*
StyleBox[\"pts\", \"TI\"]\). ConvexHullPlot inherits options from Graphics.";


Hypocycloid::usage="Hypocycloid[{\!\(\*
StyleBox[\"R\", \"TI\"]\), \!\(\*
StyleBox[\"r\", \"TI\"]\)}, \[Theta]] generates a hypocycloid curve with the radius of the fixed outside circle given by \!\(\*
StyleBox[\"R\", \"TI\"]\) and the radius of the rotating inner circle given by \!\(\*
StyleBox[\"r\", \"TI\"]\). The angle of rotation is given by the paramter \[Theta].";


Lattice3D::usage="Lattice3D[{\!\(\*
StyleBox[\"xmin\", \"TI\"]\), \!\(\*
StyleBox[\"xmax\", \"TI\"]\)}, {\!\(\*
StyleBox[\"ymin\", \"TI\"]\), \!\(\*
StyleBox[\"ymax\", \"TI\"]\)}, {\!\(\*
StyleBox[\"zmin\", \"TI\"]\), \!\(\*
StyleBox[\"zmax\", \"TI\"]\)}] displays a three-dimensional lattice in space.";


ListLinePlot3D::usage="ListLinePlot3D[\!\(\*
StyleBox[\"lis\", \"TI\",\nFontSlant->\"Italic\"]\)] creates a three-dimensional graphic of lines connecting the points given in \!\(\*
StyleBox[\"lis\", \"TI\",\nFontSlant->\"Italic\"]\) which are assumed to be lists consisting of three coordinates.";


PathPlot::usage="functionName[x] computes the\[Ellipsis]";


PointInPolygonQ::usage="PointInPolygonQ[\!\(\*
StyleBox[\"poly\", \"TI\"]\), \!\(\*
StyleBox[\"pt\", \"TI\"]\)] returns True if the point \!\(\*
StyleBox[\"pt\", \"TI\"]\) is inside the polygon specified by the set of vertices \!\(\*
StyleBox[\"poly\", \"TI\"]\).";


ProteinSpaceFillingPlot::usage="ProteinSpaceFillingPlot[\!\(\*
StyleBox[\"protein\", \"TI\"]\)] generates a molecular space-filling plot for the protein \!\(\*
StyleBox[\"protein\", \"TI\"]\).";


ProteinDotPlot::usage="ProteinDotPlot[\!\(\*SubscriptBox[
StyleBox[\"protein\", \"TI\"], \(1\)]\), \!\(\*SubscriptBox[
StyleBox[\"protein\", \"TI\"], \(2\)]\), {\!\(\*SubscriptBox[
StyleBox[\"name\", \"TI\"], \(1\)]\), \!\(\*SubscriptBox[
StyleBox[\"name\", \"TI\"], \(2\)]\)}] generates a protein dot plot comparing the two proteins \!\(\*SubscriptBox[
StyleBox[\"protein\", \"TI\"], \(1\)]\) and \!\(\*SubscriptBox[
StyleBox[\"protein\", \"TI\"], \(2\)]\).";


RandomCompose::usage="RandomCompose[\!\(\*
StyleBox[\"n\", \"TI\"]\), \!\(\*
StyleBox[\"instr\", \"TI\"]\)] generates an uncorrelated set of  \!\(\*
StyleBox[\"n\", \"TI\"]\) tones using the MIDI instrument \!\(\*
StyleBox[\"instr\", \"TI\"]\).";


RandomWalkPi::usage="RandomWalkPi[\!\(\*
StyleBox[\"n\", \"TI\"]\), \!\(\*
StyleBox[\"b\", \"TI\"]\)] generates \!\(\*
StyleBox[\"n\", \"TI\"]\) steps of a random walk on the base \!\(\*
StyleBox[\"b\", \"TI\"]\) digits of \[Pi].";


RootPlot::usage="RootPlot[\!\(\*
StyleBox[\"fun\", \"TI\"]\), {\!\(\*
StyleBox[\"x\", \"TI\"]\), \!\(\*
StyleBox[\"xmin\", \"TI\"]\), \!\(\*
StyleBox[\"xmax\", \"TI\"]\)}] plots the function \!\(\*
StyleBox[\"fun\", \"TI\"]\) together with its roots over the interval from \!\(\*
StyleBox[\"xmin\", \"TI\"]\) to \!\(\*
StyleBox[\"xmax\", \"TI\"]\).";


SimpleClosedPath::usage="SimpleClosedPath[\!\(\*
StyleBox[\"lis\", \"TI\"]\)] finds a simple closed path through the two-dimensional points, \!\(\*
StyleBox[\"lis\", \"TI\"]\).";


StandardDeviationPlot::usage="StandardDeviationPlot[\!\(\*
StyleBox[\"data\", \"TI\"]\), \!\(\*
StyleBox[\"sd\", \"TI\"]\)] plots \!\(\*
StyleBox[\"data\", \"TI\"]\) where points within one standard deviation are colored differently than those more than one standard deviation from the mean. The second argument, sd, is 1 by default and can set to any standard deviation value.";


TrendPlot::usage="TrendPlot[\!\(\*
StyleBox[\"data\", \"TI\"]\),{\!\(\*SubscriptBox[
StyleBox[\"r\", \"TI\"], \(1\)]\), \!\(\*SubscriptBox[
StyleBox[\"r\", \"TI\"], \(2\)]\),\[Ellipsis]}] plots \!\(\*
StyleBox[\"data\", \"TI\"]\) with trend lines showing growth rates over time.";


TrendlineStyle::usage="TrendlineStyle is an option for TrendPlot that specifies the style of the trend lines.";


TriangleArea::usage="TriangleArea[{\!\(\*SubscriptBox[
StyleBox[\"v\", \"TI\"], \(1\)]\),\!\(\*SubscriptBox[
StyleBox[\"v\", \"TI\"], \(2\)]\),\!\(\*SubscriptBox[
StyleBox[\"v\", \"TI\"], \(3\)]\)}] computes the area of the triangle given by the three vertices \!\(\*SubscriptBox[
StyleBox[\"v\", \"TI\"], \(1\)]\), \!\(\*SubscriptBox[
StyleBox[\"v\", \"TI\"], \(2\)]\), and \!\(\*SubscriptBox[
StyleBox[\"v\", \"TI\"], \(3\)]\).";


Options[BrownianCompose]={Weights->Automatic};


Options[ComplexListPlot]=Options[ListPlot];


Options[ListLinePlot3D]=Join[{
Mesh->None,
MeshStyle->Automatic,
PlotStyle->ColorData[1][1]
},
Options[Graphics3D]];


Options[PathPlot]=Join[{ClosedPath->True},Options[Graphics]];


Options[RootPlot]=Join[Options[NSolve],Options[Plot]];


Options[TrendPlot]=Join[{TrendlineStyle->Automatic},Options[DateListPlot]];


ListLinePlot3D::badmesh="The value of the Mesh option should be either None or All";


Begin["`Private`"]


BrownianCompose[steps_Integer,instr_:"Vibraphone",OptionsPattern[]]:=Module[{walk,durs,weights},
weights=If[OptionValue[Weights]===Automatic,Table[1/9,{9}],OptionValue[Weights]];
walk[n_]:=Accumulate[RandomChoice[weights->Range[-4,4],n]];
durs=RandomChoice[Range[1/16,1,1/16],{steps}];
Sound@MapThread[SoundNote[#1,#2,instr]&,{walk[steps],durs}]
]


ChemicalSpaceFillingPlot[chem_]:=Module[{elements,pos,radii},
elements=ChemicalData[chem,"VertexTypes"];
pos=ChemicalData[chem,"AtomPositions"];
radii=Map[ElementData[#,"VanDerWaalsRadius"]&,elements];
Graphics3D[{Specularity[White,50],
MapThread[{ColorData["Atoms",#1],Sphere[#2,#3]}&,{elements,pos,radii}]
},Lighting->"Neutral"]
]


colorWheel[n_]:=Graphics[({Hue[Rescale[#,{0,2\[Pi]}]],Disk[{0,0},1,{#,#+ n}]}&)/@Range[0,2 \[Pi],n]]


ComplexListPlot[points_,opts:OptionsPattern[]]:=
ListPlot[Map[{Re[#],Im[#]}&,points],opts,PlotStyle->{Red,PointSize[Medium]},AxesLabel->{"Re","Im"},LabelStyle->Directive["Menu"]]


ComplexRootPlot[poly_,z_,opts:OptionsPattern[]]:=ComplexListPlot[z/.NSolve[poly==0,z],opts,AspectRatio->Automatic]


ConvexHullPlot[pts_,opts:OptionsPattern[Graphics]]:=Module[{ch,ran=Range[Length[pts]]},
ch=ComputationalGeometry`ConvexHull[pts];
Graphics[{GraphicsComplex[
pts,
{Line[ch/.{a_,b__}:>{a,b,a}],
PointSize[Medium],Point[ran],
Map[Text[StringForm["`1`",#],pts[[#]],{-1.25,-1.25}]&,ran]
}
]},opts]
]


Hypocycloid[{a_,b_},\[Theta]_]:={(a-b)Cos[\[Theta]]+b Cos[\[Theta] (a-b)/b],(a-b)Sin[\[Theta]]-b Sin[\[Theta] (a-b)/b]}


Lattice3D[{xmin_,xmax_},{ymin_,ymax_},{zmin_,zmax_},opts:OptionsPattern[Graphics3D]]:=Module[{gridX,gridY,gridZ},gridX=Table[{{xmin,y,z},{xmax,y,z}},{y,ymin,ymax},{z,zmin,zmax}];
gridY=Table[{{x,ymin,z},{x,ymax,z}},{x,xmin,xmax},{z,zmin,zmax}];
gridZ=Table[{{x,y,zmin},{x,y,zmax}},{x,xmin,xmax},{y,ymin,ymax}];
Graphics3D[{
Map[Line,gridX],
Map[Line,gridY],
Map[Line,gridZ]
},opts,Boxed->False]
]


ListLinePlot3D[lis:{{_,_,_}..},opts:OptionsPattern[]]:=Module[{plotStyle,mesh,meshStyle,gr3DOpts},
mesh=OptionValue[Mesh];
plotStyle=If[
OptionValue[PlotStyle]===Automatic,
ColorData[1][1],
OptionValue[PlotStyle]
];
meshStyle=If[
OptionValue[MeshStyle]===Automatic,
{PointSize[Medium],ColorData[1][1]},
OptionValue[MeshStyle]];
gr3DOpts=FilterRules[{opts},Options[Graphics3D]];
Which[
mesh===All,Graphics3D[{Flatten@{plotStyle,Line[lis]},Flatten@{meshStyle,Point[lis]}},gr3DOpts],
mesh===None,Graphics3D[Flatten@{plotStyle,Line[lis]},gr3DOpts],
True,Message[ListLinePlot3D::badmesh]
]
]


ListLinePlot3D[lis_List,opts:OptionsPattern[]]:=Module[{colors=ColorData[1][#]&/@Range[Length[lis]]},
Graphics3D[Thread[{colors,Line/@lis}],opts]]


PathPlot[lis_List,opts:OptionsPattern[]]:=
Module[{coords=lis},
If[OptionValue[ClosedPath],
coords=coords/.{a_,b__}:>{a,b,a}];
Graphics[{
Line[coords],
PointSize[.02],Red,Point[coords]
},
FilterRules[{opts},Options[Graphics]]]]


PointInPolygonQ[poly:{{_,_}..},pt:{x_,y_}]:=Module[{edges,e2,e3,e4},
edges=Partition[poly/.{a_,b__}:>{a,b,a},2,1];e2=DeleteCases[edges,{{x1_,y1_},{x2_,y2_}}/;y1==y2];e3=DeleteCases[e2,{{x1_,y1_},{x2_,y2_}}/;(Min[y1,y2]>=y||Max[y1,y2]<y)];
e4=Map[Reverse@SortBy[#,Last]&,e3];OddQ[Count[TriangleArea[Join[#,{pt}]]&/@e4,_?Positive]]
]


ProteinDotPlot[p1_,p2_,{name1_String,name2_String}]:=
ArrayPlot[Outer[Boole[#1==#2]&,Characters[p1],Characters[p2]],
Frame->True,FrameLabel->{name1,name2}]


ProteinSpaceFillingPlot[prot_,opts:OptionsPattern[Graphics3D]]:=Module[{atoms,pos,radii},
atoms=ProteinData[prot,"AtomTypes"];
pos=ProteinData[prot,"AtomPositions"];
If[MemberQ[Join[{atoms,pos}],_Missing],Missing["NotAvailable"],
radii=Map[ElementData[#,"VanDerWaalsRadius"]&,atoms];
Graphics3D[{Specularity[White,50],
MapThread[{ColorData["Atoms",#1],Sphere[#2,#3]}&,{atoms,pos,radii}]
},opts,Lighting->"Neutral"]
]
]


RandomCompose[n_Integer,instrument_:"Piano"]:=With[{notes=Join[{None},Range[0,11]],durations=Range[1/8,1,1/8]},
Sound[{instrument,
MapThread[SoundNote[#1,#2]&,
{RandomChoice[notes,n],RandomChoice[durations,n]}]
}]
]


RandomWalkPi[d_,base_/;base>2]:=Module[{digits,angles,rules},
digits=First[RealDigits[N[\[Pi],d],base]];
angles=Rest@Range[0.,2\[Pi],2\[Pi]/(base)];rules=MapThread[#1->#2&,{Range[0,base-1],angles}];
Accumulate[Map[{Cos[#],Sin[#]}&,digits/.rules]]
]


RootPlot[fun_,{var_,varmin_,varmax_},opts:OptionsPattern[]]:=Module[{f=fun},
Plot[f,{var,varmin,varmax},
opts,
Mesh->{{0}},MeshFunctions->{f/.var->#&},
MeshStyle->{Red,PointSize[Medium]}]]


SimpleClosedPath[lis_List]:=Module[{base,angle,sorted},
base=First[SortBy[lis,Last]];
angle[a_,b_]:=ArcTan@@(b-a);
sorted=Sort[Complement[lis,{base}],angle[base,#1]<=angle[base,#2]&];Join[{base},sorted,{base}]]


StandardDeviationPlot[data_?VectorQ,n_:1,opts:OptionsPattern[ListPlot]]:= 
Module[{in,out,len=Length[data],lenrange,\[Mu]=Mean[data],\[Sigma]=StandardDeviation[data]},
lenrange=Range[Length[data]];
in=Pick[lenrange,Thread[Abs[(data-\[Mu])/\[Sigma]]<n]];
out=Complement[lenrange,in];
in=If[Length[in]===0,{Missing[]},Transpose[{in,data[[in]]}]];
out=If[Length[out]===0,{Missing[]},Transpose[{out,data[[out]]}]];
ListPlot[{in,out},
opts,
PlotStyle->{Blue,Pink},
PlotRange->All,
Epilog->{Dashed,
Line[{{0,\[Mu]+n \[Sigma]},{len,\[Mu]+n \[Sigma]}}],
Line[{{0,\[Mu]-n \[Sigma]},{len,\[Mu]-n \[Sigma]}}]}
]
]


TrendPlot[data_,rates_List,opts:OptionsPattern[]]:=Module[{min,max,tlStyle,tLine,rtTicks,init=data[[1,2]],minR,maxR},

{min,max}={Min[data[[All,2]]],Max[data[[All,2]]]};
{minR,maxR}={Min[rates],Max[rates]};

tlStyle=If[OptionValue[TrendlineStyle]===Automatic,{Dashed,Gray},OptionValue[TrendlineStyle]];

tLine[r_]:=Flatten@{tlStyle,
Line[{First[data],Last[data]/.{d_List,val_?NumberQ}:>{d,(1+r )init}}]};

rtTicks=MapThread[{(1+#)init,StringForm[" `1`%",#2]}&,{rates,100rates}];

DateListPlot[data,Joined->True,
FilterRules[{opts},Options[DateListPlot]],
Epilog:>Map[tLine,rates],
PlotRange->{(1.05+minR)min,(.95+maxR)max},
FrameTicks->{{Automatic,rtTicks},{Automatic,None}}]
]


TriangleArea[tri:{v1_,v2_,v3_}]:=Det[Map[PadRight[#,3,1]&,tri]]/2


End[]


EndPackage[]



