How to obtain a subset (of a 2-d set of points with random coordinates) having monotonically increasing ordinates

If points is your original list,

ReplaceRepeated[points,
    {bef___,x:{x1_,x2_},y:{y1_,y2_},aft___}/;x2>=y2:>{bef,x,aft}
] 
(* {{4, 4}, {8, 8}, {14, 12}, {16, 16}, {22, 20}, {26, 24}, {32, 
  32}, {38, 36}, {44, 40}, {46, 44}, {52, 48}, {58, 56}, {62, 
  60}, {64, 64}, {74, 72}, {82, 80}, {86, 84}, {92, 88}, {94, 92}} *)

LongestOrderedSequence[points, #[[2]] < #2[[2]]& ]

{{4, 4}, {8, 8}, {14, 12}, {16, 16}, {22, 20}, {26, 24}, {32, 32}, {38, 36}, {44, 40}, {46, 44}, {52, 48}, {58, 56}, {62, 60}, {64, 64}, {74, 72}, {82, 80}, {86, 84}, {92, 88}, {94, 92}}

In, general, if input list is not already sorted by the first column:

LongestOrderedSequence[points, And @@ Thread @ Less @ ## & ]

same result

Alternatively, we get the same result using a combination of FixedPoint and Split, or a combination of rhermans's and Bill's methods:

FixedPoint[First /@ Split[#, #[[1]] >= #2[[1]] || #[[2]] >= #2[[2]] &] &, points]
DeleteDuplicates @ FoldList[If[#2[[2]] > #[[2]], #2, #] &, points]

For points in OP all the methods posted so far are faster than ReplaceRepeated:

LongestOrderedSequence[points , #[[2]] < #2[[2]] & ] ; // RepeatedTiming // First 

0.00021

FixedPoint[First /@ Split[#,  #[[2]] >= #2[[2]] &] &, points] ; // RepeatedTiming// First

0.00013

DeleteDuplicates @ FoldList[ First[MaximalBy[Last][{#1, #2}]] &, points]; //
  RepeatedTiming // First 

  0.0024

  Union[points, SameTest -> (Last@#1 <= Last@#2 &)] ; //  RepeatedTiming // First

0.00019

 (p = {0, 0};
 Map[If[p[[1]] < #[[1]] && p[[2]] < #[[2]], p = #, fail] &,  points] /. 
  fail -> Sequence[]); //  RepeatedTiming // First 

0.00018

 DeleteDuplicates@FoldList[If[#2[[2]] > #[[2]], #2, #] &, points]  ; // 

RepeatedTiming // First

 0.000082

ReplaceRepeated[points,
        {bef___, x : {x1_, x2_}, y : {y1_, y2_}, aft___} /; 
      x2 >= y2 :> {bef, x, aft}
    ]; // RepeatedTiming // First

0.00056

For general input, the LongestOrderedSequence and other methods do not produce the same results. LongestOrderedSequence does produce the longest monotone sequence which does not necessarily include the first pair in the input list. The monotone sequence produced by other methods starts with the first pair but the sequence produced is not necessarily the longest possible.

Timings:

f1 = LongestOrderedSequence[# , #[[2]] < #2[[2]] & ] &;
f2 = FixedPoint[First /@ Split[#, #[[2]] >= #2[[2]] &] &, #] & ;
f3 = DeleteDuplicates @ FoldList[If[#2[[2]] > #[[2]], #2, #] &, #] &;
f4 = (p = {0, 0}; Map[If[ p[[2]] < #[[2]], p = #, fail] &, #] /. fail -> Sequence[]) &;
f5 = DeleteDuplicates @ FoldList[First[MaximalBy[Last][{#1, #2}]] &, #] &;
f6 = Union[#, SameTest -> (Last@#1 <= Last@#2 &)] &;
f7 = ReplaceRepeated[# , {bef___, x : {x1_, x2_}, y : {y1_, y2_}, aft___} /; 
      x2 >= y2 :> {bef, x, aft}] &;

The function f4 is from Bill's answer, f5 and f6 are from rhermans' answer, and f7 from Jason B.'s.

    

SeedRandom[1]
pnts = SortBy[RandomInteger[100, {10000, 2}], First]; 
timings = Table[0, 7];
results = Table[0, 7];
functions = {f1, f2, f3, f4, f5, f6, f7};
labels = {"f1", "f2", "f3", "f4", "f5", "f6", "f7"} ;

timings = Table[First[RepeatedTiming[results[[i]] = functions[[i]]@pnts;]], {i, 7}];

Prepend[SortBy[Transpose[{labels, timings, Length /@ results, First /@ results}], 
  #[[2]] &], {"f", "timing", "Length@f@pnts", "First@f@pnts" }] /.
    x_Real :> NumberForm[x, {2, 4}] // 
      Grid[#, Dividers -> All, Alignment -> {Right, Center} ] & 

$\begin{array}{|r|r|r|r|} \hline f & \text{timing} & \text{Length@f@pnts} & \text{First@f@pnts} \\ \hline \text{f3} & 0.0038 & 57 & \{0,3\} \\ \hline \text{f6} & 0.0130 & 57 & \{0,3\} \\ \hline \text{f4} & 0.0210 & 57 & \{0,3\} \\ \hline \text{f1} & 0.1100 & 101 & \{3,0\} \\ \hline \text{f2} & 0.3500 & 57 & \{0,3\} \\ \hline \text{f5} & 0.5400 & 57 & \{0,3\} \\ \hline \text{f7} & 24.0000 & 57 & \{0,3\} \\ \hline \end{array}$

All methods except LongestOrderedSequence give the same output:

Equal @@ Rest[results]

True

benchmark = {{4, 4}, {8, 8}, {14, 12}, {16, 16}, {22, 20}, {26, 
   24}, {32, 32}, {38, 36}, {44, 40}, {46, 44}, {52, 48}, {58, 
   56}, {62, 60}, {64, 64}, {74, 72}, {82, 80}, {86, 84}, {92, 
   88}, {94, 92}}

f5

Not very good, but my first thought. End up been the second slowest in @kglr's test.

DeleteDuplicates@FoldList[
  First[MaximalBy[Last][{#1, #2}]] &,
  points
  ] == benchmark

(* True *)

f6

I like the simplicity if this one, and end up been the second fastest in @kglr's test.

Union[points, SameTest -> (Last@#1 <= Last@#2 &)] == benchmark

(* True *)