fpprintprec:5$ ratprint:false$
load(draw)$  set_draw_defaults( fill_color=gray40,
draw_realpart=false,font_size=10)$  kill(all)$

# Preferences and Demand

The chapter begins with analysis based on the CES utility 
function and considers Giffen good, an extension of the
inferior good analyzed in Chapter 4.

## The CES Utility Function

The first input group restates the CES utility function and the
implied function for the marginal rate of substitution.

u(x,y,a,b):=(a*x^-b+(1-a)*y^-b)^-(1/b);
mrs(x,y,a,b):=''(diff(u(x,y,a,b),x)/diff(u(x,y,a,b),y));

Given that mrs = px/py, we can state the y-to-x ratio
in terms of py/py, as in the first input below.

The second input line defines the implied expression for 
the optimal value of x, and the third line defines its 
counterpart for y.

yxratio(px,py,a,b):= ''(((px/py)*(1-a)/a)^(1/(1+b)));
xopt(px,py, m,a,b):=''(m/(px + py*yxratio(px,py,a,b)));
yopt(px,py,m,a,b):=''(xopt(px,py,m,a,b)*yxratio(px,py,a,b));

For illustration, we require some paramater values and
the initial values of px, py, and m.

[a0,b0]:[0.3,0.8]$ [px0,py0,m0]:[50,12,1200]$

The utility function can be stated as an indirect utility function, expressed 
in terms of px, py, and m, along with a and b.

The last line shows that, given the values above, the utility function and 
the indirect utility function yield the same utility level.

/*Expression for u, given that x = xopt function and y = yopt function (not values)*/
   u(xopt(px,py,m,a,b), yopt(px,py, m,a,b),a,b);
/*Expression for indirect utility function */
   v(px,py,m,a,b):=''%;    [u0:float(v(px0,py0,m0,a0,b0)),
/*Values for u as determined by v(...) and by optimal values placed into u(...) */
   float(u(xopt(px0,py0,m0,a0,b0),yopt(px0,py0,m0,a0,b0),a0,b0))];

The next input/output group assigns names to the 
initial values of xopt and yopt, and utility. 

[[xopt0,yopt0]:[xopt(px0,py0,m0,a0,b0),
 yopt(px0,py0,m0,a0,b0)], u0:u(xopt0,yopt0,a0,b0)];

### The Uncompensated Demand Curve

We now derive a demand curve for x, given u(x,y), m, py. We select two 
prices of x, one higher than the initial price and one lower than that 
price. Then, we determine the resulting quantities of x, producing three
points on the "uncompensated" demand curve. 

[px1,px2] : [25, 80]$  [xopt1,yopt1,u1]:
[xopt(px1,py0,m0,a0,b0), yopt(px1,py0,m0,a0,b0),
   u(xopt1,yopt1, a0, b0)]$ [xopt2,yopt2,u2]:
float([xopt(px2,py0,m0,a0,b0),
  yopt(px2,py0,m0,a0,b0), u(xopt2,yopt2,a0,b0)])$
matrix(["x","y","u"],[xopt1,yopt1,u1],
    [xopt0,yopt0,u0],[xopt2,yopt2,u2]);  matrix(
  ["x","p"],[xopt1,px1],[xopt0,px0],[xopt2,px2]);

The tables above show that each price results in a different
utility level, hence points on an "uncompensated" demand curve.

The next graph develops such a demand curve and the indifference
curves that represent the utility function that generates this
demand curve. We use gr2d( ) twice, to construct "scenarios,"
which are assigne names. Each gr2d( ) command does not produce
a graph; rather, it produces an object that wxdraw( ) can
place into a graph. 

First, the scenario for the indifference curves:

indiff: gr2d(user_preamble="set key bottom left",
yrange=[0, 1.1*m0/py0],xrange=[0,1.1*xopt1],xlabel="x",
ylabel="y",key="px=px0",xtics={xopt1,xopt0,xopt2},
ytics={20,80},implicit(u(x,y,a0,b0)-u0,x,1,m0/px1,
  y,1,m0/py0),key = "", explicit(m0/py0 - 
  px0*x/py0,x,0,m0/px0), line_width=2, key="px=px1",
implicit(u(x, y, a0,b0)-u1,x,1,m0/px1,y,1,m0/py0),
key ="", explicit(m0/py0 - px1*x/py0, x, 0, m0/px1), 
color = "dark-gray", key = "px=px2",
implicit(u(x, y, a0, b0)-u2, x, 1,m0/px1,y,1,m0/py0),
key="", explicit(m0/py0-px2*x/py0,x,0,m0/px2) )$

Now the demand curve object is created. The graph created
here contains the demand curve and three points on that curve.

uncompdem:gr2d(user_preamble="set key bottom left",
yrange = [0, 1.1*px2], xtics={xopt1,xopt0,xopt2},ytics= 
{px1,px0,px2},xrange=[0, 1.5*xopt1], xrange= [0,1.1*xopt1], 
xlabel="x",ylabel="$ per unit",key= "Uncomp. demand",
implicit(x-xopt(px,py0,m0,a0,b0),x,0,1.5*xopt1,px,0,100), 
key="",points( [[xopt1,px1],[xopt0,px0],[xopt2,px2]]))$

The graph:

wxdraw(indiff,uncompdem,dimensions=[480,480])$

### Compensation

The demand curve is said to be a compensated demand curve
if income changes enough so that at all prices the utility
level is the same.

The mnewton( ) program can help us define the income change that
offsets a price change. Set u(x,y,a0,b0) = u0 and  mrs(x,y,a0,b0)=px1/py0. 
Then solve for x and y. That consumption bundle must, by construction,
to do things:  (1)generate u = u0 and (2)result in mrs=px1/py0. The income 
required to buy that bundle, assigned the name m1, is the income after 
the consumer has been compensated for the price decrease.

 load(mnewton)$
/*Solve the system. Values in an embedded list. */
 soln:mnewton([u(x,y,a0,b0)-u0,mrs(x,y,a0,b0)-px1/py0],
         [x,y],[xopt0,yopt0]);  
/* Bind solutions to names */
[xcomp1, ycomp1]:[rhs(soln[1][1]),rhs(soln[1][2])]$ 
/* Determine the required money income level */
m1:px1*xcomp1+py0*ycomp1$
/*  Print the results */             matrix(
      ["xcomp","ycomp","m1","m1 - m0"],
      [xcomp1,ycomp1,m1,m1-m0]);

The compensation required for a price increase is determined likewise.

/* Solve the system and extract the list of outcomes */
soln:mnewton([u(x,y,a0,b0)-u0,mrs(x,y,a0,b0)-px2/py0],
       [x,y],[xopt0,yopt0])[1]$    
/* Bind solutions to names. Note slight difference from preceding cell.*/
[xcomp2, ycomp2]:[rhs(soln[1]), rhs(soln[2])]$ 
/*Determine the required money income level */
m2:px2*xcomp2+py0*ycomp2$   
/*Print the results*/                     matrix(
  ["xcomp","ycomp","m2","m2 - m0"],[xcomp2,ycomp2,m2,m2-m0]);

Express y as a function of x and u. Executing solve( ) generates
two questions. The answers are "n" or "no", and "p" or "pos", 
respectively. The assume( ) and declare( ) commands reduce the 
number of prompts for more information.

assume(u>0)$ declare(b,noninteger)$ 
solny:solve(u(x,y,a,b)-u,y);

To derive an expression for the inverse compensated
demand curve for x, substitute the output above for y in the 
mrs function. The resulting function pxc(u, x, py, a, b) results.

Note:
* the use of the [1] to extract the solution from the list and 
* that the rhs( ) of the expression above must be raised to the power (1/b).

pxc(u,x,py,a,b):=
''(rhs(solve(mrs(x,rhs(solny[1])^(1/b),a,b)-px/py,px)[1]));

An alternative to the quote-quote operator is the define( ) command.   

define(pxc(u,x,py,a,b), 
       rhs(solve(mrs(x,rhs(solny[1])^(1/b),a,b)-px/py,px)[1]));

The demand curve is defined for values of x, such that 
x^b > a*u^b. The expression xcrit below provides a way to
enter this restriction into the wxdraw( ) commands.

/* Critical x values */   xcrit:(a0*u0^b0)^(1/b0)$ 
print("The critical value of x is ",xcrit)$
/*The graph */
wxdraw2d(user_preamble = "set key bottom left",
 xlabel="x", ylabel="$ per unit",xrange=[0,1.1*xopt1],
 yrange=[0, 1.5*px2],point_type=filled_circle, 
 /* The uncompensated demand curve */
 key="Uncomp. demand",
 implicit(x -xopt(px,py0,m0,a0,b0),x, xcrit+.1, 
 1.5*xopt1,px,0,100),  key="", 
 /* Points on the uncompensated demand curve*/
 points([[xopt1,px1],[xopt0,px0],[xopt2,px2]]),
 line_width=2,key= "Comp. demand", 
 /* The compensated demand curve, u = u0 */
 explicit(pxc(u0,x,py0,a0,b0),x,xcrit+0.1,20), 
 /* Points in the compensated demand curve*/  key="", 
 points([[xcomp1,px1],[xopt0,px0],[xcomp2,px2] ] ),
 line_width=1, points_joined=true, point_type=1,
 line_type=dots, points([0,xopt0],[px0,px0]),
 points([0,xopt1],[px1,px1]),
 points([0,xcomp2],[px2,px2]), 
 points([xopt0,xopt0], [0,px0]) )$

The horizontal lines produce a set of trapezoids that can be used
to evaluate the effects of price changes on Consumer Surplus, as
properly measured by the compensated demand curve and as 
approximated by the uncompensated demand curve.

The commands below produce relevant values (areas for the 
pertinent demand curve when price is reduced).

comptriangle:romberg(
 pxc(u0,x,py0,a0,b0)-px1,x,xopt0,xcomp1)$
compcschange : comptriangle+(xopt0*(px0-px1))$   
matrix(  ["Comp Triangle","Comp CS change"],
        [comptriangle,compcschange]     );

The counterparts to these values but based on the uncompensated 
demand curve appear below.

[integrate(xopt(px,py,m0,a0,b0),px, px1,px0),
uncompcschange:romberg(xopt(px,py0,m0,a0,b0),px1,px0),
uncomptriangle:uncompcschange-(px0-px1)*xopt0];

An important question regards the size of the discrepancy between the 
theoretically appropriate value and its observable counterpart. The two
computations below show that for this example, the discrepancy is 
18.4 percent for the entire area. This comparison tends to give a small
discrepancy, however, because both values share a large common value,
the transfer inherent in the price change. Focusing on the change due to the
consumer's behavior shows a quite different value, with the uncompensated
demand curve yielding a value 228.95 percent larger than its counterpart for 
the uncompensated demand curve.

[(uncompcschange-compcschange)/compcschange,
(uncomptriangle-comptriangle)/comptriangle];

### An Alternative Measure

The compensation illustrated above is just one option. An alternative is 
to determine the income change required to compensate the consumer 
for forgoing a price change. The payment in lieu of a price change is called 
the equivalent variation.

For the price reduction being considered, the consumer would have
to be awarded $499.85 to compensate for not being allowed to enjoy 
the reduction. 

soln:mnewton([u(x,y,a0,b0)-u1, mrs(x,y,a0,b0)-px0/py0], 
  [x,y],[xopt0,yopt0])$ 
[[xequiv1:rhs(soln[1][1]), yequiv1: rhs(soln[1][2])], 
m3: px0*xequiv1+py0*yequiv1,m3-m0];

The graph below shows three demand curves: the uncompensated
curve, the curve based on the compensating variation, and the curve
based on the equivalent variation.

wxdraw2d(user_preamble = "set key bottom left",
 xlabel = "x", ylabel = "$ per unit", xrange= [0,1.1*xopt1],
 yrange = [0, 1.25*px2], point_type=filled_circle,  
 key = "Uncomp. demand",
 implicit(x - xopt(px,py0,m0,a0,b0), x, 
     xcrit+.1, 1.5*xopt1, px, 0, 100),   key = "", 
 points( [[xopt1,px1],[xopt0,px0],[xopt2,px2]] ), 
 points([0, xequiv1],[px0, px0]), line_width=2,
key = "Comp. demand, u = u0", 
explicit(pxc(u0,x,py0,a0,b0),x,xcrit+0.1,1.1*xopt1),
 /* Commands below relate to the equivalent variation
    compensation and to labels */
key = "Equiv. demand, u = u1", color=red,
explicit(pxc(u1,x,py0,a0,b0),x,xcrit+0.1,1.1*xopt1),
key = "", points( [[xcomp1,px1],[xopt0,px0],[xcomp2,px2]]  ), color=black,
line_width = 1, points_joined=true, point_type = 1,
line_type=dots,  points([0,xequiv1], [px0,px0]),
points([0,xopt1], [px1,px1]), points([xopt1,xopt1], 
[0,px1]), points([xequiv1, xequiv1],[px1, px0]),
points([xopt0,xopt0],[0,px0]),label(["A",xopt0-0.5, 
px0-3]),   label(["B", xcomp1, px1-3]), 
label(["C",xopt1-0.5,px1-3]),label(["D",xequiv1-.5, 
px0-3]), label(["E", xequiv1, px1-3])    )$

The computation below relates to the information in the graph.
To determine the area that corresponds to the change in consumer
surplus, calculate the area xequiv1*(p1 - p1) plus the area ECD. 
The latter area is determined with romberg( ). The area, $499.85, exceeds 
the area defined by the uncompensated demand curve, $417.86.

equivtrapezoid: (px0-px1)*xequiv1+
romberg(pxc(u1,x,py0,a0,b0)-px1,x,xequiv1,xopt1);