THE  FUTURE OF INTERACTIVE PUBLISHING

Jon McLoone
Wolfram Research

What have computers done for publishing?

A 1687 publication: Principia Mathematica

({{, }})

A 2010 publication...

What should computers do for publishing?

Embed additional information

data=Table[100-x^2-y^2+RandomInteger[10],{x,-7,7},{y,-7,7}];FlipView[{Grid[data,Frame->All],ListContourPlot[data,ContourLabels->True],ListPlot3D[data],ListDensityPlot[data]},ImageSize->All,Alignment->Center]

({{The information on the right has 
been set up for the you to decide  
how to view it. Click on the data 
repeatedly  to change the view., }})

Graphics[Tooltip[Inset[Rasterize[CountryData[#,"Flag"],RasterSize->70],{Log[10,CountryData[#,"Population"]],Log[10,CountryData[#,"GDP"]]},Center,0.2],Column[{Style[#,18],Show[CountryData[#,"Shape"],ImageSize->75],
Row[{"GDP: $",Round[CountryData[#,"GDP"]/10^9]," billion"}],Row[{"Population: ",Round[CountryData[#,"Population"]/10^6]," million"}]}]]&/@DeleteCases[CountryData["UN"],"VaticanCity"],Frame->True,PlotRangePadding->.2,FrameLabel->{Style["Population",20],Style["GDP",20]}]

Manipulate[

(*Select the subset of the data according to the checkboxes set by the user*)pms=If[showconservative,#,DeleteCases[#,{___,"Conservative"}]]&@If[showlabour,#,DeleteCases[#,{___,"Labour"}]]&@If[shownationallabour,#,DeleteCases[#,{___,"National Labour"}]]&@If[showliberal,#,DeleteCases[#,{___,"Liberal"}]]&@PrimeMinisterData;

(*Create the whole graphic*)
Deploy@Graphics[Table[PrimeMinisterGraphic[pms,i,If[stack,i,1],stack,True],{i,Length[pms]-1}],AspectRatio->0.7,Axes->{True,False},FrameTicks->{{{0,1900},{25,1925},{50,1950},{75,1975},{100,2000}},None},Frame->True,Axes->False,GridLines->None,PlotRange->If[stack,{{0,125},{0.5,Length[pms]+0.5}},{{0,125},{1,2}}],AxesOrigin->{0,0},ImageSize->600],

(*Interface specification*)
{{stack,True,"Show Names"},{True,False}},
{{showconservative,True,"Conservative Party"},{True,False}},
{{showlabour,True,"Labour Party"},{True,False}},
{{showliberal,True,"Liberal Party"},{True,False}},
{{shownationallabour,True,"National Labour Party"},{True,False}},
Initialization:>(
DateToValue[{m_,yr_}]:=m/12+yr-1900;
(*Create one line of the graphic*)
PrimeMinisterGraphic[pmdata_,pm_,pos_,txt_,tooltip_]:=If[tooltip,Tooltip[#,If[txt,pmdata[[pm,1]],Column[{pmdata[[pm,4]],Rasterize[pmdata[[pm,1]]]},Center]]],#]&[{Switch[pmdata[[pm,5]],"Conservative",Blue,"Labour",Red,"Liberal",Yellow,"National Labour",Orange],
Polygon[{
{DateToValue[pmdata[[pm,2]]],pos},
{DateToValue[pmdata[[pm,3]]],pos},
{DateToValue[pmdata[[pm,3]]],pos+1},
{DateToValue[pmdata[[pm,2]]],pos+1},
{DateToValue[pmdata[[pm,2]]],pos}}],Black,If[txt,Text[" "<>pmdata[[pm,4]],{DateToValue[pmdata[[pm,3]]],pos+0.5},{-1,0}],{}]}];

(*The historical data on all the PMs*)
PrimeMinisterData={{,{7,1902},{12,1905},"Arthur Balfour","Conservative"},{,{12,1905},{4,1908},"Sir Henry Campbell-Bannerman","Liberal"},{,{4,1908},{12,1916},"H. H. Asqith","Liberal"},{,{12,1916},{10,1922},"David Lloyd George","Liberal"},{,{10,1922},{5,1923},"Andrew Bonar Law","Conservative"},{,{5,1923},{1,1924},"Stanley Baldwin","Conservative"},{,{1,1924},{10,1924},"Ramsay MacDonald","Labour"},{,{10,1924},{6,1929},"Stanley Baldwin","Conservative"},{,{6,1929},{8,1931},"Ramsay MacDonald","Labour"},{,{8,1931},{6,1935},"Ramsay MacDonald","National Labour"},{,{6,1935},{5,1937},"Stanley Baldwin","Conservative"},{,{5,1937},{5,1940},"Neville Chamberlain","Conservative"},{,{5,1940},{7,1945},"Winston Churchill","Conservative"},{,{7,1945},{10,1951},"Clement Attlee","Labour"},{,{10,1951},{5,1955},"Winston Churchill","Conservative"},{,{5,1955},{1,1957},"Sir Anthony Eden","Conservative"},{,{1,1957},{10,1963},"Harold Macmillan","Conservative"},{,{10,1963},{10,1964},"Sir Alec Douglas Home","Conservative"},{,{10,1964},{6,1970},"Harold Wilson","Labour"},{,{6,1970},{3,1974},"Edward Heath","Conservative"},{,{3,1974},{4,1976},"Harold Wilson","Labour"},{,{4,1976},{5,1979},"James Callaghan","Labour"},{,{5,1979},{10,1990},"Margaret Thatcher","Conservative"},{,{10,1990},{5,1997},"John Major","Conservative"},{,{5,1997},{12,2007},"Tony Blair","Labour"},
{,{12,2007},{5,2010},"Gordon Brown","Labour"},
{,{5,2010},{7,2010},"David Cameron","Conservative"},Null} ;
),ControllerLinking->True]

Hide information

Let you change information...

Compute!

PI Filter response

Manipulate[
ƒ = If[fullwave,Abs[A Sin[120π #]]&,A Sin[120π #]&];
C1=(10^(-6))c1;C2=(10^(-6))c2;
Vout=r3(γ[vd[#]]+i2[#]+i3[#])&/.First@NDSolve[Join[{
(1+r1 (γ^( ′))[vd[t]])(vd^( ′))[t]-i2[t]/C1== (ƒ[t+dt]-ƒ[t-dt])/(2dt),
i3[t]/C2+r3((γ^( ′))[vd[t]](vd^( ′))[t]+(i2^( ′))[t]+(i3^( ′))[t])==0,
-L((i3^( ″))[t]+(((r3 C2))^(-1))(i3^( ′))[t])+r2((γ^( ′))[vd[t]](vd^( ′))[t]+(i2^( ′))[t])-i3[t]/C2+i2[t]/C1==0,
vd[0]==i2[0]==i3[0]==0},If[L==0,{},{(i3^( ′))[0]==0}]],{vd,i2,i3},{t,0,1.01tmax},MaxSteps->(10^6)];
M= Max[Table[Vout[t],{t,0,tmax/3,1/1000}]];
vals= Table[Vout[t],{t,tmax-1/15,tmax,1/15/99}];
(filteredvals=InverseFourier[Fourier[vals]If[fullwave,sparf,sparh]][[26;;75]];
rip=((Mean[ (filteredvals^2)])^(1/2))/(𝓂=Mean[vals]);
Plot[{Vout[t],𝓂},{t,If[zoom,tmax-1/15,0] ,tmax},PlotRange->If[zoom,All,{0,Max[1.05A,1.02M]}],PlotStyle->{Thickness[Medium],{}},PlotLabel->Style[StringJoin["ripple: ",ToString[NumberForm[100rip,2]],"% rms\n output current: ",ToString[NumberForm[1000𝓂/r3,2]]," mA"],"Label"],ImageSize->350,ImagePadding->{{25,10},{25,10}}])//Quiet,
Dynamic[Row[{circuit}],SynchronousUpdating->False],Delimiter,
{{c1,10,"(10^6) (Subscript[C, 1])"},1,50,1,Appearance->"Labeled",ImageSize->Small},
{{c2,10,"(10^6) (Subscript[C, 2])"},1,50,1,Appearance->"Labeled",ImageSize->Small},
{{L,1},0,12,1,Appearance->"Labeled",ImageSize->Small},
{{r1,100,"(Subscript[R, rect])"},1,500,1,Appearance->"Labeled",ImageSize->Small},
{{r2,100,"(Subscript[R, choke])"},0,500,10,Appearance->"Labeled",ImageSize->Small},
{{r3,3000,"(Subscript[R, load])"}, 100,10000,50,Appearance->"Labeled",ImageSize->Small},
{{A,100,"input amplitude"},5,600,5,Appearance->"Labeled",ImageSize->Small},
{{fullwave,True,"rectifier"},{True->"full wave",False->"half wave"},ControlType->SetterBar},
{{tmax,.25,"(Subscript[t, max])"},.1,1,.05,Appearance->"Labeled",ImageSize->Small},
{{zoom,False,"zoom in"},{False,True},ControlType->Checkbox},
AutorunSequencing->{1,3,5,7},
TrackedSymbols->True,
SynchronousUpdating->False,
Initialization:>{
dt=(10^(-6)),γ[x_]:=(10^(-5))((E^(20x))-1),
sparf=1+SparseArray[Join[Table[i->-1,{i,1,8}],Table[i->-1,{i,100-6,100}]],{100}],
sparh=1+SparseArray[Join[Table[i->-1,{i,1,3}],Table[i->-1,{i,100-1,100}]],{100}],
capvals=((10^(-6))#->StringJoin[ToString[#]," µf"])&/@{1,5,10,20,30,40,50},
cap[{x_,y_},lbl_]:={Line/@{{{x,y-2.5},{x,y+2.1}},{{x,y+2.8},{x,y+7.5}},{{x-1.5,y+2.1},{x+1.5,y+2.1}},{{x-1.5,y+2.8},{x+1.5,y+2.8}}},Text[lbl,{x+3,y+2.5}]};
resH[{x_,y_},lbl_,offset_:{1,0}]:={Line[{{x,y},{1+x,y},{1.25+x,0.5+y},{1.75+x,-0.5+y},{2.25+x,0.5+y},{2.75+x,-0.5+y},{3.25+x,0.5+y},{3.75+x,-0.5+y},{4+x,y},{5+x,y}}],Text[lbl,{x+2.5,y-1.75},offset]};
resV[{x_,y_},lbl_,offset_:{1,0}]:={Line[{{x,y},{x,y+1},{x-.5,y+1.25},{x+.5,y+1.75},{x-.5,y+2.25},{x+.5,y+2.75},{x-.5,y+3.25},{x+.5,y+3.75},{x,y+4},{x,y+5}}],Text[lbl,{x+2,y+2.5},offset]};
circuit=Show[Graphics[ {
resH[{2,10},"(Subscript[R, rect])",{0,0}],resH[{14.5,10},"(Subscript[R, choke])",{0,0}],resV[{26,2.5},"(Subscript[R, load])",{-.4,0}],cap[{7.5,2.5},"(Subscript[C, 1])"],cap[{20,2.5},"(Subscript[C, 2])"],Line[{{-3,3.75},{-3,0},{26,0},{26,2.5}}],Line[{{-3,6.25},{-3,10},{2,10}}],Line[{{7,10},{9,10}}],Line[{{19.5,10},{26,10}}],Line[{{14,10},{14.5,10}}],Line[{{26,7.5},{26,10}}],Polygon[{{-.5,9},{1,10},{-.5,11}}],{Thick,Line[{{1,9.2},{1,10.8}}]},Circle[{-3,5},1.25],Text["60 Hz",{.5,3}],Style[Text["L",{11.75,8.3}],Italic]}],Plot[.7Sin[2π(x+3.5)]+5,{x,-3.5,-2.5}],ParametricPlot[{.158(2.5π t-2Cos[2.5π t])+9.25,10+.6Sin[2.5π t]},{t,0,3.6},PlotStyle->Black],ImageSize->220,BaseStyle->"Label"];}]

Tax Rates and Tax Revenue

w[{a_,b_},k_][income_,leisure_]:=k((income^a) +(leisure^b))+(1-k)((income^a) *(leisure^b));
(*Assuming[And[0<z<b3,0<b1<b2<b3],Integrate[Piecewise[{{t1,0≤w<b1},{t2,b1≤w<b2},{t3,b2≤w≤b3}}],{w,0,z}]]*)
totalTax[z_, {{b1_, t1_}, {b2_, t2_}, {b3_, t3_}}] = 
   Piecewise[{{b1*t1, (b1 > 0 && b1 - z < 0 && b2 - b3 >= 0 && 
        b1 - b2 >= 0) || (b1 > 0 && b1 - z < 0 && b1 - b2 >= 0 && 
        b2 - z >= 0) || (b1 > 0 && b1 - z < 0 && b1 - b2 >= 0 && 
        b3 - z < 0) || (b1 > 0 && b1 - z < 0 && b1 - b2 > 0)}, 
     {b1*t1 - b1*t2 + b2*t2, (b1 > 0 && b2 - b3 >= 0 && b1 - b2 < 0 && 
        b1 - z < 0 && b2 - z < 0) || (b1 > 0 && b1 - b2 < 0 && 
        b1 - z < 0 && b2 - z < 0 && b3 - z < 0)}, 
     {t1*z, (b1 <= 0 && b2 <= 0) || (b1 <= 0 && b2 - b3 >= 0) || 
       (b1 <= 0 && b2 - z >= 0) || (b1 <= 0 && b3 - z < 0) || 
       (b2 - b3 >= 0 && b1 - b2 >= 0 && b1 - z >= 0) || 
       (b1 - z >= 0 && b2 - z >= 0) || (b1 - b2 >= 0 && b1 - z >= 0 && 
        b3 - z < 0) || (b1 > 0 && b1 - b2 > 0 && b1 - z >= 0) || 
       (b2 <= 0 && b1 - b2 > 0 && b1 - z >= 0)}, 
     {(-b1)*t2 + b2*t2 + t1*z, (b1 > 0 && b2 - b3 >= 0 && 
        b1 - b2 < 0 && b2 - z < 0 && b1 - z >= 0) || 
       (b1 > 0 && b1 - b2 < 0 && b2 - z < 0 && b3 - z < 0 && 
        b1 - z >= 0)}, {b1*t1 - b1*t2 + t2*z, b1 > 0 && b1 - z < 0 && 
       b2 - z >= 0 && b1 - b2 < 0}, {b1*t1 - b2*t3 + t3*z, 
      b1 - b2 == 0 && b1 > 0 && b3 - z >= 0 && b2 - b3 < 0 && 
       b1 - z < 0 && b2 - z < 0}, {b1*t1 - b1*t2 + b2*t2 - b2*t3 + 
       t3*z, b1 > 0 && b1 - z < 0 && b3 - z >= 0 && b1 - b2 < 0 && 
       b2 - b3 < 0 && b2 - z < 0}, {(-b2)*t3 + t1*z + t3*z, 
      (b1 <= 0 && b3 - z >= 0 && b2 - b3 < 0 && b2 - z < 0 && 
        b2 > 0) || (b1 - b2 == 0 && b1 > 0 && b3 - z >= 0 && 
        b2 - b3 < 0 && b2 - z < 0 && b1 - z >= 0)}}, 
    (-b1)*t2 + b2*t2 - b2*t3 + t1*z + t3*z]; 
epilogFunction[locators_,optwork_]:={Plot[work-totalTax[work,locators],{work,0,1},PlotStyle->{{Thickness[0.01]}}][[1]],Text["optimum",{optwork,optwork-totalTax[optwork,locators]}+{4/24,6/24}],Arrow[{{optwork,optwork-totalTax[optwork,locators]}+{3/24,5/24},{optwork,optwork-totalTax[optwork,locators]}}],{ColorData[1][19],PointSize[0.05],Point[{optwork,optwork-totalTax[optwork,locators]}]},Dashing[{0.02,0.02}],Line[{{optwork,optwork-totalTax[optwork,locators]},{0,optwork-totalTax[optwork,locators]}}],Line[{{optwork,optwork-totalTax[optwork,locators]},{optwork,0}}],Append[ColorData[1][11],0.8],EdgeForm[Thickness[0.02]],Rectangle[{-0.25,0},{-0.02,totalTax[optwork,locators]}],
Black,Text[NumberForm[totalTax[optwork,locators],{4,3}],{-0.2,totalTax[optwork,locators]},{0,-1.5}]};
Manipulate[Module[{nm,locators,optimalWork},
locators={locator1+{1/6,0},locator2+{1/6,0},locator3+{1/6,0}};
nm=NMaximize[{w[s,k][work-totalTax[work,locators],1-work],0<work<1},work,Method->"NelderMead",AccuracyGoal->8,PrecisionGoal->7];
optimalWork=work/.Last@nm;Grid[{{Graphics[MapThread[{ColorData[1][#3],Rectangle[{#[[1]],0},{#[[2]],#2}]}&,{Partition[Prepend[First/@locators,0],2,1],Last/@locators,Range[3]}],ImageSize->250,PlotRange->{{0,1},{0,1}},AspectRatio->1,Frame->True,Axes->False,FrameLabel->{"income (i)","marginal tax rate"}],

ContourPlot[w[s,k][income,1-work],{work,0,1},{income,0.02,1},PlotRange->{{-0.3,1},{0,1}},Contours->3,ImageSize->250,PerformanceGoal->"Speed",AspectRatio->1,Frame->True,Axes->False,FrameLabel->{Row[{"work (",Style["w",Italic],")"}],Row[{"income (",Style["i",Italic],")"}]},Epilog->epilogFunction[locators,optimalWork]]},{Pane[Text@Grid[{{Pane[Style["utility function",White],{450,16}]},{Pane[w[s,k][Style["i",Italic],1-Style["w",Italic]],{450,20}]}},Dividers->All,Background->{None,{ColorData[1][14]}}],{460,50}],SpanFromLeft}

}]],
{{locator1,{1/6,0.25}},{1/6,0},{1/6,99/100},Locator},
{{locator2,{1/2,0.4}},{1/2,0},{1/2,99/100},Locator},
{{locator3,{5/6,0.6}},{5/6,0},{5/6,99/100},Locator},{{s,{0.5,0.45},"income & leisure utility exponents"},{0.1,0.1},{1,1},{0.05,0.05},ImageSize->50,ControlPlacement->Bottom},
{{k,0.25,"additive coefficient of utility function"},0,1,0.02,Appearance->"Labeled",ControlPlacement->Bottom},TrackedSymbols->{s,k,locator1,locator2,locator3},SaveDefinitions->True,AutorunSequencing->{2,1,4,5}]

Lawsuit Settlement Calculator

f[k_]=u/.First@First@FullSimplify[DSolve[{u[1]==1,u[2]==2,-k u'[x]/u''[x]==  x},u,x]] (* use Mathematica's differential equation solving capabilities to generate a utility function with constant relative risk aversion *);
fi[k_]=Quiet@Function[u,Evaluate[x/.First@First@FullSimplify[Solve[u==f[k][x],x]]]] (* use Mathematica's algebraic capabilities to find the inverse utility function*);
monotonicQ[data_,OptionsPattern[{"MinimumHorizontalSpacing"->0.01,"BoundingRectangle"->{{0,0} (*left bottom*),{1,1} (*right top*)}}]]:=With[{bb=OptionValue["BoundingRectangle"],ld=Last/@Sort[data],fd=First/@data},And[And@@Positive[Differences[ld]],And@@Map[Less[OptionValue["MinimumHorizontalSpacing"],#]&,Differences[fd]],And@@Join[Map[bb[[1,1]]<=#≤bb[[2,1]]&,fd],Map[bb[[1,2]]≤#≤bb[[2,2]]&,ld]]]]
litigationcosts["plaintiff",rule_String,threshold_,costs:{plaintifflitigationcosts_,defendantlitigationcosts_},j_]:=Which[j≥threshold,Which[rule==="each side bears own",costs[[1]],rule==="loser pays all",0,rule==="losing defendant pays",0,rule==="losing plaintiff pays",costs[[1]],True,costs[[1]]],j<threshold,Which[rule==="each side bears own",costs[[1]],rule==="loser pays all",Total[costs],rule==="losing defendant pays",costs[[1]],rule==="losing plaintiff pays",Total[costs],True,{a,b}]]
litigationcosts["defendant",rule_String,threshold_,costs:{plaintifflitigationcosts_,defendantlitigationcosts_},j_]:=Which[j≥threshold,Which[rule==="each side bears own",costs[[2]],rule==="loser pays all",Total[costs],rule==="losing defendant pays",Total[costs],rule==="losing plaintiff pays",costs[[2]],True,costs[[2]]],j<threshold,Which[rule==="each side bears own",costs[[2]],rule==="loser pays all",0,rule==="losing defendant pays",costs[[2]],rule==="losing plaintiff pays",0,True,{a,b}]];
settlementRange[kπ_,kΔ_,plaintiffw0_,defendantw0_,feeshiftingrule_,plaintifflitigationcosts_,defendantlitigationcosts_,plaintiffvictorythreshold_,minwealthΠ_,minwealthΔ_,cdf_,nintegratepoints_]:={
Quiet[fi[kπ][cdf[0]f[kπ][Clip[plaintiffw0+0-litigationcosts["plaintiff",feeshiftingrule,plaintiffvictorythreshold,{plaintifflitigationcosts,defendantlitigationcosts},0],{minwealthΠ,∞}]]+(NIntegrate[Evaluate[f[kπ][Clip[plaintiffw0+j-litigationcosts["plaintiff",feeshiftingrule,plaintiffvictorythreshold,{plaintifflitigationcosts,defendantlitigationcosts},j],{minwealthΠ,∞}]] *Max[0,cdf'[j]]],Evaluate@nintegratepoints])]-plaintiffw0],Quiet[defendantw0-fi[kΔ][cdf[0]*f[kΔ][Clip[defendantw0-(0+litigationcosts["defendant",feeshiftingrule,plaintiffvictorythreshold,{plaintifflitigationcosts,defendantlitigationcosts},0]),{minwealthΔ,∞}]]+NIntegrate[Evaluate[f[kΔ][Clip[defendantw0-(j+litigationcosts["defendant",feeshiftingrule,plaintiffvictorythreshold,{plaintifflitigationcosts,defendantlitigationcosts},j]),{minwealthΔ,∞}] Max[0,cdf'[j]]]],Evaluate@nintegratepoints]]]};

settlementRangeGraphicPrimitives[settlementRange:{plaintiffminimum_,defendantmaximum_},wc_]:={Append[Blue,0.5],Rectangle[{0,0},{defendantmaximum,2/3}],Append[Red,0.5],Rectangle[{plaintiffminimum,1/3},{wc,1}],If[plaintiffminimum<defendantmaximum,{Black,Thick,Tooltip[Line[{{defendantmaximum,0},{defendantmaximum,1}}],"maximum amount defendant is willing to pay"],Tooltip[Line[{{plaintiffminimum,0},{plaintiffminimum,1}}],"minimum amount plaintiff is willing to accept"],Dotted,Tooltip[Line[{{Mean[settlementRange],0},{Mean[settlementRange],1}}],"midpoint of maximum amount defendant is willing to pay and minimum amount plaintiff is willing to accept"],Opacity[1],Black,Text["settlement\nzone",{Mean[settlementRange],1/2}]},{}]};

textGrid[settlementRange:{plaintiffminimum_,defendantmaximum_},wc_]:=Text[Grid[{{"minimum plaintiff will accept",AccountingForm[Round[wc plaintiffminimum],9,NumberSigns->{"-$","$"},DigitBlock->3]},{If[plaintiffminimum<defendantmaximum,Style["midpoint",Black],Style["midpoint",Red]],AccountingForm[Round[Mean[{wc plaintiffminimum,wc defendantmaximum}]],9,NumberSigns->{"-$","$"},DigitBlock->3]},{"maximum defendant will pay",AccountingForm[Round[wc defendantmaximum],9,NumberSigns->{"-$","$"},DigitBlock->3]}},Dividers->All,Background->{{Lighter[ColorData["Rainbow"][0.2],0.5],Lighter[ColorData["Rainbow"][0.4],0.5]},None},BaseStyle->{Black,14},ItemSize->{{15,8},1}]];

pointsToPiecewiseFunction[pts_]:=Function[x,Evaluate[Piecewise[Map[{Rescale[x,First/@#,Last/@#],#[[1,1]]≤x<#[[2,1]]}&,Partition[pts,2,1]]]]];
locatorPaneGraphics[cdfpts_,opts:OptionsPattern[Graphics]]:=Graphics[Line[Append[cdfpts,{1,1}]],opts];

Manipulate[Grid[{{LocatorPane[Dynamic[cdfpts,(If[monotonicQ[#,"MinimumHorizontalSpacing"->0.01,"BoundingRectangle"->{{0.0,0.0},{0.99,0.99}}],cdfpts=#,{}])&],Dynamic@locatorPaneGraphics[cdfpts,GridLines->Automatic,ImageSize->is,AspectRatio->200/320,Frame->True,FrameLabel->{"judgment","cumulative probability"},FrameTicks->{Table[{i,i 10^wc},{i,0,1,0.25}],Automatic},PlotRange->{{0,1},{0,1}},ImagePadding->{{40,50},{50,20}}]]},{Dynamic@With[{sr=settlementRange[kπ,kΔ,plaintiffw0,defendantw0,feeshiftingrule,plaintifflitigationcosts,defendantlitigationcosts,plaintiffvictorythreshold,minwealthΠ  ,minwealthΔ ,pointsToPiecewiseFunction[Join[cdfpts,{{1,1}}]],Join[{j},First/@cdfpts,{1}]]},Column[{textGrid[sr,10^wc],Graphics[settlementRangeGraphicPrimitives[sr,2],AspectRatio->1/5,Frame->True,ImageSize->is,AspectRatio->100/320,Frame->True,FrameLabel->{"judgment","cumulative probability"},FrameTicks->{Table[{i,i 10^wc},{i,0,1,0.25}],Automatic},PlotRange->{{0,1},{0,1}},ImagePadding->{{40,50},{50,20}}]}]]}},ItemSize->{{24,18},1},Alignment->Left,Dividers->All],




(*----------------  controls ---------*)
Dynamic@Style[Row[{"worst case is ",Round[10^wc,100]}],Gray],
{{wc,5,Tooltip["defendant's worst case","this is the largest possible judgment that could be entered against the defendant"]},3,8,0.1,ImageSize->Small},
Delimiter,
Style["litigation costs",Bold],
{{plaintifflitigationcosts,0.1,Tooltip["plaintiff",Pane["The fraction of the largest judgment that the plaintiff is likely to incur in future litigation costs.",4 72]]},0,1,0.01,Appearance->"Labeled",ImageSize->Small},{{defendantlitigationcosts,0.1,Tooltip["defendant",Pane["The fraction of the largest judgment that the defendant is likely to incur in future litigation costs",4 72]]},0,1,0.01,Appearance->"Labeled",ImageSize->Small},
Delimiter,
Style["risk aversion",Bold],
{{kπ,0.2,Tooltip["plaintiff",Pane["This model assumes that the defendant exhibits constant relative risk aversion. This control sets the risk aversion parameter. Higher values create greater risk aversion.",4*72]]},0.02,5,0.01,Appearance->"Labeled",ImageSize->Small},{{kΔ,0.1,Tooltip["defendant",Pane["This model assumes that the plaintiff exhibits constant relative risk aversion. This control sets the risk aversion parameter. Higher values create greater risk aversion.",4 72]]},0.02,5,0.01,Appearance->"Labeled",ImageSize->Small},
Delimiter,
Style["minimum wealth",Bold],
{{minwealthΠ,0.01,Tooltip["plaintiff",Pane["If the plaintiff's wealth falls below this fraction of the largest judgment, its wealth is clipped to this value.",4 72]]},0.01,1,0.01,ImageSize->Small,Appearance->"Labeled"},{{minwealthΔ,0.01,Tooltip["defendant",Pane["If the defendant's wealth falls below this fraction of the largest judgment, its wealth is clipped to this value.",4 72]]},0.01,1,0.01,ImageSize->Small,Appearance->"Labeled"},Delimiter,{{feeshiftingrule,"each side bears own",Tooltip["fee shifting rule",Pane["This control determines how attorneys fees are allocated between the parties. The default \"American Rule\" is that each side bears their own attorneys fees. There are many exceptions, however, to this default rule of law.",4 72]]},{"each side bears own","loser pays all","losing defendant pays","losing plaintiff pays"},ControlType->SetterBar,ImageSize->Medium,ControlPlacement->Top},{{plaintiffvictorythreshold,0.2,Tooltip["plaintiff victory threshold",Pane["This is the minimum fraction of the largest judgment that the plaintiff must receive at trial before he court will deem the plaintiff to be the prevailing party for purposes of fee shifting rules.",4 72]]},0,1,Appearance->"Labeled",ImageSize->Small,ControlPlacement->Top},
{{cdfpts,Table[{i,1/2+i/2},{i,0,0.8,0.2}]},{0,0},{.9,1},ControlType->None},
{{is,330},ControlType->None},
{{plaintiffw0,1.1},ControlType->None},
{{defendantw0,2.1},ControlType->None},
{{nintegratepoints,0},ControlType->None},
{{plaintiffminimum,0},ControlType->None},
{{defendantmaximum,0},ControlType->None},
{{litigationcostsfunction,0},ControlType->None},
ControlPlacement->Left,SaveDefinitions->True,TrackedSymbols:>{wc,plaintifflitigationcosts,defendantlitigationcosts,kπ,kΔ,minwealthΠ,minwealthΔ,cdfpts,feeshiftingrule,plaintiffvictorythreshold},AutorunSequencing->{1,3,5},ControllerLinking->False]

The paper mindset

Other deployments of content

GraphPlot[Style["Computable\nDocument",20]->Style[#,16]&/@{"Paper","Static formats\n(PDF, images etc)","Web pages","Presentations\n(slideshows,movies etc)","Data transfer\n(database imports etc)","Physical objects","Applications\n(tools)"},VertexLabeling->True,DirectedEdges-> True,VertexRenderingFunction->(Mouseover[Text[Framed[#2,Background->RGBColor[1,1,0.8]],#1],Text[Framed[#2,Background->Yellow],#1]]&)]

Limitations imposed by the paper mindset

Style[Grid[{
{"","Paper","Digital"},
{"Depth","2 dimensional","n-dimensional"},
{"Capacity","Small","Huge"},
{"Data","Frozen","Updatable"},
{"Assumptions","Frozen","Interactive"},
{"Information communicated","Human usable","Human and computer usable"},

{"Information transfer","Document ⟶ Reader","Document ⟷ Reader"},
{"Who's driving?","Author","Reader"}

},Background->{None,{Lighter[Yellow,.9],{White,Lighter[Blend[{Blue,Green}],.8]}}},Dividers->{{Darker[Gray,.6],Darker[Gray,.6],{Lighter[Gray,.5]},Darker[Gray,.6]},{Darker[Gray,.6],Darker[Gray,.6],{False},Darker[Gray,.6]}},
Alignment->Left,ItemStyle->14,Spacings->{Automatic,.8}],"Text"]

The “electronic book”

Introducing Max Whitby, CEO of Touch Press LLP and author of “The Elements”.

“The Best App of all... Alone worth iPad.” - Stephen Fry

Specialist skills have been needed

Programming has been hard

• Authors and programmers have traditionally been different people

• Publishers and software developers have traditionally been different organizations

Different outputs require different skills

• Print production

• Website development

• Application development

...have often been different teams

Over-coming the challenges

A new mindset is needed: “Documents and applications are the same thing”

Computational automation lets authors create applications

...just as word processes automated the task of typesettting

Let’s make something right now...

Manipulate[
Plot[Sin[20 x]+Sin[f x+ϕ],{x,0,10}],
{f,20,25},{ϕ,0,2π}]

Can authors really do this? 
http://demonstrations.wolfram.com

Workflow automation creates multiple outputs from one source

Write for the superset of possible target deployments and use computation to automate deployments

Needs:

• The document must be the superset of the knowledge needed for each output

• A computable document format

• Computational infrastructure

Bringing the technology together...Coming soon “CDF”

Summary

We can change the relationship between author and reader by encoding all of the knowledge into the “document” not just a summary

Computational knowledge allows a dialog with the author’s knowledge

Computational knowledge documents provide a much “wider bandwidth” of communication

Where is the value in your intellectual assets?

Credits for additional material

Principia Mathematica, Sir Isaac Newton. Images Wikipedia.

Edge Detection, Wikipedia
http://en.wikipedia.org/wiki/Edge_detection

PI Filter, Selwyn Hollis
http://demonstrations.wolfram.com/PiFilter/

Tax and Tax rates, Seth Chandler
http://demonstrations.wolfram.com/TaxRatesAndTaxRevenue/

Lawsuit Calculator, Seth Chandler
http://demonstrations.wolfram.com/LawsuitSettlementCalculator/