Mathematica functions:
positionDuplicates[list_] := GatherBy[Range@Length[list], list[[#]]
&]
listDuplicates[l_] := DeleteDuplicates@Block[{i}, i[n_] := (i[n] =
n; Unevaluated@Sequence[]); i /@ l]
IntegerPower[k_, b_] := If[IntegerQ[#], # - 1, Floor[#]]
&@Rationalize[Log[b, k]];
(*https://mathematica.stackexchange.com/questions/203992/highest-power-of-x-of-a-number-k-that-is-less-than-n/203994#203994*)
(*
IntegerPower[345, 7] (* Outputs 3 *)
IntegerPower[0.0028, 7] (* Outputs -4 *)
IntegerPower[100, 2] (* Outputs 6 *)
IntegerPower[0.5, 2] (* Outputs -2 *)
*)
Primorial[n_] := Times @@ Prime[Range[n]]
(*Primorial[5]*)
gpf[1] := 1
gpf[n_Integer?Positive] := FactorInteger[n][[-1, 1]];
(*https://mathematica.stackexchange.com/questions/65708/how-do-i-find-the-position-of-the-maximum-value-in-each-column-of-a-table*)
(*function to find the position(s) of max values in columns of a
table, also other code on that same stackexchange page*)
maxValuePositions[list_] :=
Join @@ MapIndexed[Thread[{First /@ Position[#, Max@#],
First@#2}] &,
Transpose[list]]
(*used in A319148*)
(*check period of repeating fraction*)
ClearAll[fracPer,vp];
(*p-adic order*)
vp[p_?PrimeQ,n_Integer]:=Length@NestWhileList[#/p&,n/p,IntegerQ]-1;
(*fraction decimal expansion period*)
fracPer[q_Integer]:=0;
fracPer[q_Rational]:=Module[{den,p2,p5},den=Denominator[q];
p2=vp[2,den];
p5=vp[5,den];
den=den/2^p2/5^p5;
If[den==1,0,MultiplicativeOrder[10,den]]];
fracPer[1/60013] (* 5001 *)
fracPer[1/7] (* 6 *)
(* "fracPer" function from oeis A307388: used in code "Reciprocals
of Primes" ie for prime p, (p-1)/fracPer[1/p] is oeis sequence
A060370 (or related A006556), see 20220314 numberphile video "The
Reciprocals of Primes": *)
(*read data from websites into mathematica:*)
(* example of a webpage with a single table*)
data = Import[
"https://jmorken.github.io/20210505%20tree%20of%20composites/tree%\
20of%20composites%20page2%20transforms1.html", "Data"]
data2 = data[[2 ;; 9,
2 ;; 22]] (*extract rows 2 through 9 and columns 2
through 21*)
MatrixForm[data2]
data2[[1]]
data3 = Transpose[data2] (*transpose rows and columns*)
MatrixForm[data3]
data3[[1]]
(* example of a webpage with multiple tables*)
data = Import[
"https://jmorken.github.io/20210505%20tree%20of%20composites/tree%\
20of%20composites%20page2.html", "Data"]
data[[1]] (*display first table*)
ClearAll[fracPer,vp];
(*p-adic order*)
vp[p_?PrimeQ,n_Integer]:=Length@NestWhileList[#/p&,n/p,IntegerQ]-1;
(*fraction decimal expansion period*)
fracPer[q_Integer]:=0;
fracPer[q_Rational]:=Module[{den,p2,p5},den=Denominator[q];
p2=vp[2,den];
p5=vp[5,den];
den=den/2^p2/5^p5;
If[den==1,0,MultiplicativeOrder[10,den]]];
fracPer[1/60013] (* 5001 *)
fracPer[1/7] (* 6 *)
(* "fracPer" function from oeis A307388: used in code "Reciprocals
of Primes" ie for prime p, (p-1)/fracPer[1/p] is oeis sequence
A060370 (or related A006556), see 20220314 numberphile video "The
Reciprocals of Primes": *)
(*file I/O*)
(*can use one notebook to generate data and export .mx files and
then another notebook in the same local folder with code to import
and process the .mx files etc *)
Directory[] (*check the current directory*)
SetDirectory[NotebookDirectory[]] (*set the directory to the current
directory the notebook is in before importing and exporting data
from files*)
Print["export and import as binary format (fastest)"]
Export["planetaryGearList.mx", planetaryGearList]
xyz=Import["planetaryGearList.mx"]
Print["save as user readable mathematica package"]
(*Save["planetaryGearListWithGearRatios.m",planetaryGearListWithGearRatios];*)
(*xyz=Get["planetaryGearListWithGearRatios.m"]*)
Print["export and import as user readable mathematica package"]
Export["planetaryGearListWithGearRatios.m",planetaryGearListWithGearRatios];
xyz=Import["planetaryGearListWithGearRatios.m"]
Print["export and import as plain text table"]
Export["planetaryGearListWithGearRatios.txt",planetaryGearListWithGearRatios,"Table"]
xyz=Import["planetaryGearListWithGearRatios.txt","Table"]
Print["export and import as comma delimited csv"]
Export["planetaryGearListWithGearRatios.csv",planetaryGearListWithGearRatios]
(*xyz=Import["planetaryGearListWithGearRatios.csv"]*)
Print["export listplot images"]
listPlotToExport=ListPlot[planetaryGearRatios];
Export["planetaryGearListWithGearRatios-default.eps",listPlotToExport,"EPS"];
Export["planetaryGearListWithGearRatios-default.svg",listPlotToExport,"SVG"];
Export["planetaryGearListWithGearRatios-default.png",listPlotToExport,"PNG"];
(*png is easiest to view in windows*)
(*code for listplot export from:
https://mathematica.stackexchange.com/questions/18999/obtaining-better-quality-in-listplot
*)
data=planetaryGearRatios;
S0=ListPlot[data,Axes->False,Frame->True,FrameLabel->{"x",OverDot["x"]},RotateLabel->False,FrameStyle->Directive[FontSize->17,FontFamily->"Helvetica"],PlotStyle->{Black,PointSize[0.001]},PlotRange->{{0,5000},{0,0.5}},ImageSize->550];
(*Export["pss_plot0-5000.eps",S0,"EPS"];*)
(*Export["pss_plot0-5000.svg",S0,"SVG"];*)
Export["pss_plot0-5000.png",S0,"PNG"];
data=planetaryGearRatios;
S0=ListPlot[data,Axes->False,Frame->True,FrameLabel->{"x",OverDot["x"]},RotateLabel->False,FrameStyle->Directive[FontSize->17,FontFamily->"Helvetica"],PlotStyle->{Black,PointSize[0.001]},PlotRange->{{20000,40000},{0,0.5}},ImageSize->550];
(*Export["pss_plot20000-40000.eps",S0,"EPS"];*)
(*Export["pss_plot20000-40000.svg",S0,"SVG"];*)
Export["pss_plot20000-40000.png",S0,"PNG"];