Eisenberg: Favorite linear algebra projects
Worldwide Mathematica Conference • Chicago 1998

Source file for FitData.m

(* Worldwide Mathematica Conference - Chicago 1998 *)
(* file FitData.m: creates data for least-squares polynomial fitting *)
(* Copyright © 1998 by Murray Eisenberg *)

Begin["special`temp`"]	(* encapsulate whole file *)

(* Check for needed globals *)

(* checking myID and myName *)

datapts`check`checking::noID = "\nYou forgot to define myID!";
datapts`check`checking::badID = 
  "\nmyID must be a string, enclosed in quotes, consisting "<>
		"of the digits of your student ID number.";
datapts`check`checking::noName = "\nYou forgot to define "<>
	"myName!";
datapts`check`checking::badName = 
  "\nmyName must be a string, enclosed in quotes, consisting "<>
		"of at least three letters of your (first) name.";

datapts`check`checkingNoID = 
	If[Names["myID"] === {}, True, False];

datapts`check`checkingNoName = 
	If[Names["myName"] === {}, True, False];

datapts`check`checkingOK =
	If[datapts`check`checkingNoID, 
		Message[datapts`check`checking::noID]; False,
	If[!StringQ@ToExpression@"myID", 
		Message[datapts`check`checking::badID]; False,
	If[(!Apply[And, 
			Map[MemberQ[Characters@"0123456789", #]&, 
				Characters@ToExpression@"myID"]])
		|| (0 == StringLength@ToExpression@"myID"), 
		Message[datapts`check`checking::badID]; False,
	If[datapts`check`checkingNoName,
		Message[datapts`check`checking::noName]; False,
	If[!StringQ@ToExpression@"myName", 
		Message[datapts`check`checking::badName]; False,
	If[(!Apply[And, 
		Map[MemberQ[Characters@"ABCDEFGHIJKLMNOPQRSTUVWXYZ", #]&,
				Characters@ToUpperCase@ToExpression@"myName"]])
		|| (3 > StringLength@ToExpression@"myName"),
		Message[datapts`check`checking::badName]; False, 
		True
	]]]]]];

If[datapts`check`checkingOK,
	BeginPackage["datapts`"]
]

If[datapts`check`checkingOK,
	Begin["`Private`"]
]

(* SETUP AND TEST ... *)

If[datapts`check`checkingOK,


(* PREPARE TEST DATA *)

(* Functions used to generate test data *)

SeedRandom[Floor[0.123456 * 	
	ToExpression@ToExpression@"Global`myID"]];

Options[roll] = {dice -> 0};
roll[n_Integer?Positive,  opts___?OptionQ] := Module[{k},
	k = dice/.{opts} /. Options[roll];                          
   	If[k == 0, Random[Integer, {1, n}],                    
		Table[Random[Integer, {1, n}], {k}]
	]
];
roll[m_Integer, n_Integer, opts___?OptionQ] := Module[{k},
	k = dice/.{opts} /. Options[roll];                  
    If[k == 0, Random[Integer, {m, n}], 
		Table[Random[Integer, {m, n}],{k}]
	]
];

(* must split off cst term to avoid Indeterminate 0^0 *) 
polyval[c_, x_] := 
    c[[1]] + Sum[c[[j+1]] x^j, {j, 1, Length[c] - 1}];
    
makexymat := Module[{id, n, c, m, fuzz, x, y}, 
    id = ToExpression@(ToExpression@"Global`myID");
    n = 3 + Mod[id, 7];
    c = 0.1 roll[-14, 25, dice -> n + 1];
    m = Length@c;
    c[[m]] = 0.1 roll[5];
    fuzz = 0.0001 roll[-99, 200, dice -> roll[31, 60]];
    x = 0.01 roll[-299, 300, dice -> Length[fuzz]];
    x = Sort[x]; 
    y = (polyval[c, #]&) /@ x;
    y = y + fuzz; 
    Transpose[{x, y}]
    ];
    
(* CREATE DATA *)

(* Form problem data and instructions *)

stateProblem[name_] := 
    (xy = makexymat;
    dataSave[name<>"data", "The list of xy data pairs", 
            "xy"]
    );
    
    
(* GENERAL PROBLEM-POSING FUNCTIONS *)
 
dataSave[varname_String, what_String, dataname_String] := 
    (ToExpression[StringJoin[Sequence@@{"Global`"<>varname, "=", dataname}]]; 
     {(what<>" is stored in variable "),varname});
        
startline[id_String] :=
      "Data for ID #"<>id<>" prepared "<>tstamp[Date[]]<>
      " ...\n";
    
tstamp[when_] := 
    Module[{t, year, month, day, hour, minute},
        t = If[Length[when] == 0, Date[], when];
        t[[1]] = Mod[t[[1]], 100];
        {year, day, hour, minute} = Map[ToString, t[[{1, 3, 4, 5}]]];
        minute = StringTake["0"<>minute, -2];
        month = {"Jan", "Feb", "Mar", "Apr", "May", "Jun",
            "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"}[[t[[2]]]];
        day<>" "<>month<>" "<>year<>", "<>hour<>":"<>minute];
         
firstStringPosition[t_String, ch_String] :=
    StringLength[t] + 1 /; StringPosition[t, ch] === {}; 
firstStringPosition[t_String, ch_String] := 
    First@Flatten@StringPosition[t, ch];
     
setup[id_String, name_String] := 
    Module[{nameStub, aboutProblem}, 
        nameStub = ToUpperCase@StringTake[name, 3];
        aboutProblem = stateProblem[nameStub];
        CellPrint[Cell[TextData[ {
        	StyleBox[startline[id], FontWeight->"Bold"],
        	aboutProblem[[1]],
        	StyleBox[aboutProblem[[2]], FontFamily->"Courier"]
        	}], "Text",
        	CellFrame->True, Background->GrayLevel[0.849989]]
		]
	]; 
    
(* Execute it! *) 

setup[ToExpression@"Global`myID", 
      ToExpression@"Global`myName"];
      
] (* endIf -- end setup *)

datapts`check`checkingOK = True;

If[datapts`check`checkingOK,
	End[]	(* end Private *)
]

If[datapts`check`checkingOK,
	EndPackage[]
]

(* CLEAN UP  *)

(* clean up in case myID or myName was not defined *)
If[datapts`check`checkingNoID, 
	Remove[myID]
];

If[datapts`check`checkingNoName, 
	Remove[myName]
]

(* Don't leave package context in $ContextPath or $Packages! *)

If[datapts`check`checkingOK, 
	$ContextPath= Drop[$ContextPath, 1]
]

Delete[$Packages, Position[$Packages, "datapts`"]]

Remove["datapts`check`*"]	(* clean up `check` objects *)

Off[Remove::rmnsm];
Remove["special`temp`*"];	(* remove all locals in this file *)
On[Remove::rmnsm]

End[];	(* end special`temp` *)

(* end of file *)