Something went wrong on our end
Code owners
Assign users and groups as approvers for specific file changes. Learn more.
(* ::Package:: *)
BeginPackage["Vegas`",{"ErrorBarPlots`","ErrorBarLogPlots`"}];
MergePlots::usage="MergePlots[list] statistically combines a list of plots. MergePlots[list, True] also returns the bin-wise chisq";
IntegrateHistogram::usage="IntegrateHistogram[plot] integrates a histogram.";
CombinePlots::usage="CombinePlots[A,B] adds the histograms A and B, CombinePlots[A,B,op->f] combines them using the function f";
ApplyPlot::usage="ApplyPlot[a,op] applies the operator op to the histogram a";
ScalePlot::usage="Rescales a plot by a factor such that the integral remains unchanged";
MergeNumbers::usage="MergeNumbers[{ {y1, e1}, {y2, e2}, ..}] statistically combines a list of numbers";
PlusNumbers::usage="PlusNumbers[{y1,e1},{y2,e2},...] computes y1+y2+.. and the correct error";
DivideNumbers::usage="DivideNumbers[{y1,e1},{y2,e2}] computes y1/y2 and the correct error";
TimesNumbers::usage="TimesNumbers[{y1,e1},{y2,e2}] computes y1 y2 and the correct error";
CombinePlots::tdlen = "Objects of unequal length";
CombinePlots::wrongx = "X values do not match";
Options[CombinePlots] = {op -> Plus};
AddTarLists::usage="AddTarLists can add two lists from LoadTarFile";
MergeTarLists::usage="MergeTarLists can merge multiple lists from LoadTarFile";
ScaleTarList::usage="ScaleTarList rescales a list from LoadTarFile";
MergeBins::usage="MergeBins[plot, n] merges n adjacent bins into one, reducing the error";
ErrorBandPlot::usage="ErrorBandPlot produces an error band plot from a list (see ErrorListPlot)";
$LoadVerbosity={"\[Chi]n1"};
GuessGood\[Xi]::usage = "GuessGood\[Xi][filename_, flavour_, pieceR_, pieceV_, min_:-4] finds \
the intersection of the real and virtual \!\(\*SubscriptBox[\(\[Xi]\), \(cut\)]\) dependences";
LoadTarFile::usage="LoadTarFile[filename] loads all .vegas files from a tar file and returns a list of rules. ";
LoadTarFile::shamis="SHA checksums of `1` files do not match (`2`).";
LoadTarFile::nenough="`1` is not enough datasets";
(*Prefactor::usage="Prefactor is the prefactor restored during LoadTarFile";
Options[LoadTarFile]={Prefactor\[Rule]1(*conv \[Alpha]em^2*)};*)
BuildPattern::usage="BuildPattern[whichpiece, flavour] creates a regular expression to match the correct files.";
WithPattern::usage="WithPattern[whichpiece, ... , expr] creates an enviroment where \[Sigma] can be used to build the pattern. Avaible options include the folder to search (i.e. Folder->\"nnlo/out\") and the obserable (Observable->\"30\").";
Observable::usage="The observable as specified by the O variable of the vegas file";
Folder::usage="The folder to search. This can be a pattern.";
Begin["`Private`"];
ErrorListPlot[{{DirectedInfinity[-1], u__}, stuff___}] := ErrorListPlot[{stuff}]
ErrorListPlot[{stuff___, {DirectedInfinity[+1], o__}}] := ErrorListPlot[{stuff}]
ErrorListLogPlot[{{DirectedInfinity[-1], u__}, stuff___}] := ErrorListLogPlot[{stuff}]
ErrorListLogPlot[{stuff___, {DirectedInfinity[+1], o__}}] := ErrorListLogPlot[{stuff}]
ErrorListLogLinearPlot[{{DirectedInfinity[-1], u__}, stuff___}] := ErrorListLogLinearPlot[{stuff}]
ErrorListLogLinearPlot[{stuff___, {DirectedInfinity[+1], o__}}] := ErrorListLogLinearPlot[{stuff}]
ErrorListLogLogPlot[{{DirectedInfinity[-1], u__}, stuff___}] := ErrorListLogLogPlot[{stuff}]
ErrorListLogLogPlot[{stuff___, {DirectedInfinity[+1], o__}}] := ErrorListLogLogPlot[{stuff}]
BuildPattern[whichpiece_,flavour_,folder_String]:=RegularExpression[folder<>"/"<>whichpiece<>"_"<>flavour<>"_S\\d*X([\\d\\.]*.)D([\\d\\.]*).*"]->"{$1,$2}"
BuildPattern[whichpiece_,flavour_,opts___Rule]:=Module[{folder, obs},
folder = Folder/.{opts}; If[folder === Folder, folder=".*"];
obs = Observable/.{opts}; If[obs === Observable, obs=".*", obs="O"<>obs<>"\\.vegas"];
RegularExpression[folder<>"/"<>whichpiece<>"_"<>flavour<>"_S\\d*X([\\d\\.]*.)D([\\d\\.]*)_.*"<>obs]->"{$1,$2}"
]
sigmasign = ToExpression@If[MemberQ[Contexts[], "X`"], "X`DiracS", "Global`\[Sigma]"]
Attributes[WithPattern]={HoldAll};
WithPattern[conf__,body_]:=body/.{sigmasign[x_]:>BuildPattern[x,conf]}
AddTarLists[{"value"->v1_,"chi2a"->c1_,"plots"->p1_},{"value"->v2_,"chi2a"->c2_,"plots"->p2_}]/; p1[[;;,1]]===p2[[;;,1]] :={
"value"->PlusNumbers[v1,v2],"chi2a"->{c1,c2},
"plots"->Table[
p->CombinePlots[p/.p1,p/.p2],
{p,p1[[;;,1]]}
]
}
AddTarLists[a:{(_List->_) ..},b:{(_List->_) ..}] /; a[[;;,1]]===b[[;;,1]] := Table[
k->AddTarLists[k/.a,k/.b],
{k,a[[;;,1]]}
]
ScaleTarList[{"value"->v1_,"chi2a"->c1_,"plots"->p1_},f_] :={
"value"->f v1,"chi2a"->c1,
"plots"->Table[
p->ApplyPlot[p/.p1,# f&],
{p,p1[[;;,1]]}
]
}
ScaleTarList[a:{(_List->_) ..},f_] := Table[
k->ScaleTarList[k/.a,f],
{k,a[[;;,1]]}
]
MergeTarLists[a:{(_List->_) ..}] /; Equal@@("plots"/.a[[;;,2]])[[;;,;;,1]] :=Module[{c,y,e,plotnames,plotdb},
plotdb=("plots"/.a[[;;,2]]);
plotnames=plotdb[[1,;;,1]];
{c,y,e}=MergeNumbers["value"/.a[[;;,2]],True];
If[MemberQ[$LoadVerbosity,"plot\[Xi]"],
Print[ErrorListLogLinearPlot[Thread[{
ToExpression[a[[;;,1]]][[;;,1,1]],
("value"/.a[[;;,2]])[[;;,1]],("value"/.a[[;;,2]])[[;;,2]]
}],PlotRange->All]];
];
If[MemberQ[$LoadVerbosity,"plot\[Delta]"],
Print[ErrorListLogLinearPlot[Thread[{
ToExpression[a[[;;,1]]][[;;,1,2]],
("value"/.a[[;;,2]])[[;;,1]],("value"/.a[[;;,2]])[[;;,2]]
}],PlotRange->All]];
];
If[MemberQ[$LoadVerbosity,"\[Chi]n1"],
Print["Combination of ",a[[;;,1]],"has \!\(\*SuperscriptBox[\(\[Chi]\), \(2\)]\)=",c];
];
{
"value"->{y,e},
"chi2a"->{c,"chi2a"/.a[[;;,2]]},
"plots"->Table[
p->MergePlots[p/.plotdb],
{p,plotnames}
]
}
]
If[10<$VersionNumber<11.4,
addCompletion = FE`Evaluate[FEPrivate`AddSpecialArgCompletion[#]] &,
(* else *)
addCompletion[x_] := Null;
]
addCompletion["LoadTarFile" -> {2}]
LoadTarFile[filename_String]:=Module[{filenames},
filenames=Select[
Import[filename],
FileExtension[#]=="vegas"&
];
Thread[
filenames->Import[
filename,{
"TAR",
filenames
}]
]
]
LoadTarFile[matched_List]:=Module[{plotnames,plots,value},
If[Length[matched]<2,Message[LoadTarFile::nenough,Length[matched]];Abort[]];
If[Not[Equal@@("SHA"/.matched)],
Message[LoadTarFile::shamis,Length[matched],StringRiffle[("SHA"/.matched),","]];
];
plotnames=Complement[
matched[[1,;;,1]],
{
"SHA","iteration","chi2a","value","runtime"
}
];
value=MergeNumbers["value"/.matched,True];
plots=Table[
name->MergePlots[name/.matched],
{name,plotnames}
];
{
"value"->value[[2;;]],"chi2a"->{value[[1]],"chi2a"/.matched},
"plots"->plots
}
]
LoadTarFile[filename_,pat_RegularExpression]:=Module[{tar,matched},
If[Head[filename]===String,
tar=LoadTarFile[filename],
(*else*)
tar=filename
];
LoadTarFile[Select[tar,StringMatchQ[#[[1]],pat]&][[;;,2]]]
]
LoadTarFile[filename_,pat_RegularExpression->ans_String]:=Module[{tar,matches,out},
If[Head[filename]===String,
tar=LoadTarFile[filename],
(*else*)
tar=filename
];
out=SortBy[Normal@GroupBy[
StringCases[#1,pat->ans]->#2&@@@Select[tar,StringMatchQ[#[[1]],pat]&],
First,
LoadTarFile[#[[;;,2]]]&
],First];
If[Length[out]==1,
out[[1,2]],
(*else*)
out
]
]
LoadTarFile[filename_,pats_CirclePlus|pats_CircleDot]:=Module[{tar,out,next,scale,npat},
If[Head[filename]===String,
tar=LoadTarFile[filename],
(*else*)
tar=filename
];
out=None;
Table[
next=LoadTarFile[tar,pat];
(*If[MatchQ[pat,f_ (np_CirclePlus|np_CircleDot)],
scale=pat/.f_ (np_CirclePlus|np_CircleDot)\[RuleDelayed]f;
npat=pat/.f_ (np_CirclePlus|np_CircleDot)\[RuleDelayed]np;
next=ScaleTarList[next,scale];
Print["Scale",Evaluate[next]];
If[Or[Head[npat]===CirclePlus,Head[npat]===CircleDot],
next=MergeTarLists[next];
]
];*)
If[Head[pat]===CircleDot,
next=MergeTarLists[next];
];
If[out===None,
out=next,
(*else*)
out=AddTarLists[out,next]
],
{pat,List@@pats}
];
If[Head[pats]===CircleDot,
MergeTarLists[out],
(*else*)
out
]
]
LoadTarFile[filename_,f_ (pats_CirclePlus|pats_CircleDot|pats_RegularExpression|pats_Rule)]:=ScaleTarList[LoadTarFile[filename,pats],f]
addCompletion["GuessGood\[Xi]" -> {2}]
GuessGood\[Xi][filename_, flavour_, pieceR_, pieceV_, min_:-4]:=Module[{
tar, rdata, vdata, fits, ans
},
If[Head[filename]===String,
tar=LoadTarFile[filename],
(*else*)
tar=filename
];
rdata = Prepend["value" /. #2, ToExpression[#1][[1, 1]]] & @@@ LoadTarFile[tar, BuildPattern[pieceR, flavour]];
vdata = Prepend["value" /. #2, ToExpression[#1][[1, 1]]] & @@@ LoadTarFile[tar, BuildPattern[pieceV, flavour]];
fits = Fit[#[[;; , ;; 2]], {1, Log[Global`\[Xi]]}, Global`\[Xi]]&/@{
rdata,vdata
};
ans = Global`\[Xi] /. First@Solve[Equal @@ fits];
Print@LogLinearPlot[
fits, {Global`\[Xi], 10^min, 1},
GridLines -> {{ans}, {Plus @@ fits /. Global`\[Xi] -> ans}}
];
ans
]
MergeNumbers[list_, quiet_: False] := Block[{chi = 0, weight = 0, value},
weight = Plus @@ (1/(list[[All, 2]]^2));
value = Plus @@ (list[[All, 1]]/(list[[All, 2]]^2))/weight;
chi = 1/(Length[list] - 1) (Plus @@ (((list[[All, 1]] - value)/list[[All, 2]])^2));
If[Not[quiet], Print[chi]];
Quiet[If[quiet, {chi, value, Sqrt[1/weight]}, {value, Sqrt[1/weight]}]]
] /. Indeterminate -> 0
PlusNumbers[list__] := {Plus @@ {list}[[All, 1]], Sqrt[Plus @@ ({list}[[All, 2]]^2)]}
DivideNumbers[a_, b_] := {a[[1]]/b[[1]], Sqrt[(b[[2]]^2 a[[1]]^2)/b[[1]]^4 + a[[2]]^2/b[[1]]^2]}
TimesNumbers[a_, b_] := {a[[1]] b[[1]], Sqrt[b[[1]]^2 a[[2]]^2 + a[[1]]^2 b[[2]]^2]}
IntegrateHistogram[{{DirectedInfinity[-1], u_,e_}, stuff___}] := u+IntegrateHistogram[{stuff}]
IntegrateHistogram[{stuff___, {DirectedInfinity[+1], o_,e_}}] := o+IntegrateHistogram[{stuff}]
IntegrateHistogram[x_]/;FreeQ[x,DirectedInfinity|Infinity] := Mean[Differences[x[[All, 1]]]] ( Plus @@ x[[All, 2]] )
MergePlots[list_, chi_:False] := Quiet[Module[{out, chilist},
out = list[[1]];
(* When the bin is empty, the zero causes trouble *)
out[[All, 2]] = Plus @@ (list[[All, All, 2]]/(list[[All, All, 3]]^2))/ Plus @@ (1/(list[[All, All, 3]]^2)) /. Indeterminate -> 0;
(* When the bin is empty, the zero causes trouble *)
out[[All, 3]] = Sqrt[1/Plus @@ (1/(list[[All, All, 3]]^2))] /. Indeterminate -> 0;
chilist = Thread[{
out[[;;,1]],
1/(Length[list] - 1) * Plus @@@ ((
(Transpose[list[[;; , ;; , 2]]] - out[[;; , 2]])^2
)/(
Transpose[list[[;; , ;; , 3]]]^2
))}];
If[chi, {out, chilist}, out]
]]
CombinePlots[A_, B_, OptionsPattern[]] := Block[{opE, x1, x2},
opE[e1_, y1_, e2_, y2_] := Sqrt[D[OptionValue[op][x1, x2], x1]^2 e1^2 + D[OptionValue[op][x1, x2], x2]^2 e2^2] /. {x1 -> y1, x2 -> y2};
Select[
Table[Table[
If[A[[i]][[1]] == B[[j]][[1]], {A[[i]][[1]],
OptionValue[op][A[[i]][[2]], B[[j]][[2]]],
opE[A[[i]][[3]], A[[i]][[2]], B[[j]][[3]],
B[[j]][[2]]]}, ## &[]], {j, Length[B]}], {i,
Length[A]}] /. {x_} -> x, UnsameQ[#, {}] &]
];
ApplyPlot[A_, fY_] := Block[{x, dummy, opE},
opE[e_, y_] := Abs[D[fY[x], x]] e /. x -> y;
Table[{A[[i]][[1]], fY[A[[i]][[2]]],
opE[A[[i]][[3]], A[[i]][[2]]]}, {i, Length[A]}]
];
ScalePlot[a_,s_]:={1/s,s,s}#&/@a
ScalePlot[a_,sx_,sy_]:={1/sx,sy,sy}#&/@a
MergeBins[{{DirectedInfinity[-1], u_,e_}, stuff___}, n_] := Prepend[
MergeBins[{stuff}, n],
{DirectedInfinity[-1], u,e}
]
MergeBins[{stuff___, {DirectedInfinity[+1], o_,e_}}, n_] := Append[
MergeBins[{stuff}, n],
{DirectedInfinity[+1], o,e}
]
MergeBins[plot_, n_]/;FreeQ[plot,DirectedInfinity|Infinity] := {
Plus @@ #[[;; , 1]]/n, Plus @@ #[[;; , 2]]/n, Sqrt[
Plus @@ (#[[;; , 3]]^2)]/n
} & /@ Partition[plot, n]
ClearAll[ErrorBandPlot]
Options[ErrorBandPlot] = Join[Complement[
Options[ListLinePlot],
{
MaxPlotPoints -> Infinity, InterpolationOrder -> None,
Joined -> True, Filling -> None, FillingStyle -> Automatic,
LabelingFunction -> Automatic, LabelingSize -> Automatic,
LabelStyle -> {}, Mesh -> None, MeshFunctions -> {#1 &},
MeshShading -> None, MeshStyle -> Automatic,
PlotLayout -> "Overlaid", PlotLabels -> None, PlotMarkers -> None
}
],{
Underflow->False, Overflow->False
}];
(* one plot with x *)
ErrorBandPlot[dat_, opts : OptionsPattern[]] /; Length[dat[[1]]] == 3 := Block[{newdat, ps, diff, s},
ps = OptionValue[PlotStyle];
If[ps === Automatic, ps = ColorData[97][1]];
newdat = Select[dat,FreeQ[DirectedInfinity]];
diff = First@Differences[newdat[[;; , 1]]];
newdat = {
{#1, #2}, ErrorBar[diff/2, #3]
} & @@@ newdat;
If[And[OptionValue[Underflow]=!=False, dat[[1,1]]==DirectedInfinity[-1]],
s = 2;
If[NumberQ[OptionValue[Underflow]], s = OptionValue[Underflow]];
PrependTo[newdat, {
{dat[[+2,1]]-(s+1/2)*diff, dat[[+1,2]]}, ErrorBar[s*diff, dat[[+1,3]]]
}]
];
If[And[OptionValue[Overflow ]=!=False, dat[[-1,1]]==DirectedInfinity[+1]],
s = 2;
If[NumberQ[OptionValue[Overflow]], s = OptionValue[Overflow]];
AppendTo[newdat, {
{dat[[-2,1]]+(s+1/2)*diff, dat[[-1,2]]}, ErrorBar[s*diff, dat[[-1,3]]]
}]
];
ErrorListPlot[
newdat,
ErrorBarFunction -> Function[{coords, errs}, {
Opacity[1], EdgeForm[ps], ps,
Rectangle[
coords + {errs[[1, 1]], errs[[2, 1]]},
coords + {errs[[1, 2]], errs[[2, 2]]}
]
}],
Epilog->{
ps,
Line@Flatten[{
{#1[[1,1]]-#1[[2,1]],#1[[1,2]]},
{#1[[1,1]]+#1[[2,1]],#1[[1,2]]}
}&/@newdat,1]
},
PlotStyle -> None, FilterRules[{opts},Options[ErrorListPlot]]
]
]
(* one plot, no x *)
ErrorBandPlot[dat_, opts : OptionsPattern[]] /; Length[dat[[1]]] == 2 :=
ErrorBandPlot[MapThread[Prepend, {dat, Range[Length[dat]]}], opts]
(* multiple plots *)
ErrorBandPlot[dat_, opts : OptionsPattern[]] /; Length[dat[[1]]] > 3 := Block[{newdat, ps,plots},
ps = OptionValue[PlotStyle];
If[ps === Automatic, ps = ColorData[97] /@ Range[Length[dat]]];
If[Head[ps] =!= List, ps = ConstantArray[ps, Length[dat]]];
plots = MapThread[
ErrorBandPlot[#1, PlotStyle -> #2, opts] &,
{dat, ps}
];
Show[plots, Epilog->Join[Epilog/.AbsoluteOptions[plots,Epilog]],opts]
]
End[];
EndPackage[];
Begin["System`Convert`VEGAS`"]
ImportExport`RegisterImport["vegas",
importer,
"FunctionChannels"->{"Streams"},"BinaryFormat"->True
]
ImportExport`RegisterImport["vegasL",
importer[#,8]&,
"FunctionChannels"->{"Streams"},"BinaryFormat"->True
]
importer[filename_String,opts___]:=Module[{stream,ans},
stream=OpenRead[filename,BinaryFormat->True];
ans=importer[stream,opts];
Close[stream];
ans
]
ReadFortran[stream_,type_]:=Module[{len,ans,len2},
len=BinaryRead[stream,"UnsignedInteger32"];
If[len===EndOfFile, Return[$Failed]];
ans=BinaryReadList[stream,type,len/Switch[type,
"Byte"|"Character8"|"Integer8",1,
"Integer16",2,
"Integer32"|"Real32",4,
"Integer64"|"Real64",8
]
];
len2=BinaryRead[stream,"UnsignedInteger32"];
If[len!=len2,Print["Something's fishy"]];
If[Length[ans]==1,First[ans],ans]
]
WriteFortran[stream_, dat_, type_] := Module[{len},
len = Switch[type,
"Byte" | "Character8" | "Integer8", 1,
"Integer16", 2,
"Integer32" | "Real32", 4,
"Integer64" | "Real64", 8
];
If[Head[dat] == List,
len = Length[dat]*len
];
BinaryWrite[stream, len, "UnsignedInteger32"];
BinaryWrite[stream, dat, type];
BinaryWrite[stream, len, "UnsignedInteger32"];
]
GuessVegasVersion[stream_, intsize_:4]:=Module[{nrq, nrbins, inttype, time, magic,version},
SetStreamPosition[stream,0];
magic = StringJoin @@ Select[BinaryReadList[stream, "Character8", 17], # != "\000" &];
If[magic === "\t McMule \t",
version=StringJoin @@ ReadFortran[stream, "Character8"];
version = First@StringCases[
version,
RegularExpression["v(\\d+)([NL])"] :> {
ToExpression["$1"],
"Integer" <> ToString[8 If["$2" == "L", 8, 4]]
}
];
Return[version, Module];
];
inttype = "Integer"<>ToString[8 intsize];
(* Test v1 vs. v2 *)
SetStreamPosition[stream,6893 + 3 intsize];
{nrq, nrbins} = ReadFortran[stream, inttype];
SetStreamPosition[stream,6925 + 5 intsize + 22 nrq + 16 nrbins nrq];
time=ReadFortran[stream, "Real64"];
SetStreamPosition[stream,0];
If[FailureQ[time],
Return[{1,inttype}, Module],
(*else*)
Return[{2,inttype}, Module]
];
]
importeverything=False;
importer[stream_InputStream,intsize_:4, opts___]:=Module[{
len,len2,ans,
sha,it,ndo,si,swgt,schi,xi,randy,nrq,nrbins,quant,minv,maxv,names, X, delta, msg, version,
inttype, namelen, nrbinsuo,AddOverUnderflowBins
},
{version, inttype} = GuessVegasVersion[stream, intsize];
sha=StringJoin@@ReadFortran[stream,"Character8"];
it=ReadFortran[stream,inttype];ndo=ReadFortran[stream,inttype];
si=ReadFortran[stream,"Real64"];swgt=ReadFortran[stream,"Real64"];schi=ReadFortran[stream,"Real64"];
xi=ReadFortran[stream,"Real64"];
randy=ReadFortran[stream,inttype];
If[version>2,
{nrq,nrbins,namelen}=ReadFortran[stream,inttype],
(*else*)
{nrq,nrbins}=ReadFortran[stream,inttype];
namelen = 6;
];
{minv,maxv}=Partition[ReadFortran[stream,"Real64"],nrq];
names=StringTrim[StringJoin@@@Partition[ReadFortran[stream,"Character8"],namelen]];
quant=ReadFortran[stream,"Real64"];
If[version>1,
time=ReadFortran[stream,"Real64"];
msg=StringJoin@@ReadFortran[stream,"Character8"];
If[Or[StringContainsQ[msg,"Warning"],MemberQ[$LoadVerbosity,"msg"]],
Print[StringTrim[msg]]
];
];
If[version>2,
AddOverUnderflowBins[u_,o_,l_List] := Join[{u},l,{o}];
AddOverUnderflowBins[u_,o_,l_?NumberQ] := Join[{u},ConstantArray[l,nrbins],{o}],
(*else*)
AddOverUnderflowBins[u_,o_,l_] := l
];
Flatten[{
"SHA"->sha,"iteration"->it,
"value"->{si/swgt,Sqrt[1/swgt]},
"chi2a"->If[it>1,(schi-si^2/swgt)/(it-1),-1],
If[version>1,"runtime"->time,{}],
If[it>1,
delta = (maxv-minv)/nrbins;
nrbinsuo = If[version>2,nrbins + 2,nrbins];
Table[
names[[i]]->Thread[{
(* X *)
AddOverUnderflowBins[
DirectedInfinity[-1],DirectedInfinity[+1],
minv[[i]]+delta[[i]]*(Range[nrbins]-1/2)
],
(* Y *)
quant[[i;;nrq nrbinsuo;;nrq]]/it / AddOverUnderflowBins[1,1,delta[[i]]],
(* E *)
Sqrt[
(
quant[[nrq nrbinsuo+i;;;;nrq]]-quant[[i;;nrq nrbinsuo;;nrq]]^2/it
)/(it (it-1))] / AddOverUnderflowBins[1,1,delta[[i]]]
}
],{i,nrq}],
(* else *)
{}
],
If[importeverything,
{
"si"->si,"swgt"->swgt,"schi"->schi,
"xi"->xi,
"randy"->randy
},
(* else *)
{}
]
}]
]
tzero = FromCharacterCode[0] <> FromCharacterCode[0] <> FromCharacterCode[0];
ImportExport`RegisterExport["vegas",
exporter,
"FunctionChannels"->{"Streams"},"BinaryFormat"->True
]
ImportExport`RegisterExport["vegasL",
exporter[#,8]&,
"FunctionChannels"->{"Streams"},"BinaryFormat"->True
]
exporter[filename_String,opts___]:=Module[{stream},
stream=OpenWrite[filename,BinaryFormat->True];
exporter[stream,opts];
Close[stream];
]
exporter[stream_OutputStream, {content__Rule}, intsize_Integer: 4] := Module[{
keys, inttype,
sha, iteration, chi2a, y, e, runtime, ndo, xi, randy, msg,
hkeys, histogram, delta, minv, maxv, nrbins, namelen, nrq, quant
},
keys = {
"SHA", "iteration", "chi2a", "value", "runtime", "ndo", "xi",
"randy", "msg"
};
(* histograms *)
hkeys = Complement[{content}[[;; , 1]], keys];
(* Lengths of things *)
nrq = Length[hkeys];
namelen = Max[Max[StringLength /@ hkeys], 6];
(* Calculate number of bins from first histogram *)
histogram = hkeys[[1]] /. {content};
If[Head[histogram[[1, 1]]] =!= DirectedInfinity,
nrbins = Length[histogram],
(*else*)
nrbins = Length[histogram]-2;
];
(* Prepare variables to be written later *)
quant = ConstantArray[0, 2 (nrbins + 2) nrq];
minv = {}; maxv = {};
Table[
histogram = hkeys[[i]] /. {content};
If[Head[histogram[[1, 1]]] =!= DirectedInfinity,
(* Add OU bins *)
histogram = Join[
{{DirectedInfinity[-1], 0, 0}}, histogram, {{DirectedInfinity[-1], 0, 0}}
];
];
delta = histogram[[3, 1]] - histogram[[2, 1]];
AppendTo[maxv, Chop[histogram[[2, 1]] - delta 1/2 + nrbins delta]];
AppendTo[minv, Chop[histogram[[2, 1]] - delta 1/2]];
(* delta to array with OU bins *)
delta = Join[{1}, ConstantArray[delta, nrbins], {1}];
quant[[i ;; nrq nrbins + 2 ;; nrq]] = delta iteration histogram[[;; , 2]];
If[And @@ EqualTo[0] /@ histogram[[;; , 3]],
quant[[nrq (nrbins + 2) + i ;; ;; nrq]] = quant[[i ;; nrq nrbins + 2 ;; nrq]]^2/iteration
(*else*),
quant[[nrq (nrbins + 2) + i ;; ;; nrq]] = delta^2 iteration (
histogram[[;; , 3]]^2 (-1 + iteration) + histogram[[;; , 2]]^2
)
],
{i, Length@hkeys}
];
(* other data *)
{sha, iteration, chi2a, {y, e}, runtime, ndo, xi, randy, msg} = keys
/. {content}
/. {
"SHA" ->
StringTake[Hash[DownValues[In], "SHA", "HexString"], 5],
"iteration" -> 2,
"chi2a" -> 0,
"runtime" :> TimeUsed[],
"ndo" -> -1(* TODO *),
"xi" -> ConstantArray[-1, 17 50](* TODO *),
"randy" -> -1,
"msg" -> "Warning: Generated with Mathematica"
};
e = e + $MachineEpsilon;
inttype = "Integer" <> ToString[8 intsize];
(* Magic *)
BinaryWrite[stream, "\t" <> tzero <> " McMule \t" <> tzero];
(* Header *)
BinaryWrite[stream, "\n" <> tzero <> "v3" <> If[intsize == 8, "L", "N"] <> " \n" <> tzero];
WriteFortran[stream, Characters@sha, "Character8"];
(* Integrator state *)
WriteFortran[stream, iteration, inttype];
WriteFortran[stream, ndo, inttype];
WriteFortran[stream, y/e^2, "Real64"];
WriteFortran[stream, 1/e^2, "Real64"];
WriteFortran[stream, chi2a (-1 + iteration) + y^2/e^2, "Real64"];
WriteFortran[stream, xi, "Real64"];
WriteFortran[stream, randy, inttype];
(* Histograms *)
(* Metadata *)
WriteFortran[stream, {nrq, nrbins, namelen}, inttype];
WriteFortran[stream, Join[minv, maxv], "Real64"];
WriteFortran[stream, Flatten[Characters@StringPadRight[#, namelen] & /@ hkeys], "Character8"];
(* Data *)
WriteFortran[stream, quant, "Real64"];
(* Misc *)
WriteFortran[stream, runtime, "Real64"];
WriteFortran[stream, Characters@msg, "Character8"];
]
ImportExport`RegisterImport["badpoints",
bpimporter,
"FunctionChannels"->{"Streams"},"BinaryFormat"->True
]
bpimporter[filename_String,opts___]:=Module[{stream,ans},
stream=OpenRead[filename,BinaryFormat->True];
ans=bpimporter[stream,opts];
Close[stream];
ans
]
bpimporter[stream_InputStream, opts___]:=Module[{len,msg,whichpiece,flavour,xicut,delcut,ndim,x,len2},
Last@Reap@While[True,
len=BinaryRead[stream,"UnsignedInteger32"];
If[len===EndOfFile, Break[]];
If[len!=30+10+8+1 8+1 8+1 4+17 8,Print["Failed!"]];
msg=StringTrim[StringJoin@@BinaryReadList[stream,"Character8",30]];
whichpiece=StringTrim[StringJoin@@BinaryReadList[stream,"Character8",10]];
flavour=StringTrim[StringJoin@@BinaryReadList[stream,"Character8",8]];
xicut=BinaryRead[stream,"Real64"];
delcut=BinaryRead[stream,"Real64"];
ndim=BinaryRead[stream,"Integer32"];
x=BinaryReadList[stream,"Real64",17][[;;ndim]];
len2=BinaryRead[stream,"UnsignedInteger32"];If[len!=len2,Print["Something's fishy"]];
Sow[{
"msg"->msg,"which_piece"->whichpiece,"flavour"->flavour,"xicut"->xicut,"delcut"->delcut,"x"->x
}];
]
]
End[];
Unprotect[Import];
Import[name_String,opts___?OptionQ]/;(
ToLowerCase[FileExtension[name]]
)==="vegas":=Import[name,"vegas",opts];
Import[name_String,opts___?OptionQ]/;(
ToLowerCase[FileExtension[name]]
)==="bp":=Import[name,"badpoints",opts];
Protect[Import];
Unprotect[Export];
Export[name_String,data_List,opts___?OptionQ]/;(
ToLowerCase[FileExtension[name]]
)==="vegas":=Export[name,data,"vegas",opts];
Protect[Export];
(* ::Input:: *)
(**)