I feel all plots in both episodes are related to something A New Kind of Science. Meanwhile I put your code directly within a Compile function and the speedup is definitely noticeable with minimum modification:
cf = Compile[{},
Module[{x, max, invalid, new},
x = ConstantArray[1, 10^5];
Do[
max = Floor[(i - 1)/2];
invalid = 2 x[[i - max ;; i - 1]] - x[[i - 2 max ;; i - 2 ;; 2]];
invalid =
Pick[invalid, 1 - UnitStep[-invalid], 1];(*remove nonpositive*)
invalid = Sort[DeleteDuplicates[invalid]];
new = -1;
If[Last[invalid] == Length[invalid], new = Length[invalid] + 1;,
Do[If[invalid[[k]] =!= k, new = k;
Break[];], {k, 1, Length[invalid]}];
If[new == -1, new = Last[invalid] + 1];];
x[[i]] = new;, {i, 3, Length[x]}];
x
]
, CompilationTarget -> "C"]
