Having problems with using TableForm to format a table

Question

I want to make a table of various values of the logistic curve given by l[x_] := 1/(1 + E^((-k)*(x - \[Alpha]))).

In basic form, this is dead easy. However, I want to make some tweaks, and I can't persuade them to work.

(Apologies for images of table outputs - I don't know how to add the actual tables.)

1: Note that despite being wrapped in N[...,4], the table evaluates to more than 4 decimal places for several values:

N[With[{k = 1}, TableForm[Table[1/(1 + E^((-k)*(x - \[Alpha]))), 
     {x, 1, 20}, {\[Alpha], 5, 15, 5}], TableHeadings -> 
     {{"x=1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", 
         "12", "13", "14", "15", "16", "17", "18", "19", "20"}, 
       {"\[Alpha]=5",  "10", "15"}}]], 4]

2: I want to use l[x] instead of the full expression. But this leads Mathematica to mostly ignore the stipulated value for k:

l[x_] := 1/(1 + E^((-k)*(x - \[Alpha]))); 
N[With[{k = 1}, TableForm[Table[l[x], {x, 1, 20}, 
     {\[Alpha], 5, 15, 5}], TableHeadings -> 
     {{"x=1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", 
         "12", "13", "14", "15", "16", "17", "18", "19", "20"}, 
       {"\[Alpha]=5", "10", "15"}}]], 4]

3: I want the table to display \[Tilde]0 or \[Tilde]1 for values less than 0.0001 or greater than 0.9999 - but to retain the actual numerical value so I can perform further calulations on the table. I can change the values into text (though again this only works with the expression, not with l[x]), but of course, that means I can't then perform further caluations on them:

N[With[{k = 1}, TableForm[Table[If[1/(1 + E^((-k)*(x - \[Alpha]))) < 
         0.0001, Text["\[Tilde]0"], 
 If[1/(1 + E^((-k)*(x - \[Alpha]))) > 
           0.9999, Text["\[Tilde]1"], 
  1/(1 + E^((-k)*(x - \[Alpha])))]], 
     {x, 1, 20}, {\[Alpha], 5, 15, 5}], TableHeadings -> 
     {{"x=1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", 
         "12", "13", "14", "15", "16", "17", "18", "19", "20"}, 
       {"\[Alpha]=5", "10", "15"}}]], 4]

4: I would like to put all output values of 0.5 in bold. But Mathematica seems to ignore the /. command:

N[With[{k = 1}, TableForm[Table[If[1/(1 + E^((-k)*(x - \[Alpha]))) < 
           0.0001, Text["\[Tilde]0"], 
  If[1/(1 + E^((-k)*(x - \[Alpha]))) > 
             0.9999, Text["\[Tilde]1"], 
   1/(1 + E^((-k)*(x - \[Alpha])))]], 
       {x, 1, 20}, {\[Alpha], 5, 15, 5}], TableHeadings -> 
       {{"x=1", "2", "3", "4", "5", "6", "7", "8", "9", "10", 
           "11", "12", "13", "14", "15", "16", "17", "18", "19", 
           "20"}, {"\[Alpha]=5", "10", "15"}}]], 4] /. 0.5 -> Style[0.5, Bold]

I'd very much appreciate suggestions to fix all four of these issues.

Answer 1

I think this solves all your problems.

l[x_, k_, α_] := 1/(1 + E^((-k)*(x - α)));
table =
  Module[{boldVal, lhsLbls, tbl, tblForm, boldPos, zeroPos, onePos},
    boldVal = .5;
    lhsLbls = ToString /@ Range[20];
    lhsLbls[[1]] = "x=1";
    tbl = Table[With[{k = 1}, N[l[x, k, α], 4]], {x, 1, 20}, {α, 5, 15, 5}];
    tblForm = TableForm[tbl, TableHeadings -> {lhsLbls, {"α=5", "10", "15"}}];
    boldPos = Position[tblForm, u_?(# == boldVal &)];
    zeroPos = Position[tblForm, u_?(# < .0001 &)];
    onePos = Position[tblForm, u_?(1 - Rationalize[#] < 1/10000 &)];
    Print[
      MapAt[
        "∼1" &,
        MapAt[
          "∼0" &, 
          MapAt[Style[#, Bold] &, tblForm, boldPos], 
          zeroPos],
        onePos]];
    tbl]

{{0.01799, 0.0001234, 8.315*10^-7}, {0.04743, 0.0003354, 2.260*10^-6}, 
 {0.1192, 0.0009111, 6.144*10^-6}, {0.2689, 0.002473, 0.00001670}, 
 {0.5000, 0.006693, 0.00004540}, {0.7311, 0.01799, 0.0001234}, 
 {0.8808, 0.04743, 0.0003354}, {0.9526, 0.1192, 0.0009111}, 
 {0.9820, 0.2689, 0.002473}, {0.9933, 0.5000, 0.006693}, 
 {0.9975, 0.7311, 0.01799}, {0.9991, 0.8808, 0.04743}, 
 {0.9997, 0.9526, 0.1192}, {0.9999, 0.9820, 0.2689}, 
 {1.000, 0.9933, 0.5000}, {1.000, 0.9975, 0.7311}, 
 {1.000, 0.9991, 0.8808}, {1.000, 0.9997, 0.9526}, 
 {1.000, 0.9999, 0.9820}, {1.000, 1.000, 0.9933}}

Answer 2

To answer your first question:

N is really for controlling the precision of numerical calculations and in your code is, as intended, providing 4-digits of precision, or four significant figures if you want to put it that way.

For controlling the presentation of numbers there are a number of functions, such as NumberForm, DecimalForm, etc. We might modify your

N[With[{k = 1}, TableForm[Table[1/(1 + E^((-k)*(x - \[Alpha]))), 
     {x, 1, 20}, {\[Alpha], 5, 15, 5}], TableHeadings -> 
     {{"x=1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", 
         "12", "13", "14", "15", "16", "17", "18", "19", "20"}, 
       {"\[Alpha]=5",  "10", "15"}}]], 4]

to

DecimalForm[
 N[With[{k = 1}, 
   TableForm[
    Table[1/(1 + E^((-k)*(x - \[Alpha]))), {x, 1, 20}, {\[Alpha], 5, 
      15, 5}], 
    TableHeadings -> {{"x=1", "2", "3", "4", "5", "6", "7", "8", "9", 
       "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", 
       "20"}, {"\[Alpha]=5", "10", "15"}}]]], {4, 4}]

Note that I've dropped the argument (4) to N and provided the argument {4,4} to DecimalForm.

I expect that the answers to your other questions can also be found by separating the ideas of precision and presentation. If I have time and the inclination I'll have a closer look later.