Dark Satanic Mills on a Cloudy Day

Author

Eric W. Weisstein
January 8, 2025

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Combinatorics/DarkSatanicMillsonaCloudyDay.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/DarkSatanicMillsonaCloudyDay.html.

©2025 Wolfram Research, Inc. except for portions noted otherwise

Figures

OEIS

Picture of excess A326499 for n = 1..10501 in batches of length of perfect Wichman rules A289761.

Import["https://oeis.org/A046693/a046693_1.jpg"]

Import["https://oeis.org/A326499/a326499.jpg"]

ArrayPlot

Take[Import["https://oeis.org/A326499/a326499_1.txt","Lines"],20]//Column

Length[seq=Join[Table[0,50],BFileSequence[326499]]]

WichmannValues=Table[(n^2-(Mod[n,6]-3)^2)/3+n,{n,20}]

parts=Select[{#+1,#2}&@@@Partition[WichmannValues,2,1],Max[#]≤150&]

Length[parts]

StringJoin@@@(ToString/@Take[seq,#]&/@parts)//Column

With[{data=Characters[StringReplace[Import["https://oeis.org/A326499/a326499_1.txt","List","HeaderLines"->4],d:NumberString~~__:>d]]/.{"0"->.2,"1"->1}},
ArrayPlot[Transpose@PadLeft[data]]]

Table

From Ed Pegg. Jr.
Jan 7, 2025

WichmannValues=Table[(n^2-(Mod[n,6]-3)^2)/3+n,{n,1,42}]

Grid[Append[Transpose[Table[PadLeft[Take[
Style[If[Length[ResourceFunction["Excess01Ruler"][#,"Full"]]-Round[Sqrt[3 #+9/4]]==1,Style[#,Black,Bold,16],Style[#,Gray,14]]]&/@Range[213],{WichmannValues[[n]]+1,WichmannValues[[n+1]]}],15,""],{n,24-1}]],Range[3,25]],Spacings->{.2,.2},Dividers->{False,-2->Blue}]

sparsedatasmall=;

differencesToRuler[list_]:=FoldList[Plus,0,list];
splittodiff[split_] := Flatten[Table[#[[1]],{#[[2]]}]&/@Transpose[split]];
SplittoRuler[split_]:=  differencesToRuler[splittodiff[split]];

sparsedatasmall[[214]]

SplittoRuler[sparsedatasmall[[214]]]

A326499 =Table[Length[SplittoRuler[sparsedatasmall[[k]]]] -Round[Sqrt[3 k+9/4]],{k,1,600}]

Grid[Append[Transpose[Table[PadLeft[Take[
Style[If[A326499[[#]]==1,Style[#,Black,Bold,16],Style[#,Gray,14]]]&/@Range[327],{WichmannValues[[n]]+1,WichmannValues[[n+1]]}],19,""],{n,30-1}]],Range[3,31]],Spacings->{.2,.2},Dividers->{False,-2->Blue}]

Grid[Append[Transpose[Table[PadLeft[Take[
Style[If[A326499[[#]]==1,Style[#,Black,Bold,16],Style[#,Gray,14]]]&/@Range[465],{WichmannValues[[n]]+1,WichmannValues[[n+1]]}],23,""],{n,36-1}]],Range[3,37]],Spacings->{.2,.2},Dividers->{False,-2->Blue}]