Graphics2D: NumberForm, Rotate inside Text, PlotLabel issues

[kkoudas01]

The following code runs just fine on Wolfram Cloud.

Clear["Global`*"]

RiemannBar[box : {{x0_, x1_}, {y0_, y1_}}, {x_, y_}, _] := 
 Block[{area = (y1 + y0) (x1 - x0)},  Sow[area];
  {ChartElementData["Rectangle"][box, {}, {}], {Opacity[1], Black, Point[{x, y}]}, 
  If[Abs[area] < 10^-2, {}, {Opacity[1], Black,Text[Rotate[NumberForm[area, {Infinity, 2}], Pi/2], Mean /@ box]}]}]
  
RiemannPlot[f_, {x_, x0_, x1_, dx_: 1.}, opts___] := 
 Block[{plot, areas, extent, points, curve},
  extent = OptionValue[Flatten[{opts}], ExtentSize];
  points = 
   If[IntegerQ[dx], RandomReal[{x0, x1}, dx], 
    Switch[extent, Full, Range[x0, x1, dx], Left, 
     Range[x0 + dx, x1, dx], Right, Range[x0, x1 - dx, dx]]]; {plot, 
    areas} = 
   Reap[DiscretePlot[f, Evaluate@{x, points}, opts, ImageSize -> 275, 
     ExtentElementFunction -> RiemannBar, 
     FillingStyle -> Opacity[0.5], PlotStyle -> PointSize[Medium]]];
  Show[plot, Plot[f, {x, x0, x1}], 
   PlotLabel -> 
    Row[{"Estimated Area: ", Total[Flatten@areas], Spacer[10], 
      "Actual Area: ", NIntegrate[f, {x, x0, x1}]}], Frame -> True,   PlotRange -> All, Axes -> {True, False}]  ]
      
  RiemannPlot[BesselJ[5, x], {x, 0, 10, 0.5}, ExtentSize -> Full]

Specifically, it produces this image.

However, when I run it on wljs, it produces this image.

What’s going wrong? I’m not sure which command is causing the problem, so I’ll mention this one as the likely reason.

Thanks in advance!

[JerryI]

This one:

Text[Rotate[NumberForm[area, {Infinity, 2}], Pi/2]

NumberForm in the context of 2D graphics is not quite supported. However, it can be preconverted to text. as well as Rotate placed inside Text won't work, but outside it will.

Here is an optimized version:

Clear["Global`*"]

RiemannBar[box : {{x0_, x1_}, {y0_, y1_}}, {x_, y_}, _] := 
 Block[{area = (y1 + y0) (x1 - x0)},  Sow[area];
  {ChartElementData["Rectangle"][box, {}, {}], {Opacity[1], Black, Point[{x, y}]}, 
  If[Abs[area] < 10^-2, {}, {Opacity[1], Black,Rotate[Text[ToString[NumberForm[area, {Infinity, 2}]], Mean /@ box], Pi/2, Mean /@ box]}]}]
  
RiemannPlot[f_, {x_, x0_, x1_, dx_: 1.}, opts___] := 
 Block[{plot, areas, extent, points, curve},
  extent = OptionValue[Flatten[{opts}], ExtentSize];
  points = 
   If[IntegerQ[dx], RandomReal[{x0, x1}, dx], 
    Switch[extent, Full, Range[x0, x1, dx], Left, 
     Range[x0 + dx, x1, dx], Right, Range[x0, x1 - dx, dx]]]; {plot, 
    areas} = 
   Reap[DiscretePlot[f, Evaluate@{x, points}, opts, ImageSize -> 475, 
     ExtentElementFunction -> RiemannBar, 
     FillingStyle -> Opacity[0.5],  PlotStyle -> PointSize[Small]]];
  Show[plot, Plot[f, {x, x0, x1}], 
   PlotLabel -> 
    ToString@Row[{"Estimated Area: ", Total[Flatten@areas], "; " 
      "Actual Area: ", NIntegrate[f, {x, x0, x1}]}], Frame -> True,   PlotRange -> All, Axes -> {True, False}]  ]
      
  RiemannPlot[BesselJ[5, x], {x, 0, 10, 0.5}, ExtentSize -> Full]

However, it is still an open issue in the way, that we should add the support of such structures in Graphics 2D.

In the worst case, this "hack" can also work:

YourPlot // MMAView

[kkoudas01]

Perfect! I understand. Thank you very much, everything is going well!

[JerryI]

Ok. It is fixed for the original form:

Clear["Global`*"]

RiemannBar[box : {{x0_, x1_}, {y0_, y1_}}, {x_, y_}, _] := 
 Block[{area = (y1 + y0) (x1 - x0)},  Sow[area];
  {ChartElementData["Rectangle"][box, {}, {}], {Opacity[1], Black, Point[{x, y}]}, 
  If[Abs[area] < 10^-2, {}, {Opacity[1], Black,Text[Rotate[NumberForm[area, {Infinity, 2}], Pi/2], Mean /@ box]}]}]
  
RiemannPlot[f_, {x_, x0_, x1_, dx_: 1.}, opts___] := 
 Block[{plot, areas, extent, points, curve},
  extent = OptionValue[Flatten[{opts}], ExtentSize];
  points = 
   If[IntegerQ[dx], RandomReal[{x0, x1}, dx], 
    Switch[extent, Full, Range[x0, x1, dx], Left, 
     Range[x0 + dx, x1, dx], Right, Range[x0, x1 - dx, dx]]]; {plot, 
    areas} = 
   Reap[DiscretePlot[f, Evaluate@{x, points}, opts, ImageSize -> 475, 
     ExtentElementFunction -> RiemannBar, 
     FillingStyle -> Opacity[0.5], PlotStyle -> PointSize[Small]]];
  Show[plot, Plot[f, {x, x0, x1}], 
   PlotLabel -> 
    Style[Row[{"Estimated Area: ", Total[Flatten@areas], Spacer[10], 
      "Actual Area: ", NIntegrate[f, {x, x0, x1}]}], FontSize->8], Frame -> True,   PlotRange -> All, Axes -> {True, False}]  ]
      
  RiemannPlot[BesselJ[5, x], {x, 0, 10, 0.5}, ExtentSize -> Full]

A patch will be in the next update.

[kkoudas01]

Great! You have done a very good job!!!

[JerryI]

Should be fixed in 2.8.5