(final) Akerlof Simulation.nb

(*First part that gives the Markov Chain Properties and visualises the Markov Chain*)
beta = 1;    (*initial perception rate*)
alpha = 0.4; (*threshold or critical perception rate*)
opportunisticSellerRate = 0.02;
n = 1000;    (*number of steps to simulate*)
transitionMatrix[beta_, 
   alpha_] := {{beta - alpha, 1 - (beta - alpha)}, {beta - alpha, 
    1 - (beta - alpha)}};
markovProcess[beta_] := 
  DiscreteMarkovProcess[1, transitionMatrix[beta, alpha]];
transitionMatrix[beta_, 
   alpha_] := {{beta - alpha, 1 - (beta - alpha)}, {beta - alpha, 
    1 - (beta - alpha)}};
markovProcess[beta_] := 
  DiscreteMarkovProcess[1, transitionMatrix[beta, alpha]];
simulationResults = 
  Table[If[RandomReal[] < opportunisticSellerRate, (*RandomReal[]: a pseudorandom real number in the range 0 to 1*)
    beta = Max[beta - 0.1, alpha]];
   process = markovProcess[beta];
   RandomFunction[process, {0, 1}], {n}];
initialProperties = MarkovProcessProperties[markovProcess[1]]
finalProperties = MarkovProcessProperties[markovProcess[beta]
Insert[initialProperties, {Background -> {None, {GrayLevel[
      0.7], {White}}}, Dividers -> {Black, {2 -> Black}}, 
  Frame -> True, Spacings -> {2, {2, {0.7}, 2}}}, 2];
Insert[finalProperties, {Background -> {None, {GrayLevel[
      0.7], {White}}}, Dividers -> {Black, {2 -> Black}}, 
  Frame -> True, Spacings -> {2, {2, {0.7}, 2}}}, 2]
 Graph[markovProcess[1[]], VertexLabels -> {1 -> "H", 2 -> "L"}, 
 VertexSize -> Small, 
 EdgeLabels -> 
  With[{sm = 
     MarkovProcessProperties[markovProcess[1], "TransitionMatrix"]}, 
   Flatten@Table[DirectedEdge[i, j] -> sm[[i, j]], {i, 2}, {j, 2}]], 
 ImageSize -> Medium]
Graph[markovProcess[0.4[]], VertexLabels -> {1 -> "H", 2 -> "L"}, 
 VertexSize -> Small, 
 EdgeLabels -> 
  With[{sm = 
     MarkovProcessProperties[markovProcess[0.4], "TransitionMatrix"]},
    Flatten@Table[DirectedEdge[i, j] -> sm[[i, j]], {i, 2}, {j, 2}]], 
 ImageSize -> Medium]


(*Second part that visualises the process and plots the frequence of High-Quality products*)

(*display plots*)
*Parameters*) a = 0.4;
timeSteps = 1000;  (*number of steps for the simulation*)
betaStart = 1;  (*initial β (beta) value*)
opportunisticRate = 0.02;  (*2% of sellers are opportunistic*)
movingAverageWindow = 
  100; (*window size for the moving average, 10 to 25% of the \
timeSteps*)

(*module to simulate market behavior and calculate frequency of H \
with moving average*)
simulateMarketBehavior[betaInitial_] := 
  Module[{beta, t, transitionMatrix, state, statesHistory, 
    stateNumeric}, beta = betaInitial;
   state = "H";
   statesHistory = {state};
   For[t = 1, t <= timeSteps, t++, 
    If[RandomReal[] < opportunisticRate, (*RandomReal[]: a pseudorandom real number in the range 0 to 1*)
     beta = Max[beta - 0.1, 
        a];  (*decrease β (beta) upon encountering an opportunistic seller*)];
    transitionMatrix = {{beta - a, 1 - (beta - a)}, {beta - a, 
       1 - (beta - a)}};
    stateProbabilities = 
     If[state == "H", transitionMatrix[[1]], transitionMatrix[[2]]];
    state = If[RandomReal[] < stateProbabilities[[1]], "H", "L"];
    AppendTo[statesHistory, state];];
   stateNumeric = Map[If[# == "H", 1, 0] &, statesHistory];
   MovingAverage[stateNumeric, movingAverageWindow]];

(*run simulations + plot results together*)
simulationResults = Table[simulateMarketBehavior[betaStart], {50}];
frequencyHPlots = 
  ListLinePlot[simulationResults, PlotRange -> {0, 1}, 
   PlotLabels -> "Simulations, as \[Beta] starts at 1", Frame -> True,
    FrameLabel -> {"Time Step", "Frequency of H"}, 
   PlotLegends -> Automatic];

(*display plots*)
frequencyHPlots;
initialExpectation = betaStart - a;
initialExpPlot = 
  ListLinePlot[initialExpectation, PlotRange -> {0, 1}, 
   PlotLabels -> "Simulations, as \[Beta] starts at 1", Frame -> True,
    FrameLabel -> {"Time Step", "Frequency of H"}, 
   PlotLegends -> Automatic];
Show[frequencyHPlots, 
 Plot[initialExpectation, {timeSteps, 1, 914}, 
  PlotStyle -> {Black, Thickness[0.015]}, 
  PlotLabels -> "Initial Expectation"]]