I answered a question on Physics StackExchange - considered as homework - numerically. The question is: What is the resistance of three stacked identical blocks, the middle bar shifted by its half width to the right. Conjecture: The resistance of the reduced vertical overlapping blocks, 1/2.
Since it's a nice opportunity to test NDSolve, I prepared a graphical short answer, showing that there is a current in the outer parts, too, yielding resistance of about 3/2.
The short answer with the potential and current given is not quite perfect, because it's unclear what NDSolve is assuming implicitly at the inner boundary, I am presenting the complete implementation with Neumann boundary conditions here.
SetOptions[Graphics,
{ImageSize -> 50, BaseStyle -> {Opacity[0.6], RGBColor[0.2, 0.6, 0.9, 0.6]}}];
region[shift_] := RegionUnion[
Rectangle[{0, 2.5}, {10, 7.5}],Rectangle[{shift, -2.5}, {10 + shift, 2.5}],
Rectangle[{0, -7.5}, {10, -2.5}]];
RegionBoundary[region[5]]
(* Line[{{0., -7.5}, {10., -7.5}, {10., -2.5}, {15., -2.5}, {15., 2.5}, {10., 2.5},
{10., 7.5}, {0., 7.5}, {0., 2.5}, {5.,2.5},
{5., -2.5}, {0., -2.5}, {0., -7.5}}] *)
Graphics[{region[5], Black, Opacity[1], Thickness[0.1], RegionBoundary[region[5]]}]
Now the implementation of the Laplace PDE with isolating Neumann boundary everywhere and Dirichlet potential at top and bottom
LaplaceSolution[ region_, voltage_ ] :=
Module[{boundary = RegionBoundary[region], potential, current, resistivity},
potential = NDSolveValue[{Laplacian[ϕ[x, y], {x, y}] ==
NeumannValue[0, {x, y} ∈ boundary],
DirichletCondition[ ϕ[x, y] == voltage, y == 7.5],
DirichletCondition[ ϕ[x, y] == 0, y == -7.5]},
ϕ , {x, y} ∈ region ];
current = Function @@ {{x, y}, Grad[potential[x, y], {x, y}]};
resistivity = 1/Mean[(current [#, -7][[2]] &) /@
RandomReal[{0.01, 9.99}, 10000 ]];
{ Potential -> potential, CurrentDensity -> current, Resistivity -> resistivity}]
The current integral is implemented as a random sample mean, because the density as a derivative of a spline is irregularly discontinuous, yielding complaint messages by Integrate.
lp = LaplaceSolution[ region[5], 15 ]
(* {Potential -> InterpolatingFunction[ ... ],
CurrentDensity -> Function[{x, y}, {InterpolatingFunction[... ][x, y],
InterpolatingFunction[ ... ][x, y]}],
Resistivity -> 1.559712162176465`}
Some graphics
show[shift_] := Module[{pot, cur, res},
{pot, cur, res} = {Potential, CurrentDensity, Resistivity} /.
LaplaceSolution[region[shift], 15];
Show[{ContourPlot[pot[x, y], {x, y} ∈ region[shift],
Contours -> Range[0, 15, 0.2],
ColorFunction -> (CMYKColor @@ {{1, 1, 0, 0 } (1 - #) + {0, 1, 1, 0} #} &)],
VectorPlot[cur[x, y], {x, y} ∈ region[shift],
VectorScaling -> Automatic, VectorSizes -> Automatic,
VectorColorFunction -> (Green &)]},
Epilog -> {Text["1/∫ \!\(\*SubscriptBox[\(j\), \(y\)]\)
\[DifferentialD]x " -> PercentForm[ res], Scaled[{0.75, 0.85}]]}]
]
show[9]
Now lets try to find the resistivity function especially at the opening point $x=10$.
pts = Join[Range[0.1, 9.9, 0.2], Range[9.901, 9.9999, 0.01]];
table = ({10.0 - #, LaplaceSolution[ region[#], 15]} &) /@ pts
set $x=10$ as origin
restb = Reverse[({Part[#, 1], Part[#, 2, -1, -1]} &) /@ table];
ls = ListPlot[restb, Joined -> True]
fit[x_] = Rationalize[Fit[ restb , {1, Sqrt[x^3], x, Sqrt[x], 1/Sqrt[x],
1/x, 1/Sqrt[x^3], 1/x^2}, x], 1/1024]
$$-\frac{\sqrt{x^3}}{27}+\frac{1}{48 \sqrt{x^3}}+\frac{20 x}{33}-\frac{241 \sqrt{x}}{85}-\frac{45}{181 x}+\frac{73}{39 \sqrt{x}}+\frac{85}{19}$$
Show[{ListPlot[restb] , Plot[fit[x], {x, 0.01, 10},
PlotRange -> {0, 12}, PlotStyle -> {Opacity[0.5], Thickness[0.02], Red}]}]
Question
The graph suggests a solution in the complex plane with a map $(x,y) \to \sqrt{x+i y}$. What may be the analytical Laurent series representing the resistivity function around the point of the opening vertex?
