(* ::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, newx, newy, newe, maskA, maskB},
   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};
   newx = Intersection[A[[;; , 1]], B[[;; , 1]]];
   maskA = First@First[Position[A[[;; , 1]], #]] & /@ newx;
   maskB = First@First[Position[A[[;; , 1]], #]] & /@ newx;
   newy = MapThread[OptionValue[op], {A[[maskA, 2]], B[[maskB, 2]]}];
   newe = MapThread[opE, {
       A[[maskA, 3]], A[[maskA, 2]], B[[maskB, 3]], B[[maskB, 2]]
   }];
   Thread[{newx, newy, newe}]
]


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:: *)
(**)
