ClearAll["Global`*"]

(* Initial Guess for Value Function depending on current rating Ψ *)

V[Ψ_] = c + d Ψ + e Ψ^2

(* Step 0: Explicitly Solve for Inference *)
(* Consistency and Rationality Equation which determine Inference *)
Cons[θ_,ω_,p_]=θ + (1+ω)/2-κ p

Rat[μ_,ω_,p_]= μ + ω

(* Explicitly solve Inference by setting Cons == current rating, Rat == price *)

(* Save solution in tempsol *)

tempsol=FullSimplify[Solve[Cons[μ,ω,p]==Ψ && Rat[μ,ω,p]==p,{μ,ω}]]

(* store solution as a function of rating Ψ and price p in (Subscript[μ, inf]) and (Subscript[ω, inf]) *)

(Subscript[μ, inf])[Ψ_,p_]=FullSimplify[μ/.tempsol[[1]]]

(Subscript[ω, inf])[Ψ_,p_]=FullSimplify[ω/.tempsol[[1]]]

(* get implied quantity which is equal to 1 - cutoff taste (Subscript[ω, inf]) *)

(Subscript[q, inf])[Ψ_,p_]=1-(Subscript[ω, inf])[Ψ,p]

(* Inference is Complete *)

(* Induced Review (Subscript[ψ, t ])is equal to rating by average consumer (Cons[]) given true quality, inferred cutoff, and price *)

(Subscript[ψ, t])=FullSimplify[Cons[θ,(Subscript[ω, inf])[Ψ,p],p]]

(* Step 1: Rewrite Bellman problem with target rating as control *)

(* Use this to rewrite price and quantity as a function of target rating ψ *)

(* Get (Subscript[p, per]) and (Subscript[q, per]) as the price and quantity given current stock rating Ψ and target rating ψ *)

(Subscript[p, per])[ψ_,Ψ_] =FullSimplify[ p/.Solve[ψ == (1-σ) * Ψ+σ (Subscript[ψ, t]),p][[1]]]

(Subscript[q, per])[ψ_,Ψ_]=FullSimplify[ (Subscript[q, inf])[Ψ,(Subscript[p, per])[ψ,Ψ]]]

(* Flow profits f - as a function of Ψ and ψ - equal price times quantity *)

f[ψ_,Ψ_] = FullSimplify[(Subscript[p, per])[ψ,Ψ]*(Subscript[q, per])[ψ,Ψ]]

(* Step 2: Value Function -- Guess & Verify *)

(* Get derivative of Value function (Subscript[V, D]) *)

(Subscript[V, D])[Ψ_]=D[V[Ψ],Ψ]

(* Differentiate Bellman Equation w.r.t. control ψ & plug in previous expression*)

foc[ψ_,Ψ_]=D[f[ψ,Ψ],ψ]+δ (Subscript[V, D])[ψ]

(* Solve FOC to obtain the optimal ψ and collect terms with powers of Ψ *)

(* Save result in lom which is a function of Ψ *)

lom[Ψ_]=Collect[ψ/.FullSimplify[Solve[foc[ψ,Ψ]==0,ψ]][[1]],Ψ]

(*Plug this into Bellman Equation and collect coefficients in coefflist *)

coefflist=FullSimplify[CoefficientList[f[lom[Ψ],Ψ]+δ V[lom[Ψ]],Ψ]]

(* Equate Coefficients step by step (two solutions) *)

(* Two solutions for e *)

FullSimplify[Solve[e==coefflist[[3]],e]]

(* Save solutions separately; (Subscript[coe, 1]) and (Subscript[coe, 2]) *)

(Subscript[coe, 1])=FullSimplify[Solve[e==coefflist[[3]],e],{0<δ<1,0<σ<1,0<κ<1}][[1]]

(Subscript[coe, 2])=FullSimplify[Solve[e==coefflist[[3]],e],{0<δ<1,0<σ<1,0<κ<1}][[2]]

(* Get solutions for d given the solution for e, save in (Subscript[cod, 1]) and (Subscript[cod, 2]) *)

(Subscript[cod, 1])=FullSimplify[Solve[d==coefflist[[2]]/.(Subscript[coe, 1]),d],{0<δ<1,0<σ<1,0<κ<1}][[1]]

(Subscript[cod, 2])=FullSimplify[Solve[d==coefflist[[2]]/.(Subscript[coe, 2]),d],{0<δ<1,0<σ<1,0<κ<1}][[1]]

(* Get solutions for c given the solutions for d and e, save in (Subscript[coc, 1]) and (Subscript[coc, 2]) *)

(Subscript[coc, 1])=Simplify[Solve[c==coefflist[[1]]/.{(Subscript[coe, 1])[[1]],(Subscript[cod, 1])[[1]]},c],{0<δ<1,0<σ<1,0<κ<1}][[1]]

(Subscript[coc, 2])=Simplify[Solve[c==coefflist[[1]]/.{(Subscript[coe, 2])[[1]],(Subscript[cod, 2])[[1]]},c],{0<δ<1,0<σ<1,0<κ<1}][[1]]

(* Save full solutions in (Subscript[co, 1]) and (Subscript[co, 2]) *)

(Subscript[co, 1])={(Subscript[coc, 1])[[1]],(Subscript[cod, 1])[[1]],(Subscript[coe, 1])[[1]]};

(Subscript[co, 2])={(Subscript[coc, 2])[[1]],(Subscript[cod, 2])[[1]],(Subscript[coe, 2])[[1]]};

(* Get induced Law of Motions for each solution, save in (Subscript[lom, 1]) and (Subscript[lom, 2]) by collecting terms *)

(Subscript[lom, 1])=Collect[Simplify[lom[Ψ]/.(Subscript[co, 1])],Ψ];

(Subscript[lom, 2])=Collect[Simplify[lom[Ψ]/.(Subscript[co, 2])],Ψ];

(* Obtain associated Coefficient Lists of the law of motion (w.r.t Ψ) *)

(Subscript[lomco, 1])=FullSimplify[CoefficientList[(Subscript[lom, 1]),Ψ],{1>σ>0,0<δ<1,θ>0,1>κ>0}]

(Subscript[lomco, 2])=FullSimplify[CoefficientList[(Subscript[lom, 2]),Ψ],{1>σ>0,0<δ<1,θ>0,1>κ>0}]

(* Step 3: Establishing unique solution *)
(* Using technical assumption σ < 1 - κ < = > κ < 1 - σ, adapted to given parametrization *)

(* Check whether absolute value of second coefficient is between 0 and 1 (higher rating -> higher target rating) *)
(* First check for σ == 1 -> oscillating so between -1 and 0 *)

(* First solution satisfies convergence *)

FullSimplify[(Subscript[lomco, 1])[[2]]<0 && (Subscript[lomco, 1])[[2]]>-1,{0<δ<1,σ==1,0<=κ<1/2}]

(* Second solution violates convergence *)

FullSimplify[(Subscript[lomco, 2])[[2]]<-1 || (Subscript[lomco, 2])[[2]]>1,{0<δ<1,σ==1,0<=κ<1/2}]

(* Suggests that first solution is correct one *)

(* Next check for σ < 1/2, κ < 1-σ *)

FullSimplify[(Subscript[lomco, 1])[[2]]>0 && (Subscript[lomco, 1])[[2]]<1,{0<δ<1,0<σ<1/2,κ<1-σ}]

FullSimplify[(Subscript[lomco, 2])[[2]]<-1 || (Subscript[lomco, 2])[[2]]>1,{0<δ<1,0<σ<1/2,κ<1-σ}]

(* Same observation: First solution is the applicable one *)

(* Final Check: 1/2 < σ < 1, κ < 1/2 *)

FullSimplify[(Subscript[lomco, 1])[[2]]>-1&& (Subscript[lomco, 1])[[2]]<1,{0<δ<1,1/2<σ<1,κ<1/2,2+2 κ (-1+σ)!=3 σ}]

FullSimplify[(Subscript[lomco, 2])[[2]]<0 || (Subscript[lomco, 2])[[2]]>1,{0<δ<1,1/2<σ<1,κ<1/2}]

(* Step 4: Comparative Statics for Speed of Convergence (given by second coefficient of lomco) *)

(* Speed of Convergence Comp Stat, only for σ < 1/2 to avoid oscillation *)

Reduce[(Subscript[lomco, 1])[[2]]>0&&0<σ<1/2&&0<κ<1-σ&&0<δ<1]

Reduce[D[(Subscript[lomco, 1])[[2]],σ]<0&&0<σ<1/2&&0<κ<1-σ&&0<δ<1]

(* Second coefficient decreases in σ, so speed of convergence increasing in σ (see Proposition 2) *)

(* Step 5: Analysis of Convergence Point *)

(* Convergence Point given |b| < 1  *)

(* Limitreview and Rating obtains via geometric series convergence a/(1-b) *)

limitrev = FullSimplify[(Subscript[lomco, 1])[[1]]/(1-(Subscript[lomco, 1])[[2]])]

(* Get Price in Limit *)

limitprice = FullSimplify[(Subscript[p, per])[limitrev,limitrev]]

(* Check that Quality is correctly inferred *)

limitinfqual=FullSimplify[(Subscript[μ, inf])[limitrev,limitprice]]

(* Get Limiting Quantity and Profits *)

limitquant = FullSimplify[(Subscript[q, per])[limitrev,limitrev]]

FullSimplify[limitprof = FullSimplify[limitquant * limitprice]]

(* Get Review left in limit *)

limitleftreview=FullSimplify[Cons[θ,(Subscript[ω, inf])[limitrev,limitprice],limitprice]]

(* Check that consistent *)

FullSimplify[limitrev==limitleftreview]

(* Get Limit CS (triangle formula due to correct quality inference) *)

limitcs=FullSimplify[(θ+1-limitprice)*limitquant/2]

(* Step 6: Comparative Statics (Corollary 1) *)

(* Profits increasing in sensitivity σ *)

FullSimplify[D[limitprof,σ]>0,{0<δ<1,σ>0,0<κ<1,θ>0}]

(* Profits are weakly increasing in σ, strictly for κ <> 0.5 *)

(* Rating increasing in sensitivity σ *)

FullSimplify[D[limitrev,σ]>0,{σ>0,0<δ<1,θ>0,1>κ>0}]

(* Rating in Limit weakly increasing in σ, strictly for κ <> 0.5 *)

(* Limit CS; always check that price has opposite movement when θ unaffected *)

(* Limit CS w.r.t κ *)

FullSimplify[D[limitcs,κ]<0,{σ>0,0<δ<1,θ>0,1>κ>0}]

FullSimplify[D[limitprice,κ]>0,{σ>0,0<δ<1,θ>0,1>κ>0}]

(* Limit CS w.r.t σ *)

FullSimplify[D[limitcs,σ]>0,{σ>0,0<δ<1,θ>0,1>κ>0}]

FullSimplify[D[limitprice,σ]<0,{σ>0,0<δ<1,θ>0,1>κ>0}]

(* Limit CS increasing in σ iff κ > 1/2, price opposite behavior *)

(* Limit CS w.r.t δ *)

FullSimplify[D[limitcs,δ]>0,{σ>0,0<δ<1,θ>0,1>κ>0}]

FullSimplify[D[limitprice,δ]<0,{σ>0,0<δ<1,θ>0,1>κ>0}]

(* Limit CS w.r.t. θ, now same movement for price and CS *)

FullSimplify[D[limitcs,θ]>0,{σ>0,0<δ<1,θ>0,1>κ>0}]

FullSimplify[D[limitprice,θ]>0,{σ>0,0<δ<1,θ>0,1>κ>0}]

(* Step 7: Platform Maximization (Proposition 3) *)

(* Set up maximization problem; platformProfit depends on weight on consumers (Subscript[w, c]) *)

FullSimplify[platformProfit = (Subscript[w, c])*limitcs + (1-(Subscript[w, c])) * limitprof,0≤(Subscript[w, c])≤1]

(* Differentiate w.r.t σ, save in dPlatformProfitds *)

dPlatformProfitds = FullSimplify[D[platformProfit,σ]]

(* Get roots of denominator *)

FullSimplify[Solve[Denominator[dPlatformProfitds]==0,σ]]

(* Get critical σ such that platform profits invariant to σ (locally), save in scrit *)

FullSimplify[Solve[dPlatformProfitds==0,σ]]

scrit = σ/.FullSimplify[Solve[dPlatformProfitds==0,σ]][[1]][[1]]

(* Check that scrit is negative for equal weight *)

FullSimplify[(scrit/.{(Subscript[w, c])->0.5 } )< 0,0<δ<1]

(* Proposition 3.i) For κ > 1/2 always incentive to increase sensitivity *)

FullSimplify[dPlatformProfitds>0,{σ>0,0<δ<1,θ>0,1/2<κ<1,1>(Subscript[w, c])>0}]

(* Proposition 3.ii) Consider κ < 1/2 *)

FullSimplify[dPlatformProfitds>0,{κ<1/2,σ<scrit,σ>0,0<δ<1,θ>0,1>(Subscript[w, c])>0}]

FullSimplify[dPlatformProfitds<0,{κ<1/2,σ>scrit,σ>0,0<δ<1,θ>0,1>(Subscript[w, c])>0}]

(* Single-peaked profits around scrit *)

(* Get weight such that maximal sensitivity of 1 is critical *)

FullSimplify[Solve[scrit==1,(Subscript[w, c])]]

FullSimplify[D[scrit,(Subscript[w, c])]<0,{κ<1/2,0<δ<1,(Subscript[w, c])>0}]

FullSimplify[scrit<0,{(Subscript[w, c])>(1-2κ)/(3-4κ),κ<1/2,σ>0,0<δ<1,θ>0,1>(Subscript[w, c])>0}]

(* Scrit is unique maximizer unless (Subscript[w, c])>(1-2κ)/(3-4κ); then choose σ=0 *)