Monte-Carlo vs. klassische Integration

<< Graphics`

Funktion

s = 5;

func[l_List]:=  ;

func[l_List] := (1/(Sqrt[Plus])) @@ l;

Exakter Wert

ClearAll[exakt];
exakt[s_] := exakt[s] = 
        NIntegrate[
          Evaluate[
            func[Table[
                ToExpression["i" <> ToString[n]],  {n, 1, s}]] ], 
          Evaluate[ 
            Sequence @@ 
              Table[{ToExpression["i" <> ToString[n]],  0.01, 
                  1.01},  {n, 1, s}]] ]

exakt /@ Range[1, 9]

IntegrateTemp[expr_] := expr;
IntegrateTemp[expr_,  {var_,  from_,  to_},  vars___] := 
      Module[{tmp}, 
tmp = 
          IntegrateTemp[Simplify@Integrate[expr,  var],  
            vars]; 
(tmp /. {var -> 
                  to})
 - (tmp /. {var -> 
                  from})
]

ClearAll[exakt];
exakt[s_] := exakt[s] = 
        IntegrateTemp[
          Evaluate[
            func[Table[
                ToExpression["i" <> ToString[n]],  {n, 1, s}]] ], 
          Evaluate[ 
            Sequence @@ 
              Table[{ToExpression["i" <> ToString[n]],  0.01, 
                  1.01},  {n, 1, s}]] ]

(Print[#]; exakt[#]) & /@ Range[1, 9]

klassische Trapezregel

val = 0;
ClearAll[klassTR];
s = 2;
klassTR[f_,  m_Integer,  range : {from_,  to_}] := 
        klassTR[f, m,  {from,  to}, {},  0];
klassTR[f_,  m_Integer,  range : {from_,  to_},  l_List,  
          n_Integer /; n == s] := f[l];
klassTR[f_,  m_Integer,  range : {from_,  to_},  l_List,  
          n_Integer /; n < s] := 
        Module[{val = 0,  i = from,  
            step = (to - from)/
                m}, 
  
val  +=  
            1/(2  m)*
              klassTR[f, m, range, Append[l,  i],  
                n + 1]; 
For[i = from + step,  i < to,  
            i += step,  
            val += 1/m klassTR[f, m, range, Append[l,  i],  
                  n + 1]]; 
i = 
            to; 
val  +=  
            1/(2  m)*
              klassTR[f, m, range, Append[l,  i],  
                n + 1]; 
val
];

s = 2;
TRError[s] = 
      Table[{(m + 1)^s,  
          klassTR[func,  m,  {0.01, 1.01}] - exakt[s]},  {m,  1,  
          200}]

s = 3;
TRError[s] = 
      Table[{(m + 1)^s,  
          klassTR[func,  m,  {0.01, 1.01}] - exakt[s]},  {m,  1,  
          50}]

s = 4;
TRError[s] = 
      Table[{(m + 1)^s,  
          klassTR[func,  m,  {0.01, 1.01}] - exakt[s]},  {m,  1,  
          17}]

s = 5;
TRError[s] = 
      Table[{(m + 1)^s,  
          klassTR[func,  m,  {0.01, 1.01}] - exakt[s]},  {m,  1,  
          9}]

s = 6;
TRError[s] = 
      Table[{(m + 1)^s,  
          klassTR[func,  m,  {0.01, 1.01}] - exakt[s]},  {m,  1,  
          6}]

s = 7;
TRError[s] = 
      Table[{(m + 1)^s,  
          klassTR[func,  m,  {0.01, 1.01}] - exakt[s]},  {m,  1,  
          4}]

s = 9;
TRError[s] = 
      Table[{(m + 1)^s,  
          klassTR[func,  m,  {0.01, 1.01}] - exakt[s]},  {m,  1,  
          3}]

\(\(MultipleListPlot[
        Sequence @@ \((\(Log[10, Abs[TRError[#]]] &\) /@ {2, 3, 4, 5, 6, 7, 
                9})\), \ PlotJoined -> True, \ 
        PlotLegend -> {2, 3, 4, 5, 6, 7, 9}, \ 
        LegendPosition -> {\(-0.8\), \ \(-0.5\)}, \ 
        LegendSize -> {0.5, \ 0.4}, \ LegendTextSpace -> 3, \ 
        LegendShadow -> None, \ 
        AxesLabel -> {\*""(Subscript[Log, 10])(N)"", \ \*""(Subscript[Log, 10])(err)""}, \ 
        TextStyle -> {FontFamily -> "Helvetica"}];\)\)

Monte Carlo

<< Graphics`

Plot3D[func[{x1, x2}],  {x1,  0.01, 1},  {x2, 0.01, 1},  
        PlotPoints -> 100,  Mesh -> False,  
        PlotRange -> {0, 4.5}];

n = 100000;

s = 2;
fvals = 
        func /@ Table[ Table[Random[] + 0.01,  {s}],  {n}];
MCErrors[s] = 
        Take[MapIndexed[{#2[[1]],  #1/#2[[1]] - exakt[s]} &,  
            Rest@FoldList[Plus,  0,  fvals]],  {1000,  n,  
            1000}];

s = 3;
fvals = 
        func /@ Table[ Table[Random[] + 0.01,  {s}],  {n}];
MCErrors[s] = 
        Take[MapIndexed[{#2[[1]],  #1/#2[[1]] - exakt[s]} &,  
            Rest@FoldList[Plus,  0,  fvals]],  {1000,  n,  
            1000}];

s = 4;
fvals = 
        func /@ Table[ Table[Random[] + 0.01,  {s}],  {n}];
MCErrors[s] = 
        Take[MapIndexed[{#2[[1]],  #1/#2[[1]] - exakt[s]} &,  
            Rest@FoldList[Plus,  0,  fvals]],  {1000,  n,  
            1000}];

s = 5;
fvals = 
        func /@ Table[ Table[Random[] + 0.01,  {s}],  {n}];
MCErrors[s] = 
        Take[MapIndexed[{#2[[1]],  #1/#2[[1]] - exakt[s]} &,  
            Rest@FoldList[Plus,  0,  fvals]],  {1000,  n,  
            1000}];

s = 6;
fvals = 
        func /@ Table[ Table[Random[] + 0.01,  {s}],  {n}];
MCErrors[s] = 
        Take[MapIndexed[{#2[[1]],  #1/#2[[1]] - exakt[s]} &,  
            Rest@FoldList[Plus,  0,  fvals]],  {1000,  n,  
            1000}];

s = 7;
fvals = 
        func /@ Table[ Table[Random[] + 0.01,  {s}],  {n}];
MCErrors[s] = 
        Take[MapIndexed[{#2[[1]],  #1/#2[[1]] - exakt[s]} &,  
            Rest@FoldList[Plus,  0,  fvals]],  {1000,  n,  
            1000}];

s = 8;
fvals = 
        func /@ Table[ Table[Random[] + 0.01,  {s}],  {n}];
MCErrors[s] = 
        Take[MapIndexed[{#2[[1]],  #1/#2[[1]] - exakt[s]} &,  
            Rest@FoldList[Plus,  0,  fvals]],  {1000,  n,  
            1000}];

s = 9;
fvals = 
        func /@ Table[ Table[Random[] + 0.01,  {s}],  {n}];
MCErrors[s] = 
        Take[MapIndexed[{#2[[1]],  #1/#2[[1]] - exakt[s]} &,  
            Rest@FoldList[Plus,  0,  fvals]],  {1000,  n,  
            1000}];

dims = {2, 3, 4, 5, 6, 7, 8, 9}

\(MultipleListPlot[
      Sequence @@ \((\(Log[10, Abs[MCErrors[#]]] &\) /@ dims)\), \ 
      PlotJoined -> True, \ PlotLegend -> dims, \ 
      LegendPosition -> {\(-0.8\), \ \(-0.5\)}, \ 
      LegendSize -> {0.5, \ 0.4}, \ LegendTextSpace -> 3, \ 
      LegendShadow -> None, \ 
      AxesLabel -> {\*""(Subscript[Log, 10])(N)"", \ \*""(Subscript[Log, 10])(err)""}, \ 
      TextStyle -> {FontFamily -> "Helvetica"}]\)

s = 20;
fvals = 
        func /@ Table[ Table[Random[] + 0.01,  {s}],  {n}];
MCVals[s] = 
        Take[MapIndexed[{#2[[1]],  #1/#2[[1]]} &,  
            Rest@FoldList[Plus,  0,  fvals]],  {1000,  n,  
            1000}];
fvals =.

ListPlot[MCVals[20],  PlotJoined -> True]

s = 50;
fvals = 
        func /@ Table[ Table[Random[] + 0.01,  {s}],  {n}];
MCVals[s] = 
        Take[MapIndexed[{#2[[1]],  #1/#2[[1]]} &,  
            Rest@FoldList[Plus,  0,  fvals]],  {1000,  n,  
            1000}];

ListPlot[MCVals[50],  PlotJoined -> True]

s = 100;
fvals = 
        func /@ Table[ Table[Random[] + 0.01,  {s}],  {n}];
MCVals[s] = 
        Take[MapIndexed[{#2[[1]],  #1/#2[[1]]} &,  
            Rest@FoldList[Plus,  0,  fvals]],  {1000,  n,  
            1000}];

ListPlot[MCVals[100],  PlotJoined -> True]