3-d plot labels

Question

I would like to put labels on vertices instead of putting a label on axes. I am not sure how this can be done. My specific question is the following. In the attached 3-d picture, I would like to remove the numbers 0,0.5 and 1. Currently, I have three labels for the three axes. I would like to remove them and instead place four labels (one for each vertex). I would really appreciate if someone could let me know how to do this.

Here is the code that I am using.

Clear[f, g, h, p, r, l, jac, u1, u2, u3, u4, G, x, y, z, sol, xinit, \
yinit, zinit, plotfunc0, plotfunc1]
r = 0.5;    (*Recombination parameter*)
G = {{6, 6, 6, 2}, {5, 5, 5, 
   1}, {5, 5, 5, 1}, {7, 7, 7, 3}};
u1[x_, y_, z_] = 
  G[[1, 1]]*x +  G[[1, 2]]*y + G[[1, 3]]*z +  
   G[[1, 4]]*(1 - x - y - z) ;
u2[x_, y_, z_] = 
  G[[2, 1]]*x +  G[[2, 2]]*y + G[[2, 3]]*z +  
   G[[2, 4]]*(1 - x - y - z);
u3[x_, y_, z_] = 
  G[[3, 1]]*x +  G[[3, 2]]*y + G[[3, 3]]*z +  
   G[[3, 4]]*(1 - x - y - z) ;
u4[x_, y_, z_] = 
  G[[4, 1]]*x +  G[[4, 2]]*y + G[[4, 3]]*z +  
   G[[4, 4]]*(1 - x - y - z) ;
ualpha[x_, y_, 
   z_] = (x*u1[x, y, z]) + (y*u2[x, y, z]) + (z*
     u3[x, y, z]) + ((1 - x - y - z)*u4[x, y, z]);
us[x_, y_, z_] = (x*u1[x, y, z]) + (y*u2[x, y, z]);
ua[x_, y_, z_] = (z*u3[x, y, z]) + ((1 - x - y - z)*u4[x, y, z]);
uc[x_, y_, z_] = (x*u1[x, y, z]) + (z*u3[x, y, z]);
ud[x_, y_, z_] = (y*u2[x, y, z]) + ((1 - x - y - z)*u4[x, y, z]);
F1[x_, y_, 
   z_] = ((1 - r)*x*u1[x, y, z]/ualpha[x, y, z]) + (r*us[x, y, z]*
     uc[x, y, z]/((ualpha[x, y, z])^2)) - x;
F2[x_, y_, 
   z_] = ((1 - r)*y*u2[x, y, z]/ualpha[x, y, z]) + (r*us[x, y, z]*
     ud[x, y, z]/((ualpha[x, y, z])^2)) - y;
F3[x_, y_, 
   z_] = ((1 - r)*z*u3[x, y, z]/ualpha[x, y, z]) + (r*ua[x, y, z]*
     uc[x, y, z]/((ualpha[x, y, z])^2)) - z;
nmax = 1000.0;
tmax = 500;
func0 = {};
tol = 0.000001;
func1 = {};
P0 = {};
P1 = {};
basin0 = 0;
basin1 = 0;
basinneq01 = 0;
plotfunc0 = {};
plotfunc1 = {};
p100 = {1, 0, 0};
For[k = 1, k <= nmax, k++, 
 region = ImplicitRegion[
   x + y + z <= 1 && x >= 0 && y >= 0 && z >= 0, {x, y, 
    z}];(*way to get uniform points from region*)
 rand = RandomPoint[region] ;
 solution = 
  NDSolve[{x'[t] == F1[x[t], y[t], z[t]], 
    y'[t] == F2[x[t], y[t], z[t]], z'[t] == F3[x[t], y[t], z[t]], 
    x[0] == rand[[1]], y[0] == rand[[2]], z[0] == rand[[3]]}, {x, y, 
    z}, {t, 0, tmax}];
 prox = Evaluate[{x[t], y[t], z[t]} /. solution] /. {t -> tmax};
 d0 = Norm[prox];
 If[d0 < tol, basin0 = basin0 + 1, 
  If[d0 > 1 - tol, basin1 = basin1 + 1]];
 (*If[d0>tol&&d1>tol,basinneq01=basinneq01+1,If[d0<tol,basin0=basin0+\
1,If[d1<tol, basin1=basin1+1]]];*)
 
 If[d0 < tol, 
  plotfunc0 = 
   ParametricPlot3D[{x[t], y[t], z[t]} /. solution, {t, 0, tmax}, 
     PlotRange -> {{0, 1}, {0, 1}, {0, 1}}, 
     BaseStyle -> Arrowheads[{0, .01, 0.01, 0}], 
     PlotStyle -> {Red, Thin}, Boxed -> False, 
     AxesStyle -> Directive[Black, Bold, Thick, 16], 
     AxesEdge -> {{-1, -1}, {-1, -1}, {-1, -1}}, 
     AxesLabel -> {"sc", "sd", "ac"}] /. Line -> Arrow, 
  plotfunc1 = 
   ParametricPlot3D[{x[t], y[t], z[t]} /. solution, {t, 0, tmax}, 
     PlotRange -> {{0, 1}, {0, 1}, {0, 1}}, 
     BaseStyle -> Arrowheads[{0, .001, 0.001, 0}], 
     PlotStyle -> {Blue, Thin}, Boxed -> False, 
     AxesStyle -> Directive[Black, Bold, Thick, 16], 
     AxesEdge -> {{-1, -1}, {-1, -1}, {-1, -1}}, 
     AxesLabel -> {"sc", "sd", "ac"}] /. Line -> Arrow];
 AppendTo[func0, plotfunc0];
 AppendTo[func1, plotfunc1]]
p1 = Graphics3D[{Black, Opacity[0.1], 
    HalfPlane[{{1, 0, 0}, {0, 1, 0}}, {0, -1, 0}], 
    HalfPlane[{{0, 0, 1}, {0, 1, 0}}, {0, -1, 0}], 
    HalfPlane[{{0, 0, 1}, {1, 0, 0}}, {-1, 0, 0}]}];
Show[func0, func1, p1]
basin0 = basin0/nmax
basin1 = basin1/nmax
TimeUsed[]

Answer 1

We can use Simplex[3] as the plotting region with the desired look. We use BoundaryDiscretizeRegion to discretize it and use the options MeshCellLabel and MeshCellStyle to label and style various cells:

labeledsimplex = BoundaryDiscretizeRegion[Simplex[3], 
   MaxCellMeasure -> Infinity, 
   MeshCellStyle -> {2 -> Opacity[.2, Gray], 
        {1, 6 | 2 | 3} -> Directive[Thick, Opacity[1], Black], 
        1 -> Directive[Gray, Thin]}, 
   MeshCellLabel -> Prepend[{0, 1} -> Style["ad", 16, Bold] ][
     {#, #2} -> Placed[Style[#3, 16, Bold], #4] & @@@ 
      Thread[{1, {2, 3, 6}, {"sc", "sd", "ac"}, {-.1,1.1,1.1}}]]]

Since OP's code crashed my session, I use some 3D plot with lines contained in the simplex:

SeedRandom[1];
func1 = BSplineFunction@RandomPoint[Simplex[3], 100];
func2 = BSplineFunction@RandomPoint[Simplex[3], 100];

plots = ParametricPlot3D[{func1[t], func2[t]}, {t, 0, 1}, 
   ImageSize -> Large, 
   BaseStyle -> 
    Arrowheads[ConstantArray[Medium, 40], Appearance -> "Projected"], 
   PlotStyle -> {Directive[Thin, Red], Directive[Thin, Blue]}, 
   Boxed -> False, Axes -> False] /. Line -> Arrow

The picture at the top is obtained using

Show[plots, labeledsimplex,
 PlotRange -> All, PlotRangePadding -> 0, ViewPoint -> {.3, 2, .3}]

Update: An alternative approach using custom Arrowheads to render axes:

simplex = BoundaryDiscretizeRegion[Simplex[3], 
   MaxCellMeasure -> Infinity, 
   MeshCellStyle -> {2 -> Opacity[.2, Gray], 
     1 -> Directive[Thin, GrayLevel[.1]]}];

labeledAxes = Graphics3D @ 
   {Text[Style["ad", 16, Bold, Black], {0, 0, 0}, {-1, -1}],
    Black, Thick, 
    MapThread[{Arrowheads[{{Automatic,1, 
         {Graphics3D[Inset[Style[#, 16, Bold, Black], {0, 0, 0}, #2]], 0}}}], 
       Arrow[{{0, 0, 0}, 1.1 #3}]} &, 
     {{"sc", "sd", "ac"}, {{1, 0}, {-1, 1}, {0, -1}}, IdentityMatrix[3]}]};

Show[plots, simplex, labeledAxes, PlotRange -> All, 
  ViewPoint -> {.3, 2, .3}]