(*     Package pour Mathematica 4
							"\!\(\*UnderscriptBox[\(Propagation\\\\ des\\\\ incertitudes\), \(_\)]\)"						 
			
							par Marcel Délèze
						 Collège du Sud, CH 1630 Bulle
							Version de déc. 2002         *)

BeginPackage["CalculErreur`"]

mσ::usage=
	"mσ[x] où x = {x1, x2, ..., xn} calcule {m, (Overscript[σ, __])} où \n     m est la moyenne de x et\n    (Overscript[σ, __])=(Sqrt[(((∑_(j = 1)^n)((((Subscript[x, j]) - m))^2))/(n (n - 1)))]) l'écart-type de la moyenne;
		\n\nmσ[x,σ] où x = {x1, x2, ..., xn} calcule {m,(Overscript[σ, __])} où \n     m est la moyenne de x et\n    (Overscript[σ, __])=(σ/(Sqrt[n])) l'écart-type de la moyenne; 
		\n\nmσ[x] où x = {{x1,Δx1,}, {x2,Δx2}, ..., {xn,Δxn}} calcule {m,(Overscript[σ, __])} où\n      m est la moyenne de {x1, x2, ...} et\n     (Overscript[σ, __])=(Sqrt[(((∑_(j = 1)^n)(Subscript[Δx, j]^2))/(n (n - 1)))]) l'estimateur de l'écart-type de m."

resultArrondi::usage=
	"resultArrondi[{m,Δm}] arrondit {m,Δm}; \n\n	resultArrondi[x] arrondit chaque élément de la liste\n     x = {{x1,Δx1}, {x2,Δx2}, ...}."

gauss::usage=
	"gauss[f,v] calcule la formule de l'incertitude absolue de\n    l'expression f par rapport à la liste de variables v."

gaussRel::usage=
	"gaussRel[f,v] calcule la formule de l'incertitude relative de\n    l'expression f par rapport à la liste de variables v."

evalF::usage=
	"evalF[f,v,m] calcule les valeurs de l'expression f\n {{f1}, {f2}, ...} en donnant à la liste de variables v les valeurs m."

evalΔf::usage=
	"evalΔf[f,v,m,i] calcule les incertitudes absolues de l'expression f\n {Δf1, Δf2, ...} en donnant à la liste de variables v les valeurs m\n et aux incertitudes correspondantes les valeurs i."

evalΔfRel::usage=
	"evalΔfRel[f,v,m,i] calcule les incertitudes relatives de l'expression f\n {((Δf1)/f1), ((Δf2)/f2), ...} en donnant à la liste de variables v les valeurs m\n et aux incertitudes correspondantes les valeurs i."

evalFΔf::usage=
	"evalFΔf[f,v,m,i] calcule les valeurs et incertitudes absolues de l'expression f\n {{f1,Δf1}, {f2,Δf2}, ...} en donnant à la liste de variables v les valeurs m\n et aux incertitudes correspondantes les valeurs i."

evalΔvar::usage=
	"evalΔvar[v,m,i] calcule les incertitudes absolues sur chaque variable\n {{Δx1,Δy1,...}, {Δx2,Δy2}, ...}} en donnant à la liste de variables v les valeurs m\n et aux incertitudes correspondantes les valeurs i."

ℜ::usage=
	"Placé dans la déclaration d'une incertitude,\n le symbole ℜ indique que l'incertitude est relative."

substitue::usage=
"substitue[v,m] crée une liste de substitutions\n où les variables de la liste v prennent les valeurs de la liste m;
		\n\nsubstitue[v,m,i] crée une liste de substitutions\n  où les variables v prennent les valeurs m et\n  les incertitudes correspondantes prennent les valeurs i."

graphErr::usage=
	"graphErr[res] crée un graphique avec la liste\n res = {{y1,Δy1}, {y2,Δy2},...} dont les abscisses sont {1, 2, ...}; \n\n
		graphErr[absc, res] crée un graphique avec les listes\n absc = {x1, x2, ...}, res = {{y1,Δy1}, {y2,Δy2}, ...}."

protege::usage=
	"protege[v] protège une liste de variables v = {a, b, c, ...} et\n les variables {Δa, Δb, Δc, ...} qui désignent les incertitudes correspondantes."

formatPourcent::usage=
	"formatPourcent[x] affiche le nombre x au format %.\n Si x est un vecteur, il est converti en une matrice colonne."

Off[General::spell1];

Begin["`Private`"]

mσ[x_List]:=Module[{n,m,σ},
		n=Length[x];
		m=((Apply[Plus,x])/n);
		σ=(Sqrt[((Apply[Plus,(x-m)^2])/(n(n-1)))]);
		{N[m],N[σ]}]/;VectorQ[x];

mσ[x_List,σ_]:=N[{((Apply[Plus,x])/(Length[x])),(σ/(Sqrt[Length[x]]))}]/;VectorQ[x];

mσ[x_List]:=Module[{n,v,dv,m,σ},
		n=Length[x];
		{v,dv}=Transpose[x];
		m=((Apply[Plus,v])/n);
		σ=(Sqrt[((Apply[Plus,dv^2])/(n(n-1)))]) ;
		{N[m],N[σ]}]/;MatrixQ[x];

resultArrondi[{m_,Δm_}]:=Module[{n},
		n=Floor[Log[10,Abs[Δm]]];
		{N[Round[m*10^(-n)]*10^n],N[Round[Δm*10^(-n)]*10^n]}/;NumericQ[m]&&NumericQ[Δm]]

resultArrondi[x_List]:=Map[resultArrondi,x]

grad[f_,v_List]:=Table[D[f,v[[j]]],{j,1,Length[v]}]

errListe[v_List]:=
Table[Symbol[StringInsert[SymbolName[v[[j]]],"Δ",1]],{j,1,Length[v]}]

gauss[f_,v_]:=Abs[D[f,v]*Symbol[StringInsert[SymbolName[v],"Δ",1]]]/;AtomQ[v]

gauss[f_,v_List]:=Sqrt[Apply[Plus,(grad[f,v]*errListe[v])^2]]

gaussRel[f_,v_]:=Simplify[(Sqrt[(((((gauss[f,v])/f)))^2)])]

evalF[f_,v_,m_]:=Transpose[{f/.substitue[v,m]}]

evalΔf[f_,v_,m_,i_]:=gauss[f,v]/.substitue[v,m,i];

evalΔfRel[f_,v_,m_,i_]:=((evalΔf[f,v,m,i])/(Flatten[evalF[f,v,m],1])) ℜ;

evalFΔf[f_,v_,m_,i_]:=Module[{val},val={Flatten[evalF[f,v,m],1],
	evalΔf[f,v,m,i]};
	If[MatrixQ[val],Transpose[val],{val}]];

evalΔvar[v_,m_,i_]:=Transpose[Table[evalΔf[v[[k]],v[[k]],Transpose[m][[k]],i[[k]]],{k,1,Length[v]}]];

Protect[ℜ];

affine[m_,a_*ℜ+b_]:=a m+b

affine[m_,a_*ℜ]:=a m

affine[m_,b_]:=b

composante[k_][i_List]:=i[[k]]

composante[k_][i_]:=i

substitue[v_,m_]:={v->N[m]}/;NumericQ[m]

substitue[v_,m_List]:=Table[{v->N[m[[k]]]},{k,1,Length[m]}]/;SameQ[Head[v],Symbol]

substitue[v_List,m_List]:=Table[v[[k]]->N[m[[k]]],{k,1,Length[m]}]/;VectorQ[m]

substitue[v_List,m_List]:=Table[substitue[v,m[[k]]],{k,1,Length[m]}]/;MatrixQ[m]

substitue[v_,m_,i_]:={v->N[m],Symbol[StringInsert[SymbolName[v],"Δ",1]]->affine[m,i]}/; NumericQ[m]

substitue[v_,m_List,i_]:=Table[substitue[v,m[[k]],i],{k,1,Length[m]}]/;SameQ[Head[v],Symbol]

substitue[v_List,m_List,i_List]:=Flatten[Table[substitue[v[[k]],m[[k]],i[[k]]],{k,1,Length[m]}]]/;VectorQ[m]

substitue[v_List,m_List,i_List]:=Table[substitue[v,m[[k]],Map[composante[k],i]],{k,1,Length[m]}]/;MatrixQ[m]

barre[x_,Δx_,y_,Δy_]:=Line[{{x-Δx,y+Δy},{x+Δx,y+Δy},{x,y+Δy},{x,y-Δy},
			{x-Δx,y-Δy},{x+Δx,y-Δy}}]

graphErr[ordErr_List]:=Module[{a, b, c, dx,p},
		p=Transpose[{Range[Length[ordErr]],
Transpose[ordErr][[1]],
Transpose[ordErr][[2]]}];
a=1-0.1*(Length[ordErr]-1);
		b = Length[ordErr]+0.1*(Length[ordErr]-1);
		dx=(b-a)*0.002;
		c=Min[Table[p[[i,2]]-1.5*p[[i,3]],{i,1,Length[p]}]];
		Graphics[
		Table[barre[p[[i,1]],dx,p[[i,2]],p[[i,3]]],{i,1,Length[p]}],
	PlotRange->{{a,b},All},
			AxesOrigin->{a,c},
		Axes->True,
			Ticks->{Range[Length[ordErr]],Automatic},
		ImageSize->{300, 200}]]

graphErr[abscisses_List,ordErr_List]:=Module[{a, b, c,dx, p},
		p=Transpose[{abscisses,
Transpose[ordErr][[1]],
Transpose[ordErr][[2]]}];
a=Min[abscisses]-0.1*(Max[abscisses]-Min[abscisses]);
	b=Max[abscisses]+0.1*(Max[abscisses]-Min[abscisses]);
		dx=(b-a)*0.002;
			c=Min[Table[p[[i,2]]-3*p[[i,3]],{i,1,Length[p]}]];	
		Graphics[
			Table[barre[p[[i,1]],dx,p[[i,2]],p[[i,3]]],{i,1,Length[p]}],
	PlotRange->{{a,b},All},
	PlotRange->{{a,b},All},
			AxesOrigin->{a,c},
		Axes->True,
			Ticks->Automatic,
		ImageSize->{400, 300}]]

protege[v_]:=(Map[Protect,v];Map[Protect,errListe[v]];)

formatPourcent[x_]:=Transpose[{x/.{ℜ->100. "%"}}]/;VectorQ[x]

formatPourcent[x_]:=x/.{ℜ->100. "%"};

End[]

EndPackage[]