Skip to main content
Source Link
Nicholas G
  • 2.1k
  • 12
  • 17

As I mentioned in a comment, I do not use an init.m file, I paste my frequently used functions from project notebook to project notebook as an initialization cell. That having been said, my initialization cell is:

If[False, {(* 
  true for saving to PDF at true dimensions and ImageResolution of \
1200 PDI, false for large graphs for screen and saving as PNG, 
  see  https://mathematica.stackexchange.com/a/234591/43662*)
  ftsz = 12,(*fontsize 12 for graph publication quality PDFs*)
  imgsz = 100, 
  imgrez = 2400}(*imagesize coefficient 57/was100 equal to one inch*)
\

 , {ftsz = 38, imgsz = 267, 
  imgrez = 72}];(*else for large images and publishing PNG graphs \
42/200*)
fntandsz = {FontFamily -> (fntFam = "Georgia")(*"Times"*), 
  FontSize -> ftsz};
$HistoryLength = 5;
txt[a_, b_, c : {_?NumericQ, _?NumericQ} : {0, 0}, 
  d : {_?NumericQ, _?NumericQ} : {1, 0}, opt : OptionsPattern[]] := 
 Text[Style[a, opt, FontFamily -> "Georgia"(*"Times"*), 
   FontSize -> ftsz], b, c, 
  d](* This simplifies the input for text in raphics to avoid the \
need to nest Text[Style[ ] ] in every graphic. The options at the end \
get passed to Style[]. The previous arguments are made optional by \
getting a default value ":{0,0}" while a test prevents the code from \
confusing an option for those with ":{_?NumericQ,_NumericQ}" *) 
fpath = (NotebookBrowseDirectory /. Options[$FrontEnd]) <> 
  "\\";(*save in notebook path*)
(*stop evaluation if the path does not end in \Documents\*)
If[StringTake[fpath, -11] != "\\Documents\\",
 (*Remove cells from evaluation queue*)(
  SelectionMove[EvaluationNotebook[], All, Notebook, 
   AutoScroll -> False];
  FrontEndExecute@FrontEndToken@"RemoveFromEvaluationQueue";
  SelectionMove[EvaluationCell[], After, Cell, AutoScroll -> False];
  (*set $Pre to abort current cell but before that schedule a task to \
un-define $Pre*)
  SessionSubmit[ScheduledTask[$Pre =., {Quantity[3, "Seconds"]}]];
  MessageDialog[
   "Wrong working directory! Open and close a file in /Documents and \
rerun."];
  $Pre = Abort[] &; 
  Abort[];)];(*end of sequence stopping evaluation if the directory \
is false*)
droptrailingperiod[x_] := 
 If[Round[x] == x,(*is the rightmost a period, from some precision?*)

  
  Round[x](*then use Round to drop the trailing period*)
  , x](*else not*)
adollartick[
  x_] := {x,(*define a function that creates a tick label pair for \
dollar amounts*)
  NumberForm[droptrailingperiod@x, NumberSigns -> {"-$", "$"}, 
   DigitBlock -> 
    3](*put dollar sign and comma and drop the trailing period*)
  }
dollarticks[min_, max_] := 
 adollartick[#] & /@ 
  N[FindDivisions[{min, max}, 
    3]](*to produce dollar amounts as tick marks with three tickmarks*)


dollarticks7[min_, max_] := 
 adollartick[#] & /@ 
  N[FindDivisions[{min, max}, 
    7]](*to produce dollar amounts as tick marks with seven tickmarks*)


apercenttick[x_] := {x,(*function of tick pair for percentages*)
  ToString[
    droptrailingperiod[
     100 x]](*multiply by 100 and drop trailing period*)
   <> "%"}(*and append a % sign*)
percentticks[min_, max_] := 
 apercenttick[#] & /@ N[FindDivisions[{min, max}, 7]]
fewpercentticks[min_, max_] := 
 apercenttick[#] & /@ N[FindDivisions[{min, max}, 4]]
fewticks[min_, max_] := 
 droptrailingperiod[#] & /@ N[FindDivisions[{min, max}, 4]]
acommatick[x_] := {x, AccountingForm[x]}
commaticks[min_, max_] := 
 acommatick[#] & /@ FindDivisions[{min, max}, 7]
fewcommaticks[min_, max_] := 
 acommatick[#] & /@ FindDivisions[{min, max}, 4]
seagreen = 
 RGBColor[{46/255, 139/255, 
   87/255}];(*also define some extra colors*)
yellowgreen = RGBColor[{173/255, 1, 47/255}];
darkyellow = RGBColor[{204/255, 204/255, 0}];
(*a very complex function for placing text in 3D:*)
text3D[str_, location_ : {0, 0, 0}, 
  scaling : {_?NumericQ, _?NumericQ} : { 1, 1}, 
  longitude : _?NumericQ : 0, elevation : _?NumericQ : 0, 
  tilt : _?NumericQ : 0, opt : OptionsPattern[]] := 
 Module[{mesh = 
    DiscretizeGraphics[
     Text[
      Style[str, opt, FontFamily -> "Georgia"(*"Times"*), 
       FontSize -> 12(*don't scale with ftsz*)]], _Text, 
     MaxCellMeasure -> 0.04],
   rotmatrx = 
    RotationMatrix[longitude, {0, 0, 1}] . 
     RotationMatrix[-elevation, {0, 1, 0}] . 
     RotationMatrix[tilt, {1, 0, 0}]}, 
  Join[{EdgeForm[]}, 
   MeshPrimitives[mesh, 
     2] /. {x_?NumberQ, 
      y_?NumberQ} :> (rotmatrx . (scaling~Join~{1} {x, y, 0}) + 
       location)
   (*,{Black},MeshPrimitives[BoundaryMesh[mesh],1]/.{x_?NumberQ,y_?
   NumberQ}\[RuleDelayed](rotmatrx.(scaling~Join~{1} {x,y,0})+
   location)REMOVE REM IF NEEDING OUTLINES, see https://
   mathematica.stackexchange.com/a/131842/43662*)]]
twoYrDigitAbbrev[yr_] := 
 "\[CloseCurlyQuote]" <> 
  StringTake[ToString[yr], -2](*Show 1964 as '64*)
twoDgNo[x_] := 
 NumberForm[
  x, {5, 2}](*Show 3.1415923 as 3.14; no not use for numbers with \
over 5 digits*)
numericOrPercent[num_, digits_ : {2, 0}] := Which[
  0 <= num <= 1 && NumericQ[num], 
  Style[PercentForm[num, digits], FontSlant -> Plain],
  NumericQ[num], Style[num, FontSlant -> Plain],
  True, num]
tblFm2Dgt[x_List, opt : OptionsPattern[]] /; Length@Dimensions@x > 1 :=
  TableForm[Map[twoDgNo[#] &, x, {2}], 
  opt](*to make tables show two digits while exportable with built-in \
precision*)
(*define the chi-squared test*)
chiSquareTest[obs_List, exp_List] /; 
  Dimensions[obs] == Dimensions[exp] := 
 Block[{t}, t = Total[(Flatten@obs - Flatten@exp)^2/Flatten@exp] // N;
  {Rule["chisqr", t], 
   Rule[pval, 
    SurvivalFunction[
     ChiSquareDistribution[
      Times @@ 
       Table[Dimensions[exp][[i]] - 1, {i, Length@Dimensions@exp}]], 
     t]]}]
expTable[u_List] := Module[(*Create null hypothesis matrix*)
  {rs = Plus @@ u,
   cs = Plus @@ Transpose[u],
   n = Total[Flatten[u]]},
  Transpose@Outer[Times, rs, cs]/n]
lineAndPoints[lst_List] := {Line[lst], 
  Tooltip[Point[#], #[[2]]] & /@ lst}
percent[n_] := 
 If[n > 1 || n < 0, "Erroneous use of percent.", 
  If[n == 1, "100%", StringTake[ToString[twoDgNo[n]], -2] <> "%"]]
SetOptions[AccountingForm, 
  DigitBlock -> 3];(*Use AccountingForm to see 
numbers with commas and spaces every third decimal digit.*)

I also have some functions for abbeviations according to the Blue Book citation system that legal practice uses, if anyone is interested I 'd gladly share.

Post Made Community Wiki by Nicholas G