“So intellectual education is measured, not by words heard or read,but by thoughts excited.”
Stanley Jevons (1877)

Introduction to Mathematica for Economics, 
Commerce and Business Academics and Students
School of Commerce Research Seminar Series (May 2003)
Flinders University, South Australia  
Jim Larkin. School of Commerce, Flinders University 
Wolfram’s Mathematica is a computer software program which combines powerful symbolic manipulation and number-crunching capabilities with impressive 2D and 3D graphics-production all caged within a sophisticated and powerful programming language. This software technology has incredible potential and endless applications in the education of commerce and business students (broadly construed) especially but not only in the disciplines of finance and investment science, economics and statistics and a few areas in accountancy. Potentialities are magnified in distance education: Using Mathematica the production of interactive teaching materials of prodigious pedagogical power is scarcely more difficult than typing a letter in Word. This seminar presentation and 'research paper' - itself a Mathematica notebook - provides an introduction to Mathematica and illustrates its power and utility with original examples taken from cost and management accounting, financial mathematics, statistical theory, microeconomics/game theory, and investment science.

A Mathematica Notebook (by Jim Larkin)

“It has been well said that the highest aim in education is analogous to the highest aim in mathematics, namely,
  to obtain not results but powers, not particular solutions, but the means by which endless solutions may be wrought.”
George Elliot (Essay on Carlyle)

1 - Introduction to Calculation and Symbolic Manipulation with Mathematica

Remove["Global`*"];
Off[General::spell];
SetOptions[Plot, ImageSize -> 200];

10 + 11

10 - 5
5*5
5^2
20/2

2^200

2^2000

Pi // N
E // N

N[Pi, 200]
N[E, 200]

Clear[a, x, b, c];
y = a*(x^2) + b*x - c

Solve[y == 0, x]

D[a, x]

D[a*(x^k), x]

D[(x^k) + (x^m), x]

D[f[x] + g[x], x]
D[f[x] - g[x], x]

D[f[x]*g[x], x]
D[f[x]/g[x], x]

D[f[g[x]], x]

Integrate[f[x], x]

Integrate[c, x]
Integrate[a*(x^k), x]

Integrate[Sin[x], {x, 2  π, 3  π}]

Remove["Global`*"];
A=(({{a, b}, {c, d}}));bvector = {e, f};
solvector = 
      Simplify[Inverse[A] . bvector]

solvector  =  LinearSolve[A, bvector]

Remove["Global`*"];
A=(({{a, b, c}, {d, e, f}, {g, h, i}}));bvector=(({{π}, {θ}, {ρ}}));
solvector = solvector = 
        Simplify[Inverse[A] . bvector]

Table[(Subscript[x, i]), {i, 1, 10}]

Sum[(Subscript[x, i]), {i, 1, 10}]

Sum[(Subscript[x, i]), {i, 1, n}]

Sum[(((1 + i))^k), {k, 1, 10}]

Product[(Subscript[x, i]), {i, 1, 10}]

Product[(Subscript[x, i]), {i, 1, n}]

Needs["Graphics`PlotField`"]
Clear[x, y]; 
    PlotVectorField[{x + y, x - y}, {x, -3, 3}, {y, -3, 3}, 
      ColorFunction -> Hue, ScaleFunction -> (1 &), Axes -> True, 
      AxesLabel -> {"x", "y"}, ImageSize -> 300];

2 - Mathematica for 2D and 3D Graphics

Plot[(x^2),{x, -10, 10},ImageSize -> 200,AxesLabel -> {"x", "y"},PlotStyle -> {Thickness[0.02], 
                RGBColor[0.9, 0.1, 0]}];

Plot[Log[x],{x, 1, 100},ImageSize -> 200,AxesLabel -> {"x", "y"},PlotStyle -> {Thickness[0.02], RGBColor[0, 0, 1]}];

Plot[(E^x),{x, 1, 10},ImageSize -> 200,AxesLabel -> {"x", "y"},PlotStyle -> {Thickness[0.02], Hue[Random[]]}];

Plot[1/x,{x, 1, 10},ImageSize -> 200,AxesLabel -> {"x", "y"},PlotStyle -> {Thickness[0.02], Hue[Random[]]}];

Plot[{Sin[x], Cos[x]},{x, 0, 4  π},ImageSize -> 200,AxesLabel -> {"x", "y"},PlotStyle -> {{Thickness[0.02], 
                  Hue[Random[]]}, {Thickness[0.03], Hue[Random[]]}}];

Clear[y, u, v];
y = 5  u - u^2 + v - v^2;
Plot3D[y, {u, -1000, 1000}, {v, -1000, 1000}, 
        ImageSize -> 250];

Q = 10  L^ .6 K^ .4;
Plot3D[Q, {L, 0, 15}, {K, 0, 1000}, 
        LightSources -> {{{1. , 0. , 1. }, 
              RGBColor[0.5, 0, 0.5]}, {{1. , 1. , 1. }, 
              RGBColor[1, 0.5, 0.6]}, {{0. , 1. , 1. }, RGBColor[0, 0, 1]}}, 
        AxesLabel -> {"L", "K", "Q"}, 
        ImageSize -> 225];

3 - Illustration of Mathematical Ideas: 'Domination of higher power terms'
Example based on Calculus & Mathematica, 1999. Bill Davis et al. matheverywhere, inc.

Plot[(x^3),{x, -10, 10},ImageSize -> 200,PlotStyle -> {{RGBColor[1, 0, 0], 
                  Thickness[0.02]}}];
Plot[(x^4),{x, -10, 10},ImageSize -> 200,PlotStyle -> {{RGBColor[0, 0, 1], 
                  Thickness[0.02]}}];

(* 
      What about the plot of  (x^3) + (x^4)   ? *)

Plot[{(x^3) + (x^4)},{x, -0.5, 0.5},ImageSize -> 200,PlotStyle -> {{Hue[Random[]], Thickness[0.02]}}];
Plot[{(x^3) + (x^4)},{x, -1, 1},ImageSize -> 200,PlotStyle -> {{Hue[Random[]], Thickness[0.02]}}];

Plot[{(x^3) + (x^4)},{x, -2, 2},ImageSize -> 200,PlotStyle -> {{Hue[Random[]], Thickness[0.02]}}];
Plot[{(x^3) + (x^4)},{x, -5, 5},ImageSize -> 200,PlotStyle -> {{Hue[Random[]], Thickness[0.02]}}];

4 - Comprehensive Illustrations from  Accounting, Finance, Statistical Theory,
 Investment Science and Microeconomics/ Game Theory

Comprehensive Illustration 1 - CVP analysis

{TC = TFC + q*VCu, "...", 
      TR = p*q, "...", Π = TR - TC}

Solve[Π == 0, q]
(Subscript[q, BE]) = 
      q /. Solve[Π == 0, 
            q][[1]]
(Subscript[q, π]) = 
      q /. Solve[Π == targetΠ, 
            q][[1]]

{  Solve[Π == targetΠ, q], "...", 
      Solve[Π == targetΠ, p], "...", 
      Solve[Π == targetΠ, VCu], "...", 
      Solve[Π == targetΠ, TFC]  }

Block[{TFC = 500, p = 10, VCu = 5}, Plot[{TR, TC, Π}, {q, 0, 200}]]; Block[{TFC = 500, VCu = 5}, Plot[(Subscript[q, BE]), {p, 0, 50}]];Block[{TFC = 500, p = 10}, Plot[(Subscript[q, BE]), {VCu, 0, 15}]]; Block[{p = 10, VCu = 5}, Plot[(Subscript[q, BE]), {TFC, 0, 1000}]]  ;

{  (Subscript[q, BE]) /. {TFC -> 500, p -> 10, 
          VCu -> 5}, "...",   (Subscript[q, π]) /. {TFC -> 500, 
          p -> 10, VCu -> 5, 
          targetΠ -> 100}    }

Block[{TFC = 500}, 
            Plot[Evaluate[Table[(Subscript[q, BE]), {VCu, 0, 50, 5}]], {p, 0, 50}, 
              ImageSize -> 150, PlotRange -> {0, 100}]];

Comprehensive Illustration 2 - Financial maths : Compounding and discounting
Present and future values of ordinary simple annuities and of single amounts with continuous compounding

Some Formula derivations

Clear[A];

Sum[A*(((1 + i))^(-k)), {k, 1, n}] // Simplify

Sum[A*(((1 + i))^k), {k, n - 1, 0, -1}]

Limit[presentAmt*(((1 + (r/m)))^(m*t)), 
      m -> ∞]

Limit[futureAmt*(((1 + (r/m)))^(-m*t)), 
      m -> ∞]

Some User Defined Functions

(* 
      Creating a FV of a single amount function *) 
FV[PV_, r_, m_, t_] := 
      PV*(((1 + r/m))^(t*m))
FV[PV, r, m, t]

FV[100, 0.1, 1, 10]

(* 
      Creating a PV of a single amount function *) 
PV[FV_, r_, m_, t_] := 
      FV*(((1 + r/m))^(-t*m))
PV[FV, r, m, t]

PV[100, 0.1, 1, 3]

FVA[
        A_, r_, m_, t_] := 
      A*((((1 + r/m))^(t*m)) - 1)/(r/m)
FVA[A, r, m, t]

FVA[1, 0.1, 1, 3]

PVA[
        A_, r_, m_, t_] := 
      A*(1 - (((1 + r/m))^(-t*m)))/(r/
              m)
PVA[A, r, m, t]

PVA[1, 0.1, 1, 3]

PVA[20000, 0.185, 1, 25]

Table[{t,  PV[1, 0.10, 1, t], PV[10000, 0.10, 1, t]}, {t, 0, 12, 1}] // 
      TableForm

data1 = 
        Table[1*(((1 + i))^n), {n, 1, 10}, {i, 0.05, 0.25, 
            0.05}];
\(table1 = 
      TableForm[data1, 
        TableHeadings -> {Automatic, {"0.05", "0.1", "0.15", "0.20", "0.25"}}]\)

\(table2 = 
      TableForm[
        Table[1*\((1 + i)\)\^\(-n\), {n, 1, 10}, {i, 0.05, 0.25, 0.05}], 
        TableHeadings -> {Automatic, {"0.05", "0.1", "0.15", "0.20", "0.25"}}]\)

table3=TableForm[Table[((((1 + i))^n) - 1)/i, {n, 1, 10}, {i, 0.05, 
              0.25, 0.05}],\(TableHeadings -> {Automatic, {"0.05", "0.1", "0.15", "0.20", "0.25"}}\)]

table4=TableForm[Table[(1 - (((1 + i))^(-n)))/i, {n, 1, 10}, {i, 
              0.05, 0.25, 0.05}],\(TableHeadings -> {Automatic, {"0.05", "0.1", "0.15", "0.20", "0.25"}}\)]

Clear[t, r]; r = 1.0; t = 1;
Table[{m, 1*(((1 + r/m))^(m*t))}, {m, 1, 100000, 10000}] // 
      TableForm

Some financial maths additions

Solve[FV == PV*(((1 + i))^n), n]

Solve[FV == PV*(((1 + i))^n), i]

Solve[FV == PV*(((1 + i))^n), PV]

Solve[FVA == A*((((1 + i))^n) - 1)/i, n]

Solve[FVA == A*((((1 + i))^n) - 1)/i, A]

Solve[FVA == A*((((1 + i))^n) - 1)/i, i]

Solve[PVA == A*(1 - (((1 + i))^(-n)))/i, n]

Solve[PVA == A*(1 - (((1 + i))^(-n)))/i, A]

Solve[FVA == A*(1 - (((1 + i))^(-n)))/i, i]

Comprehensive Illustration 3 - Net present value and IRR analysis

Clear[r]; 
    NPV3yr = CF0 + CF1*(((1 + r))^(-1)) + CF2*(((1 + r))^(-2)) + 
        CF3*(((1 + r))^(-3))

cashflows = {CF0 = -1000, CF1 = 400, CF2 = 500, 
          CF3 = 400};
Plot[NPV3yr,{r, 0,  .30},AxesLabel -> {"r", "NPV"},PlotStyle -> {Thickness[0.015], 
                RGBColor[1, 0, 0.5]},TextStyle -> textprefs,AxesOrigin -> {0, 0},PlotRange -> {-200, 350},ImageSize -> 225,Ticks -> {{0.05, 0.15,  .25}, Automatic}];

Solve[NPV3yr == 0, r] // N

Comprehensive Illustration 4 - Investment science I: An asset's 'characteristic line' and 'beta' (regression analysis)

<<Statistics`LinearRegression`
<<Graphics`MultipleListPlot`
mktdata = {{0.09, 0.12},{0.20, 0.23},{0.08, 0.07},{0.13, 0.15},{0.01, -0.05},{0.14, 0.12},{0.10, 0.13},{-0.05, -0.10},{0.14, 0.07},{0.07, 0.06},{0.09, 0.06}};
mktdataG = ListPlot[mktdata, PlotJoined -> False, PlotStyle -> {Hue[0.65], PointSize[0.03]}, AxesLabel -> {"Rm","Ri"},TextStyle -> {FontSize -> 12}];

The data set 'mktdata' - called a list in Mathematica - consists of {(Subscript[R, m, k]), (Subscript[R, i, k])} for k = 1, ..., 11, where (Subscript[R, m, k]) is the rate of return on the 'market' in period k and (Subscript[R, i, k]) is the rate of return on individual stock i  in period k.

dataresults = 
      Regress[mktdata, {1, x}, x, 
        RegressionReport -> {ParameterTable, 
            AdjustedRSquared}]

StoredResults=Regress[mktdata, {1, x}, x, 
            RegressionReport -> {SinglePredictionCITable, 
                ParameterConfidenceRegion, FitResiduals}];{observed, predicted, se, ci} = 
          Transpose[(SinglePredictionCITable /. 
                  StoredResults)[[1]]];
(xval = Map[First, mktdata]; 
          predicted = 
            Transpose[{xval, predicted}]; 
lowerCI = 
            Transpose[{xval, Map[First, ci]}]; 
          upperCI = Transpose[{xval, Map[Last, ci]}]);

\(\(fittedG = 
          ListPlot[predicted, PlotJoined -> True, 
            AxesLabel -> {\*""(Subscript[R, i])"", \*""(Subscript[R, m])""}, TextStyle -> {FontSize -> 12}, 
            DisplayFunction -> Identity];\)

      \(CIsG = 
          MultipleListPlot[lowerCI, upperCI, PlotJoined -> {True, True}, 
            PlotStyle -> {Dashing[{ .05, 0.25}], Dashing[{ .05, 0.25}]}, 
            DisplayFunction -> Identity];\)

      \(Show[mktdataG, fittedG, CIsG, 
          PlotLabel -> "              Stock i's Characteristic Line", 
          ImageSize -> 315, 
          DisplayFunction -> $DisplayFunction];\)\)

Comprehensive Illustration 5 - Financial maths & decision making: Business Valuation
A small business owner making an accounting profit of $109000 annually (without deducting a salary) is offered $1 million for the business. Should they sell ?

accgprofit = 109000;

Business Valuation 1:  What would have been once called the accountant's approach

Clear[i]; i = Table[i, {i, 0.05, 0.40, 0.05}];

busval1 = Table[accgprofit/i, {i, 0.05, 0.40, 0.05}]

g =  0.05;  
    busval2 = 
      Table[accgprofit*((1 + g)/(i - g)), {i, 0.05, 0.40, 
          0.05}]

n = 20;  g =  0.15;
busval3 = 
        Table[Sum[
            accgprofit*((((1 + g))^k)/(((1 + i))^k)), {k, 1, n}], {i, 
            0.05, 0.40, 0.05}];
n = 6;  g =  0.10;
busval4 = 
        Table[Sum[
            accgprofit*((((1 + g))^k)/(((1 + i))^k)), {k, 1, n}], {i, 
            0.05, 0.40, 0.05}];
n = 3;  g =  0.05; 
busval5 = 
        Table[Sum[
            accgprofit*((((1 + g))^k)/(((1 + i))^k)), {k, 1, n}], {i, 
            0.05, 0.40, 0.05}];

\(TableForm[{{i, busval1, busval2, busval3, busval4, busval5}}, 
      TableHeadings -> {{"Accg(V)"}, {"cost (r)", "infiniteY", "∞, g=5%", "20yr,g=15%", "6yr,g=10%", "3yr,g=5%"}}]\)

Business Valuation 2:  What would have been once called the economist's approach

salary = 45000; 
    ecoprofit1 = accgprofit - salary;
busval5 = 
        Table[ecoprofit1/i, {i, 0.05, 0.40, 
            0.05}];
 g =  0.05;  
    busval6 = 
      Table[ecoprofit1*((1 + g)/(i - g)), {i, 0.05, 0.40, 
          0.05}];

n = 20;  g =  0.15;
busval7 = 
        Table[Sum[
            ecoprofit1*((((1 + g))^k)/(((1 + i))^k)), {k, 1, n}], {i, 
            0.05, 0.40, 0.05}];
n = 6;  g =  0.10;
busval8 = 
        Table[Sum[
            ecoprofit1*((((1 + g))^k)/(((1 + i))^k)), {k, 1, n}], {i, 
            0.05, 0.40, 0.05}];
n = 3;  g =  0.05; 
busval9 = 
        Table[Sum[
            ecoprofit1*((((1 + g))^k)/(((1 + i))^k)), {k, 1, n}], {i, 
            0.05, 0.40, 0.05}];
\(TableForm[{{i, busval5, busval6, busval7, busval8, busval9}}, 
      TableHeadings -> {{"Eco(V)"}, {"cost (r)", "infiniteY", "∞, g=5%", "20yr,g=15%", "6yr,g=10%", "3yr,g=5%"}}]\)

(My) Conclusion Advice : subject to  the standard assumption that labour or work is a negative argument in the 
agent's utility function sell the restaurant for $1,000,000 and do it  now  !

Note on use of Mathematica session : Clearing user defined functions

?"Global`*"

Clear["Global`*"]

?"Global`*"

Remove["Global`*"]

?"Global`*"

End of Mathematica Notebook (by Jim Larkin)