Message Boards

WOLFRAM COMMUNITY

6491 Views

2 Replies

1 Total Likes

View groups...

Follow this post

Share this post:

GROUPS:

Economics Mathematica

Solving set of equations

Songklod Rastapana

Posted 10 years ago

I have been trying to solve set of equations with four parameters; pi, [Lambda]h, [Lambda]l, R and six variables ys, ds, yr, dr, ph, and pl. Firstly, I solved ys, ds, yr, and dr as a function of four parameters and 2 variables (ph and pl). Secondly, I plugged in the solutions of ys, ds, yr, and dr into defined functions called indiff and mkt. Finally, I tried to solve ph and pl from indiff and mkt using Solve. However, I got two problem; 1) ys and ds have not been plugged into indiff and mkt. I am not sure what's wrong with the code here. 2) Solve doesn't work as the program have run for a long time without any output (I have also tried reduce and eliminate but those seem not working too :(. In this case, I am not sure if the solution exists or there is something wrong with the code. I am also not sure if there is solutions in this case. If there is no solution, it might be a good idea to try numerical approach. Any helps would be greatly appreciated. ClearAll["Global`"] EU = Log[#] &; (__________________________________________________________________) temp = Solve[((pi(1 - \[Lambda]h)(1 - ph)) / (ys + ph(1 - ys) - \[Lambda]hds)) + (((1 - pi)(1 - \[Lambda]l)(1 - pl)) / (ys +pl(1 - ys) - \[Lambda]lds)) == 0 && (pi\[Lambda]h((1/ ds) - (1 - \[Lambda]h)/(ys + ph(1 - ys) - \[Lambda]hds)) + (1 -pi)\[Lambda]l((1/ds) - (1 - \[Lambda]l)/(ys + pl(1 - ys) - \[Lambda]lds)) ) == 0, {ys, ds}] FullDefinition[temp] ys[a_, b_, c_, d_, e_, f_] := ys /. temp[[1, 1]] /. {pi -> a, \[Lambda]h -> b, \[Lambda]l -> c,R -> d, ph -> e, pl -> f} ds[a_, b_, c_, d_, e_, f_] :=ds /. temp[[1, 2]] /. {pi -> a, \[Lambda]h -> b, \[Lambda]l -> c,R -> d, ph -> e, pl -> f} ys[pi, \[Lambda]h, \[Lambda]l, R, ph, pl] ds[pi, \[Lambda]h, \[Lambda]l, R, ph, pl] (____________________________________________________________________) temp = Solve[((pi(1 - ph)) / (yr + ph(1 - yr))) + (((1 - pi)(1 - \[Lambda]l)(1 - pl)) / (yr + pl(1 - yr) - \[Lambda]ldr)) ==0 && (1 - pi)\[Lambda]l((1/dr) - (1 - \[Lambda]l)/(yr + pl(1 - yr) - \[Lambda]ldr)) ==0, {yr, dr}] FullDefinition[temp] yr[a_, b_, c_, d_, e_, f_] := yr /. temp[[1, 1]] /. {pi -> a, \[Lambda]h -> b, \[Lambda]l -> c,R -> d, ph -> e, pl -> f} dr[a_, b_, c_, d_, e_, f_] :=dr /. temp[[1, 2]] /. {pi -> a, \[Lambda]h -> b, \[Lambda]l -> c, R -> d, ph -> e, pl -> f} yr[pi, \[Lambda]h, \[Lambda]l, R, ph, pl] dr[pi, \[Lambda]h, \[Lambda]l, R, ph, pl] (___________________________________________________________________) indiff[pi_, \[Lambda]h_, \[Lambda]l_, R_, ph_,pl_] := ((pi(\[Lambda]hEU[ds] + (1 - \[Lambda]h)EU[((ys +ph(1 - ys) - \[Lambda]hds)/((1 - \[Lambda]h)(ph/R)))]) + (1 -pi)(\[Lambda]lEU[ds] + (1 - \[Lambda]l)EU[((ys + pl(1 - ys) - \[Lambda]lds)/((1 - \[Lambda]l)(pl/R)))])) - (pi(\[Lambda]hEU[(yr + ph(1 - yr))] + (1 - \[Lambda]h)EU[(yr + ph(1 - yr))]) + (1 -pi)(\[Lambda]lEU[dr] + (1 - \[Lambda]l)* EU[((yr +pl(1 - yr) - \[Lambda]ldr)/((1 - \[Lambda]l)(pl/R)))]))) /. {ys ->ys[pi, \[Lambda]h, \[Lambda]l, R, ph, pl],ds -> ds[pi, \[Lambda]h, \[Lambda]l, R, ph, pl],yr -> yr[pi, \[Lambda]h, \[Lambda]l, R, ph, pl],dr -> dr[pi, \[Lambda]h, \[Lambda]l, R, ph, pl]} indiff[pi, \[Lambda]h, \[Lambda]l, R, ph, pl] (_____________________________________________________________________) mkt [pi_, \[Lambda]h_, \[Lambda]l_, R_, ph_,pl_] := (ys - \[Lambda]lds)/((ys - \[Lambda]hds)/ph) - (\[Lambda]ldr - yr)/(1 - yr) /. {ys ->ys[pi, \[Lambda]h, \[Lambda]l, R, ph, pl], ds -> ds[pi, \[Lambda]h, \[Lambda]l, R, ph, pl], yr -> yr[pi, \[Lambda]h, \[Lambda]l, R, ph, pl],dr -> dr[pi, \[Lambda]h, \[Lambda]l, R, ph, pl]} mkt[pi, \[Lambda]h, \[Lambda]l, R, ph, pl] (____________________________________________________________________) Solve[mkt[pi, \[Lambda]h, \[Lambda]l, R, ph, pl] == 0 &&indiff[pi, \[Lambda]h, \[Lambda]l, R, ph, pl] == 0, {ph, pl}] Panel[With[{mktt = mkt[pi, \[Lambda]h, \[Lambda]l, R, ph, pl], indifft = indiff[pi, \[Lambda]h, \[Lambda]l, R, ph, pl]}, Manipulate[ Plot3D[{mktt, indifft}, {ph, 0, 1}, {pl, 1, 5}], {pi, 0,1}, {\[Lambda]h, 0, 1}, {\[Lambda]l, 0, 1}, {R, 1, 5}]], "Check if the solution exists"]

I have been trying to solve set of equations with four parameters; pi, [Lambda]h, [Lambda]l, R and six variables ys, ds, yr, dr, ph, and pl. Firstly, I solved ys, ds, yr, and dr as a function of four parameters and 2 variables (ph and pl). Secondly, I plugged in the solutions of ys, ds, yr, and dr into defined functions called indiff and mkt. Finally, I tried to solve ph and pl from indiff and mkt using Solve.

However, I got two problem; 1) ys and ds have not been plugged into indiff and mkt. I am not sure what's wrong with the code here. 2) Solve doesn't work as the program have run for a long time without any output (I have also tried reduce and eliminate but those seem not working too :(. In this case, I am not sure if the solution exists or there is something wrong with the code. I am also not sure if there is solutions in this case. If there is no solution, it might be a good idea to try numerical approach.

Any helps would be greatly appreciated.

ClearAll["Global`*"]

EU = Log[#] &;

(*__________________________________________________________________*)
temp = Solve[((pi*(1 - \[Lambda]h)*(1 - ph)) / (ys + ph*(1 - ys) - \[Lambda]h*ds)) + (((1 - pi)*(1 - \[Lambda]l)*(1 - pl)) / (ys +pl*(1 - ys) - \[Lambda]l*ds)) == 0 && (pi*\[Lambda]h*((1/ ds) - (1 - \[Lambda]h)/(ys + ph*(1 - ys) - \[Lambda]h*ds))  +  (1 -pi)*\[Lambda]l*((1/ds) - (1 - \[Lambda]l)/(ys + pl*(1 - ys) - \[Lambda]l*ds)) ) == 0, {ys, ds}]

FullDefinition[temp]

ys[a_, b_, c_, d_, e_, f_] := ys /. temp[[1, 1]] /. {pi -> a, \[Lambda]h -> b, \[Lambda]l -> c,R -> d, ph -> e, pl -> f}
ds[a_, b_, c_, d_, e_, f_] :=ds /. temp[[1, 2]] /. {pi -> a, \[Lambda]h -> b, \[Lambda]l -> c,R -> d, ph -> e, pl -> f}

ys[pi, \[Lambda]h, \[Lambda]l, R, ph, pl]
ds[pi, \[Lambda]h, \[Lambda]l, R, ph, pl]

(*____________________________________________________________________*)
temp = Solve[((pi*(1 - ph)) / (yr + ph*(1 - yr))) + (((1 - pi)*(1 - \[Lambda]l)*(1 - pl)) / (yr + pl*(1 - yr) - \[Lambda]l*dr)) ==0 && (1 - pi)*\[Lambda]l*((1/dr) - (1 - \[Lambda]l)/(yr + pl*(1 - yr) - \[Lambda]l*dr))  ==0, {yr, dr}]

FullDefinition[temp]

yr[a_, b_, c_, d_, e_, f_] := yr /. temp[[1, 1]] /. {pi -> a, \[Lambda]h -> b, \[Lambda]l -> c,R -> d, ph -> e, pl -> f}
dr[a_, b_, c_, d_, e_, f_] :=dr /. temp[[1, 2]] /. {pi -> a, \[Lambda]h -> b, \[Lambda]l -> c, R -> d, ph -> e, pl -> f}

yr[pi, \[Lambda]h, \[Lambda]l, R, ph, pl]
dr[pi, \[Lambda]h, \[Lambda]l, R, ph, pl]

(*___________________________________________________________________*)
indiff[pi_, \[Lambda]h_, \[Lambda]l_, R_, ph_,pl_] := ((pi*(\[Lambda]h*EU[ds] + (1 - \[Lambda]h)*EU[((ys +ph*(1 - ys) - \[Lambda]h*ds)/((1 - \[Lambda]h)*(ph/R)))]) + (1 -pi)*(\[Lambda]l*EU[ds] + (1 - \[Lambda]l)*EU[((ys + pl*(1 - ys) - \[Lambda]l*ds)/((1 - \[Lambda]l)*(pl/R)))])) - (pi*(\[Lambda]h*EU[(yr + ph*(1 - yr))] + (1 - \[Lambda]h)*EU[(yr + ph*(1 - yr))]) + (1 -pi)*(\[Lambda]l*EU[dr] + (1 - \[Lambda]l)* EU[((yr +pl*(1 - yr) - \[Lambda]l*dr)/((1 - \[Lambda]l)*(pl/R)))]))) /. {ys ->ys[pi, \[Lambda]h, \[Lambda]l, R, ph, pl],ds -> ds[pi, \[Lambda]h, \[Lambda]l, R, ph, pl],yr -> yr[pi, \[Lambda]h, \[Lambda]l, R, ph, pl],dr -> dr[pi, \[Lambda]h, \[Lambda]l, R, ph, pl]}

indiff[pi, \[Lambda]h, \[Lambda]l, R, ph, pl]

(*_____________________________________________________________________*)
mkt [pi_, \[Lambda]h_, \[Lambda]l_, R_, ph_,pl_] := (ys - \[Lambda]l*ds)/((ys - \[Lambda]h*ds)/ph) - (\[Lambda]l*dr - yr)/(1 - yr) /. {ys ->ys[pi, \[Lambda]h, \[Lambda]l, R, ph, pl], ds -> ds[pi, \[Lambda]h, \[Lambda]l, R, ph, pl], yr -> yr[pi, \[Lambda]h, \[Lambda]l, R, ph, pl],dr -> dr[pi, \[Lambda]h, \[Lambda]l, R, ph, pl]}

mkt[pi, \[Lambda]h, \[Lambda]l, R, ph, pl]

(*____________________________________________________________________*)
Solve[mkt[pi, \[Lambda]h, \[Lambda]l, R, ph, pl] == 0 &&indiff[pi, \[Lambda]h, \[Lambda]l, R, ph, pl] == 0, {ph, pl}]

Panel[With[{mktt = mkt[pi, \[Lambda]h, \[Lambda]l, R, ph, pl], indifft = indiff[pi, \[Lambda]h, \[Lambda]l, R, ph, pl]}, 
  Manipulate[ Plot3D[{mktt, indifft}, {ph, 0, 1}, {pl, 1, 5}], {pi, 0,1}, {\[Lambda]h, 0, 1}, {\[Lambda]l, 0, 1}, {R, 1, 5}]], "Check if the solution exists"]

POSTED BY: Songklod Rastapana