# Solve Lagrange-multliplier with arrow-security prices with nonlinear (exp) utility function

at the moment I have successfully solved the Demand function for securities in the following model:

t=0 current time, 2 uncertain states with same probability in period 2 indexed with i=1 and i=2.

Other vectors are:

endowments $\left[ e_0,e_1,e_2 \right]$ ; consumption $\left[ y_0,y_1,y_2 \right]or\left[ c_0,c_1,c_2 \right]$ ; expenses for securities $\left[q_1 \cdot \theta _1 +q_2 \cdot \theta _2 \right]$ (price times its quantity of demand). The payoffs of the securities in period 2 will be: $a_1=\left[ 1,1 \right] a_2=\left[ 1,2 \right]$ , where columns adhere to either one security.

So we assume $q_2$ is a stock paper to pay out more in uncertain state 2 of period 2 (should its price be higher or return lower than $q_1$ by the general equilibrium theory? )

Some other intermediate vectors are used to ease calculations. Matrix or list notation is used throughout where possible to account for more states in the future application, even more periods with more market participants than solo.

So essentially We want to solve the following: The utility function is quadratic (works also with Log-utility correctly) and the lagrange equation becomes (when no arbitrage are conditioned on the $q_s \to q_1 = p_1 + p_2 \space ; \space q_2=p_1+2p_2$: My code becomes:

     ClearAll["Global*"]
Remove["Global*"]

n:=2 (* there are two uncertain states, this parameter is very important here! *)

cons:=Table[Subscript[y, i-1],{i,n+1}]
prices:=Table[Subscript[p, i],{i,n}]
qprices:=Table[Subscript[q, i],{i,n}]
probs:=Table[Subscript[(π), i],{i,n}]
wqp:=Table[Subscript[w, i],{i,n}]
theta:=Table[Subscript[θ, i],{i,n}]
endows:=Table[Subscript[e, i-1],{i,n+1}]
solv:=Table[Subscript[(sol), i],{i,n+2}]
mat:=Table[Subscript[m, i,j],{i,n+1},{j,n+1}];
parmat :=mat[[1;;-1,2;;-1]];  (*I subdivide the m matrix, is a bit clumsy to use here*)
fixmat :=mat[[1;;-1,1;;1]];
parmat
fixmat
ArrayFlatten[{{parmat,fixmat}}]
Vf[j_]:=cons[[j]]-α*cons[[j]]^2
pay:=Table[Subscript[a, i,j],{i,n},{j,n}]
baby:=Table[Subscript[g, i,j],{i,n},{j,n}]
ident:=ConstantArray[1,{1,2}]
ident
fixmat

probs={0.5,0.5}
pay={{1,1},{1,2}}
endows={10,0,0}
β=1

α=(1/100)

(*till lagra setup some matrix products and easy linear equations are  solved to create the restriction equation, some equations here are maybe superfluous *)

parmat={(-1)*qprices,pay[],pay[]}
(* not used: parmat2={(-1)*prices.pay,pay[],pay[]} *)

fixmat={{-Subscript[y, 0]+endows[]},{Subscript[y, 1]-endows[]},{Subscript[y, 2]-endows[]}}
allmat=ArrayFlatten[{{parmat,fixmat}}]
allmat2 := allmat[[2;;-1,1;;-1]]
allmat3= RowReduce[allmat2]

allmatt4={{pay[].prices},{pay[].prices}}

Do[(Subscript[(θ), i])=allmat3[[i,3]],{i,1,n}]

Do[Subscript[w, i]=allmatt4[[i]],{i,1,n}]
allmat6:=allmat[[1;;1,1;;-1]]
NB:=-fixmat[]+theta.allmatt4
Subscript[t, 0]=Simplify[NB]

i=1; While[i<=n,Subscript[t, i]=Collect[Subscript[t, i-1],Subscript[p, i]];i++]

lagra=Vf+β * Sum[probs[[i-1]]*Vf[i],{i,2,n+1}]-λ*(Subscript[t, n])
lagra
λ:=Subscript[y, -1]
deriv:=D[lagra,{Table[Subscript[y, i-1],{i,0,n+1}]}]
s=Solve[deriv ==0,Table[Subscript[y, i-1],{i,0,n+1}]]
i=1; While[i<= n+2,Subscript[(sol), i]=s[[All,i,2]];i++]
Do[Subscript[y, i]=Subscript[(sol), i+2],{i,0,2}] (*apply solution of solv vector to my original cons[ y..] vector *)
cons
Simplify[theta[]]
Subscript[q, 1]=1
Subscript[p, 1]=2Subscript[q, 1]-Subscript[q, 2] (*input here explicitly but this equation should follow out of rowreduce of one of the matrix above, but i could not work this out *)
Subscript[p, 2]=Subscript[q, 2]-Subscript[q, 1] (* same here *)

Simplify[theta[]]


As textbook solutions suggest the thetas are [($e_1,e_2$)=0] when $q_1$=1 is given (stated in problem with solution, but not needed for a even more general algrebaic computation when $q_1$ is unknown) : My output with the stated code is correct here: $\left\{\frac{50. q_2^2-15. q_2-87.5}{1. q_2^2-3. q_2+2.75}\right\}$ And $\left\{\frac{135.\, -90. q_2}{1. q_2^2-3. q_2+2.75}\right\}$

So that procedure works, BUT Using exponential utility function:

    Vf[j_] := Exp[cons[[j]]]


The solve or reduce function of mathematica won't yield explicit solutions to work with. Does anybody know how to resolve this? Log-utility strangely does work!

The textbook solution with exponential utility function (again with $q_1$=1) is: The consumption vector for this solution is: Thanks very much! I've just started with mathematica in my financial economics preperation.

• Welcome to Mathematica.SE! I suggest the following: 1) As you receive help, try to give it too, by answering questions in your area of expertise. 2) Read the faq! 3) When you see good questions and answers, vote them up by clicking the gray triangles, because the credibility of the system is based on the reputation gained by users sharing their knowledge. Also, please remember to accept the answer, if any, that solves your problem, by clicking the checkmark sign! – user9660 Mar 16 '15 at 16:41
• You have equations 10 - Subscript[y, 0] - Subscript[p, 1] Subscript[y, 1] - Subscript[p, 2] Subscript[y, 2], E^Subscript[y, 0] - Subscript[y, -1], 0.5 E^Subscript[y, 1] - Subscript[p, 1] Subscript[y, -1], 0.5 E^Subscript[y, 2] - Subscript[p, 2] Subscript[y, -1]} which are not polynomials. They can perhaps be solved exactly for explicit numerical values of the p parameters. At the least I would expect they can be approximately solved in that case using FindRoot. – Daniel Lichtblau Mar 16 '15 at 18:10
• Hello Daniel, thank you very much for your response. I also noticed that the computation would get stuck when evaluating ($y_2$ won't get resolved, even implicitly). I did consider FindRoot, but I fail at setting up the expression correctly as the function demands a starting point. The message is: Solve::inex: Solve was unable to solve the system with inexact coefficients or the system obtained by direct rationalization of inexact numbers present in the system. – chrisoutwright Mar 16 '15 at 18:23