Apparently, I'm a slow thinker about fast computation. A refinement that came to me during breakfast:

Length /@ 
   With[{iNames = 
      StringReplace[
       IntegerName[Range@10000, "Words"], {"," -> "", "-" -> "-"}]},
    With[{orderingAll = 
       Position[iNames, #] & /@ AlphabeticSort[iNames] // Flatten},
     Table[
      With[{seq = Pick[orderingAll, UnitStep[n - orderingAll], 1]},
       Position[Range@n - seq, 0]], {n, Length@iNames}]
     ]]; // AbsoluteTiming

(* {6.70907, 
    {1, 2, 1, 1, 0, 0, 0, 1, 0, 0, 2, 2,..., 2, 0, 1, 0, 1, 0, 0, 0, 0, 1, 0, 0}} *)

11 min. for 100K terms on a 8+2 core MacBook Pro M1 Max (used 40-50% CPU due to vectorization of some operations — unsure how that translates to other CPUs). :)

To get the fixed points, remove Length from

Length /@ With[ ...]

Replace it with Flatten to get lists of fixed points:

Flatten /@ With[ ...]

Without Flatten, you get Position forms, instead of Part index forms, that is {{4}, {7}, {12}} instead of {4, 7, 12}.

My approach is based on this elegant solution, which unfortunately is invalid because the default order puts 18 before 800:

fixedPoints = Position[# - Ordering[IntegerName[#, "Words"]], 0] &;
Range[13] // fixedPoints (* 27 sec for Range[10^6] *)
(*  {{4}, {7}, {12}}  *)

There is no built-in ordering for AlphabeticSort[], which is unfortunate for your problem. So I made my own:

alphabeticOrdering = Function[list, Position[list, #] & /@ AlphabeticSort[list] // Flatten];
Range[800] // alphabeticOrdering[IntegerName[#, "Words"]] & // Take[#, 5] &
Range[800] // Ordering[IntegerName[#, "Words"]] & // Take[#, 5] &
(*
{8, 800, 18, 80, 88}
{8, 18, 800, 80, 88}
*)

alphabeticFixedPoints = Position[# - alphabeticOrdering[IntegerName[#, "Words"]], 0] &;
Range[800] // alphabeticFixedPoints
(*  {{15}}  *)

The rest came from your suggestion not to re-do the sorting each time. I couldn't find an efficient way to insert a new word in order (among built-in functions) — maybe there is one — so I tried sorting all once and filtering the sorted names.

UnitStep[a - b] is a numeric way to compute a < b (return value 0) and a >= b (return value 1). It is vectorized, so it is fast for packed arrays a and b. Pick[] is also a fast way to filter packed lists.

One way to break down code is to use a small example and examine the steps. I usually copy the whole code, then strip off the layers down to the core, and examine the output as I add a layer at a time back. For small codes, one might use Echo[] with labels to see the whole process. The following filters Range[8] from Range[12]:

Length /@ With[{iNames =
    Echo[
     StringReplace[
      IntegerName[Range@12, "Words"], {"," -> "", "-" -> "-"}],
     "Initial"]},
  With[{orderingAll =
     Echo[
      Position[iNames, #] & /@
        Echo[
         AlphabeticSort[iNames],
         "Sorted"] //
       Flatten,
      "Ordering"]},
   Table[
    With[{seq =
       Echo[
        Pick[orderingAll,
         Echo[
          UnitStep[n - orderingAll],
          "UnitStep: < -> 0, >= -> 1"],
         1],
        "Pick"]},
     Echo[
      Position[Range@n - seq, 0],
      "Fixed-point positions"]],
    {n, 8, 8}]]]

HTH.

Maybe this:

a = Function[n,
   IntegerName[Range@n, "Words"] //
    Position[# - AlphabeticSort[#], 0] &];

Length@*a /@ Range[1000] // AbsoluteTiming
(*  {9.982, {1, 2, 1, 1, 0, 0, 0, 1, 0, 0, 2, 2, 3, 2, 0,...} *)

Range[2000] takes 40 sec. so probably n^2 time complexity.

Here's a thought. We're doing an AlphabeticSort on the IntegerName of a large — say n — Range of numbers. This takes a certain length of time. Then we do the same thing for n+1, which should take slightly longer. Wouldn't it be much faster if there was an easy way to fit the IntegerName of n+1 into the already-sorted list for Range[n]?

To example this, we've done a sort for Range[13] yielding {8,11,5,4,9,1,7,6,10,13,3,12,2}. Now, instead of doing a sort for Range[14], isn't it possible to deduce where in this list for Range[13] the 14 is to be inserted without re-sorting the entire list?

Oops, forgot your StringReplace[]. Sorry about that.

20 minutes for 100K terms on a 2020 iMac. It's a 10-core Intel i9 but I do have a bunch of other stuff running on it. I'm going to try for a million terms.

Thank you for this. One more thing, as your code is a little obscure to me in terms of how exactly it works. If I wanted the fixed points of a single number (i.e., {4,7,12} for 13), what needs to change?