Project Help Notebook by Keith Stroyan

Help NoteBook Copyright 1998 by Academic Press, Inc. - All rights reserved.
Modify this Notebook to prepare your project report.

Project 29: Price Adjustment 
for Bytie Breakfast Rolls

by A . Student and B . Pupil

with technical help from Da LabMonitor and Help Notebook

The cobWeb package for graphs with lists (<Enter> it, but don't look.)

Needs["Graphics`Colors`"];

BeginPackage["Cobwebs`"]cobWeb::"usage" = 
      "cobWeb[f, p1, itnum, pmax, opns] calculates itnum iterates of the \
discrete dynamical system p[i] = p[i-1] + f[ p[i-1] ] beginning at p1 and \
draws a graph of the resulting 'cobweb'.  pmax and opns are parameters that \
specify a range for the p-axis and any options to use in drawing the plots.  \
cobWeb returns a list of the iterates it calculates."Begin["`Private`"]maxf[g_, pmax_] := 
      Block[{prange, funcvalues}, prange = Range[0, pmax, (pmax/100)]; 
        funcvalues = (g[#1]&)/@prange; Max[funcvalues, pmax]]makeWeb[iterates_List, p1_] := 
      Block[{linepoints, funcpoints, pathpoints, depth}, 
        linepoints = Drop[Transpose[{iterates, iterates}], 1]; 
        funcpoints = Partition[iterates, 2, 1]; pathpoints = {}; 
        depth = Length[funcpoints]; 
        Do[AppendTo[
            pathpoints, {
              funcpoints[[i]], 
              linepoints[[i]]}], {i, 1, 
            depth}]; pathpoints = Flatten[pathpoints, 1]; 
        pathpoints = PrependTo[pathpoints, {p1, 0}]; 
        Line[Drop[pathpoints, -1]]]cobWeb[f_, p1_, itnum_, pmax_, opns___Rule] := 
      Block[{iterates, path}, g[p_] := p + f[p]; 
        iterates = NestList[g, p1, itnum]; path = makeWeb[iterates, p1]; 
        ymax = maxf[g, pmax]; 
        Plot[{p, g[p]}, {p, 0, pmax}, PlotStyle -> {path}, opns, 
          PlotRange -> {{0, pmax}, {0, ymax}}, 
          AxesOrigin -> {0, 0}]; iterates]End[]; Protect[cobWeb]; EndPackage[];

My Project Introduction

Write this l\!\(a\_S\)t.  Begin with the b\!\(a\_S\)ic question and state your main finding clearly, but with few technical details.  You might even modify the title of this section to make it more interesting.

Hint 29.1: Supply & Demand

Re\!\(a\_D\) the project section 29.1 and the beginning of Chapter 20 on CD of the main text.  Explain your variables and parameters where demand and supply are given by the following Mathematica functions.

\(Clear[d, s, p, a, b, Subscript]; 
d[p_] := b\_D - a\_D\ p; 

    s[p_] := a\_S\ \((p - c)\); 

    Print["Aggregate supply at price p, s[p]= ", s[p]]; 
    Print["Aggregate demand at price p, d[p]=", d[p]]; \)

For example, the example in Chapter 20 on CD is:

(Subscript[a, S]) = 1000; c = 0.40; 
    Print["Aggregate supply at price p, s[p]= ", s[p]]; (Subscript[a, D]) = 500; 
    (Subscript[b, D]) = 1000; Print["Aggregate demand at price p, d[p]=", d[p]]; 
    Plot[{s[p], d[p]}, {p, 0, 2}, PlotStyle -> {Brown, Blue}, 
      PlotRange -> {0, 1200}];

Intuitive meaning of the parameters

Give the meaning of the parameters  (Subscript[a, D]), (Subscript[a, S]), (Subscript[b, D]), 
    c .

Hint 29.3: Equilibrium Price

Read the hint and explain the following computation.

\(Clear[d, s, p, a, b, c, Subscript]; 
d[p_] := b\_D - a\_D\ p; 

    s[p_] := a\_S\ \((p - c)\); 
eqPrice = Solve[d[p] == s[p], p]; 

    p\_e = p /. eqPrice[[1]]\)

In the case of the example above,

(Subscript[a, S]) = 1000; c = 0.40; (Subscript[a, D]) = 500; (Subscript[b, D]) = 1000; 
    Print["Equilibrium price = ", (Subscript[p, e])];

The Linear Economy

Hint 29.4: The Price Adjustment Model

Explain how the recursive formula

p[t + 1] = p[t] + k (d[p[t]] - s[p[t]])

adjusts prices.

The "Change Form" and "Iteration Form" of a Discrete Dynamical 
      System

This notebook will help you with the Bytie Economy Project.  It computes the `change' form of discrete dynamical systems:

p[0] = P0p[t + 1] = p[t] + f[p[t]]

where you define f[p_]:=??  The function iteration form that is used inside "cobwebs" is

p[0] = P0p[t + 1] = g[p[t]]

where g[p_] := p + f[p].  (You should be a little familiar with Chapter 12 of the text and the NoteBook FirstDynSys.mb.)

Hint 29.5: Stability

Read the Hint in the project and try the following computations before making your general conclusions.

The Specific Supply& Demand

\(a\_S = 1000; 
\(c = 0.40; \)\)\(Print["Aggregate supply at price p, s[p]= ", s[p]]; 
a\_D = 500; 

    b\_D = 1000; 
\(Print["Aggregate demand at price p, d[p]=", d[p]]; 
    \)\)Plot[{s[p], d[p]}, {p, 0, 2}, PlotStyle -> {Brown, Blue}, 
      PlotRange -> {0, 1100}]; Print["Equilibrium price = ", (Subscript[p, e])];

The Change Law and Initial Condition

f[p_] := k (d[p] - s[p]); k =  .0013; initialPrice = 1.2; numberIterations = 20; pmax = 2. ; iterates = 
      cobWeb[f, initialPrice, numberIterations, pmax, Ticks -> None]; 
    \(ListPlot[iterates, PlotJoined -> True, 
      PlotRange -> {0, 1.5}]; 
lastnrs = Take[iterates, \(-6\)]\)

Daily Demands

demands = d[iterates]

Demand at Equilibrium Price

We computed the equilibrium price above, but let's check to be sure Mathematica knows it now.

(Subscript[p, e])

Now use the equilibrium to calculate demand at equilibrium

d[(Subscript[p, e])]

Profit at Equilibrium

((Subscript[p, e]) - c) d[(Subscript[p, e])]

Daily Profits

profits = (iterates - c) d[iterates]

ListPlot[profits, PlotJoined -> True, PlotStyle -> Red];

Change in Profit vs Total Tax

profit[c_] := 
      (((Subscript[a, S]) ((((Subscript[b, D]) - (Subscript[a, D]) c))^2))/((((Subscript[a, D]) + (Subscript[a, S])))^2)); profit[ .4] - profit[ .45]

Total Tax

.05 d[(Subscript[p, e])]

The above help with Mathematica should be sufficient to support your solution of the remaining hints.