Can Mathematica achieve this diagram?

Can Mathematica be used to create diagrams of drift diffusion of the kind shown, including histograms showing the response-time distributions?

The distributions capture the time taken by a random walker, starting at 0.5, to hit the "barriers" 1 or 0. They are called reponse-time distributions within psychology because the random walker is assumed to capture evidence accumulation, and a decision is assumed to be made depending on what barrier is hit. Usually the walker has some bias towards the "correct" barrier, and in the shown diagram the blue distribution captures the time taken to make correct decisions, while the red shows the time taken to make the wrong decisions.

• Could you explain more about what the histograms represent? The distribution of times to hit 0 and 1? – Chris K Nov 9 '19 at 22:33
• @ChrisK I will add more details in the question. – user120911 Nov 9 '19 at 22:47
• Some sample data to demo with would be appreciated. – C. E. Nov 10 '19 at 9:35

Here's a similar figure with made-up data:

dist1 = NormalDistribution[0.002, 1/100];
dist2 = NormalDistribution[-0.002, 1/10];

randomWalk[] :=
NestWhileList[# + 0.7 RandomVariate[dist1] +
0.3 RandomVariate[dist2] &, 0.5, 0 < # < 1 &];

SeedRandom[0]
{foo, res} =
Reap[Do[Sow[Length@#, Clip[Last@#, {0, 1}]] &@randomWalk[], {10000}], {1, 0}];
{{successes}, {failures}} = res;

sdist = SmoothKernelDistribution[successes];
fdist = SmoothKernelDistribution[failures];

SeedRandom[5];
samplewalks = Table[randomWalk[], 4];


Visualization:

yticks = {(*{0.,"0.0000"},*)0.0005, {0.001, "0.0010"}, 0.0015, {0.002, "0.0020"}, 0.0025};
maxtime =
Max[Mean[{Max@{successes, failures}, Max@samplewalks}], 10 + Max@samplewalks];
pdfaspectratiofactor = 80;

Column[{
Plot[
Length[successes] PDF[sdist, x]/(Length[successes] + Length[failures]),
{x, 0, maxtime},
Ticks -> {None, yticks}, Filling -> Axis,
ImagePadding -> {{35, 12}, {0, 5}}, ImageSize -> Large,
PlotRange -> {{0, maxtime}, {0, 0.0025}},
AspectRatio -> 0.0025*pdfaspectratiofactor],
ListLinePlot[
samplewalks,
PlotStyle -> (If[Last[#] >= 1, ColorData[97][1], Darker@Red] & /@ samplewalks),
Frame -> True, FrameTicks -> {{Automatic, None}, {None, None}},
PlotRange -> {{0, maxtime}, {0, 1}}, PlotRangeClipping -> True,
ImagePadding -> {{35, 12}, {5, 5}}, ImageSize -> Large,
AspectRatio -> 0.4],
Plot[
Length[failures] PDF[fdist, x]/(Length[successes] + Length[failures]),
{x, 0, maxtime},
ScalingFunctions -> "Reverse",
FrameTicks -> {{yticks, None}, {Automatic, None}}, Filling -> Axis,
PlotStyle -> Darker@Red,
ImagePadding -> {{35, 12}, {15, 0}}, ImageSize -> Large,
Frame -> True,
PlotRange -> {{0, maxtime}, {0, 0.0011}},
AspectRatio -> 0.0011*pdfaspectratiofactor]
}, Center, 0]