Obrázky pro BP: Steinerův bod a jeho fuzzy zobecnění

Část obrázků BP je generována přímo v souborech NUMERIC-DISK.np / NUMERIC-GAUSS.nb 

Některé obrázky v BP byly vygenerovány pomocí balíčku TikZ přímo v TEXu.

Zde uvádíme vybrané obrázky generované systémem Mathematica, které nebyly generovány v souborech NUMERIC-[kernel].nb

(Soubor spouštět sekvenčně od začátku, je-li to nutné)

Kapitola 5: Výpočet Steinerova bodu fuzzy množiny

Lichoběžníková metoda

Funkce f

f[x_] := (((((x-5))^2)*Sin[x/2] -(x-2) +x^(3/2))/5)-0.75 + 1.5*(E^(-(x-3.5)^4))
Plot[f[x],{x,0,7},AspectRatio->Automatic]

Dělení

pA[x_,x1_,x2_] := ((f[x2]-f[x1])/(x2-x1))x + f[x1]-((f[x2]-f[x1])/(x2-x1))*x1;
plotA = Plot[pA[x,1,3],{x,1,3},Filling->Axis,PlotStyle->Green,PlotRange->{{0,8},{-1,Automatic}},Ticks->None,AspectRatio->Automatic];
plotB = Plot[pA[x,3,5],{x,3,5},Filling->Axis,PlotStyle->Red,PlotRange->{{0,8},{-1,Automatic}},Ticks->None,AspectRatio->Automatic];
plotC = Plot[pA[x,5,7],{x,5,7},Filling->Axis,PlotStyle->Green,PlotRange->{{0,8},{-1,Automatic}},Ticks->None,AspectRatio->Automatic];

Popisky

tcks = {{1,Subscript["x","0"]},{3,Subscript["x","1"]},{5,Subscript["x","2"]},{7,Subscript["x","3"]}};
epi = {
Text["f(x)",{7.75,1.75}],

Arrow[{{1,-0.5},{3,-0.5}}],Arrow[{{3,-0.5},{1,-0.5}}],Text["H",{2,-0.75}],
Arrow[{{3,-0.5},{5,-0.5}}],Arrow[{{5,-0.5},{3,-0.5}}],Text["H",{4,-0.75}],
Arrow[{{5,-0.5},{7,-0.5}}],Arrow[{{7,-0.5},{5,-0.5}}],Text["H",{6,-0.75}],

PointSize[Medium],Point[{{1,f[1]},{3,f[3]},{5,f[5]},{7,f[7]}}],
Dashed,
Line[{{1,0},{1,f[1]}}],Line[{{3,0},{3,f[3]}}],
Line[{{5,0},{5,f[5]}}],Line[{{7,0},{7,f[7]}}]
};

plotf = Plot[{f[x]} ,{x,0,8},Ticks->{{{1,"a"},{1,"a"},{7,"b"},{7,"b"}}, None},AspectRatio->Automatic,PlotRange->{Automatic,{-1,Automatic}} ]

Výsledný obrázek

final = Show[{plotA,plotB,plotC,plotf},Ticks->{tcks, None},Epilog-> epi]

Simpsonova metoda

Lagrangeovy polynomy

p1A[x_] := (((x-2)*(x-3))/((1-2)*(1-3)));p2A[x_] := (((x-1)*(x-3))/((2-1)*(2-3)));p3A[x_] := (((x-1)*(x-2))/((3-1)*(3-2)));
pA[x_] := f[1]*p1A[x]+f[2]*p2A[x]+f[3]*p3A[x];

p1B[x_] := (((x-6)*(x-7))/((5-6)*(5-7)));p2B[x_] := (((x-5)*(x-7))/((6-5)*(6-7)));p3B[x_] := (((x-5)*(x-6))/((7-5)*(7-6)));
pC[x_] := f[5]*p1B[x]+f[6]*p2B[x]+f[7]*p3B[x];

p1C[x_] := (((x-4)*(x-5))/((3-4)*(3-5)));p2C[x_] := (((x-3)*(x-5))/((4-3)*(4-5)));p3C[x_] := (((x-3)*(x-4))/((5-3)*(5-4)));
pB[x_] := f[3]*p1C[x]+f[4]*p2C[x]+f[5]*p3C[x];

Dělení

plotA = Plot[pA[x],{x,1,3},Filling->Axis,PlotStyle->Green,PlotRange->{{0,8},{-1,Automatic}},Ticks->None,AspectRatio->Automatic];
plotB = Plot[pB[x],{x,3,5},Filling->Axis,PlotStyle->Red,PlotRange->{{0,8},{-1,Automatic}},Ticks->None,AspectRatio->Automatic];
plotC = Plot[pC[x],{x,5,7},Filling->Axis,PlotStyle->Green,PlotRange->{{0,8},{-1,Automatic}},Ticks->None,AspectRatio->Automatic];

Popisky

popisek1 = Plot[{f[x]} ,{x,0,8},Ticks->{{{1,"a"},{1,"a"},{7,"b"},{7,"b"}}, None},AspectRatio->Automatic,PlotRange->{Automatic,{-1,Automatic}} ];
popisek2 = Plot[{f[x]} ,{x,1,7},Ticks->{{{1,Subscript["x","0"]},{1,Subscript["x","0"]},{7,Subscript["x","6"]},{7,Subscript["x","6"]}}, None},AspectRatio->Automatic,PlotRange->{Automatic,{-0.5,2.5}},Filling->Axis ];
intend = Show[{popisek1,popisek2},Epilog->{Text["f(x)",{7.75,1.75}],Dashed,Line[{{1,0},{1,f[1]}}],Line[{{7,0},{7,f[7]}}],PointSize[Medium],Point[{{1,f[1]},{7,f[7]}}]}];

Výsledný obrázek

final = Show[{plotA,plotB,plotC,popisek1},Ticks->{tcks, None},Epilog-> epi]

Opsaný a vepsaný mnohoúhelník

Použité funkce

nextPlus[number_,modulo_] := Mod[number,modulo]+1;

nextMinus[number_,modulo_] := If[number-1≤ 0,modulo,number-1];

scalarProd[dirX_,dirY_, nextPoint_] := dirX * nextPoint[[1]] + dirY*nextPoint[[2]];

getIntersect[points_,i_]:=
Module[{aa,bb,cc,dd,AA,BB,CC,DD,mod},
mod=Length[points];
{aa,bb} = points[[i]];
{cc,dd} = points[[nextPlus[i,mod]]];
{AA,BB} = points[[ nextPlus[nextPlus[i,mod],mod] ]];
{CC,DD} = points[[ nextPlus[nextPlus[nextPlus[i,mod],mod],mod] ]];
 Return[{aa,bb}+(((-bb+BB) CC+AA (bb-DD)+aa (-BB+DD))/(-BB cc+bb CC-CC dd+AA (-bb+dd)+aa (BB-DD)+cc DD))*{aa-cc,bb-dd}];
]

getHull[allPoints_] :=
Module[{aa,bb,cc,dd,AA,BB,CC,DD,intersect,i,mod,hull,points,leftovers},
(*{points,leftovers} = getNewList[allPoints];*)
points = allPoints;
leftovers = {};
mod = Length[points];
hull = {};


For[i=1,i≤ mod,i++,
intersect = getIntersect[points,i];
AppendTo[hull,intersect]
(*
Print[Graphics[{
Line[{{aa,bb},{cc,dd}}],
Line[{{AA,BB},{CC,DD}}],
PointSize[Large],
Point[intersect]
}]]
*)
];

Return[Join[hull,leftovers]];
];

ha[{ex_,ey_}, {vx_,vy_}] := {ex,ey} . {vx,vy};

generateCirclePoints[number_,phi_] := Table[{Cos[x+phi],Sin[x+phi]},{x,0,2Pi,2*Pi/number}][[;;-2]];

Region

reg= RegionPlot[(x^2)/2+(y^2)/1≤  1,{x,-4,4},{y,-1,1},PlotRange->All,AspectRatio->Automatic,MeshFunctions->{#1+#2&},Mesh->20,PlotStyle->None,ColorFunction->Black,BoundaryStyle->Black,Frame->None];

regNofill= RegionPlot[(x^2)/2+(y^2)/1≤  1,{x,-4,4},{y,-1,1},PlotRange->All,AspectRatio->Automatic,MeshFunctions->{#1+#2&},Mesh->0,PlotStyle->None,ColorFunction->Gray,BoundaryStyle->Black,Frame->None];
regDashed= RegionPlot[(x^2)/2+(y^2)/1≤  1,{x,-4,4},{y,-1,1},PlotRange->All,AspectRatio->Automatic,MeshFunctions->{#1+#2&},Mesh->0,PlotStyle->None,ColorFunction->Gray,BoundaryStyle->{Dashed,Gray},Frame->None];

Vybrané body

points2 = {{14/10,1/(5Sqrt[2])}, {1,1/Sqrt[2]}, {0,1}, {-1,1/Sqrt[2]},{-14/10,-1/(5Sqrt[2])}, {-1,-1/Sqrt[2]},{0,-1},{1,-1/Sqrt[2]}};

hull = getHull[points2];

Vepsaný mnohoúhelník

Mpoints = {Text[Subscript[k,1], {0,1},{0,-2}],
Text[Subscript[k,2],{-0.9,1/Sqrt[2]},{2.5,-1.75}],
Text[Subscript[k,3],{-14/10,-1/(5Sqrt[2])},{2,0}],
Text[Subscript[k,4], {-1,-1/Sqrt[2]},{1,1.5}],
Text[Subscript[k,5],{0,-1},{0,1.5}],
Text[Subscript[k,6],{1,-1/Sqrt[2]},{-1.5,1}],
Text[Subscript[k,7],{14/10,1/(5Sqrt[2])},{-2.5,0}],
Text[Subscript[k,8],{1,1/Sqrt[2]},{-1.7,-1.5}]};

g = Graphics[{
PointSize[Medium],
Point[points2],
Line[Append[points2,points2[[1]]]]
}];

g1 = Graphics[{
LightGray,
Polygon[Append[points2,points2[[1]]]],
Black,Line[Append[points2,points2[[1]]]],
PointSize[Medium],
Point[points2],
Text["M",{0,0}],
Mpoints
}];

g11 = Graphics[{
White,
Polygon[Append[points2,points2[[1]]]],
Black,Line[Append[points2,points2[[1]]]],
PointSize[Medium],
Point[points2],
Mpoints
}];

Opsaný mnohoúhelník

Lpoints = {Text[Subscript[l,1],{-0.7573593128807148`,1.2218254069479773`},{1,-1.7}],
Text[Subscript[l,2], {-1.8284271247461896`,0.46446609406726236`},{2.5,-0.75}],
Text[Subscript[l,3],{-1.585786437626905`,-0.5355339059327375`},{1.7,0.75}],
Text[Subscript[l,4],{-0.65685424949238`,-1.1923881554251181`},{0.5,1.5}],
Text[Subscript[l,5], {0.7573593128807148`,-1.2218254069479773`},{-0.75,1.5}],
Text[Subscript[l,6],{1.8284271247461896`,-0.46446609406726236`},{-2,0.5}],
Text[Subscript[l,7],{1.585786437626905`,0.5355339059327375`},{-2.5,-1.2}],
Text[Subscript[l,8],{0.65685424949238`,1.1923881554251181`},{-1.2,-1.5}]};

g2 = Graphics[{
LightGray,
Polygon[Append[hull,hull[[1]]]],
Black,Line[Append[hull,hull[[1]]]],
PointSize[Medium],
Point[hull],
Text["L",{0,0}],
Lpoints
}];

g22 = Graphics[{
Black,Line[Append[hull,hull[[1]]]],
Blue,
PointSize[Medium],
Point[hull],
Lpoints
}];

Několik výpočtů

haRight = Map[ha[{1,0},#]&, points2];
haLeft = Map[ha[{-1,0},#]&, points2];

iMaxRight = Ordering[haRight,-1][[1]];
iMaxLeft = Ordering[haRight,1][[1]];

rightUpper =getIntersect[points2,nextMinus[iMaxRight,Length[points2]]];
leftUpper =getIntersect[points2,nextMinus[nextMinus[iMaxLeft,Length[points2]],Length[points2]]];
rightLower = getIntersect[points2,nextMinus[nextMinus[iMaxRight,Length[points2]],Length[points2]]];
leftLower = getIntersect[points2,nextMinus[iMaxLeft,Length[points2]]];

iRightUpper = Position[hull,rightUpper][[1,1]];
iLeftUpper = Position[hull,leftUpper][[1,1]];
iRightLower = Position[hull,rightLower][[1,1]];
iLeftLower = Position[hull,leftLower][[1,1]];

upperHullPart = If[iRightUpper > iLeftUpper, 
Join[hull[[iRightUpper;;Length[hull]]], hull[[1;;iLeftUpper]]],
Join[hull[[iRightUpper;;iLeftUpper]]]
];

lowerHullPart = If[iRightUpper > iLeftUpper, 
hull[[iLeftUpper+1;;iRightUpper]][[1;;-2]],
Join[hull[[iLeftUpper+1;;Length[hull]]],hull[[1;;iRightUpper]][[1;;-2]]]
];

upperPointPart =  If[iMaxRight > iMaxLeft, 
Join[points2[[iMaxRight;;Length[points2]]], points2[[1;;iMaxLeft]]][[2;;-2]],
Join[points2[[iMaxRight;;iMaxLeft]]][[2;;-2]]
];

lowerPointPart =  If[iMaxRight > iMaxLeft, 
points2[[iMaxLeft+1;;iMaxRight]][[1;;-2]],
Join[points2[[iMaxLeft+1;;Length[points2]]],points2[[1;;iMaxRight]][[1;;-2]]]
];

lowerPointPart2 =  If[iMaxRight > iMaxLeft, 
points2[[iMaxLeft;;iMaxRight]],
Join[points2[[iMaxLeft;;Length[points2]]],points2[[1;;iMaxRight]]]
];

steinY[points_,n_] :=Module[{pts,res},
pts = N[generateCirclePoints[n,0]];
res = 0;
For[i=1,i≤ n,i++,res+=pts[[i,2]]*Max[Map[ha[pts[[i]],#]& ,points]]];
Return[((2*Pi)/n)*res*(1/Pi)];
];

steinX[points_,n_] :=Module[{pts,res},
pts = N[generateCirclePoints[n,0]];
res = 0;
For[i=1,i≤ n,i++,res+=pts[[i,1]]*Max[Map[ha[pts[[i]],#]& ,points]]];
Return[((2*Pi)/n)*res*(1/Pi)];
];

upperAprox = Append[Join[upperHullPart,lowerPointPart],Join[upperHullPart,lowerPointPart][[1]]];
lowerAprox = Append[Join[upperPointPart,lowerHullPart],Join[upperPointPart,lowerHullPart][[1]]];

Ukázky

Show[reg]

Show[{reg, Graphics[{
PointSize[Medium],
Point[points2],
Text["R",{0,0}],
Mpoints
}]},PlotRange->{{-2.2,2.2},{-1.6,1.6}},AspectRatio->Automatic]

Show[{regDashed,g1},PlotRange->{{-2.2,2.2},{-1.6,1.6}},AspectRatio->Automatic]

Show[{g2,regDashed},PlotRange->{{-2.2,2.2},{-1.6,1.6}}]

Průsečíky vepsaného

M = points2; L = hull;

im5a = Graphics[{
Thickness[0.001],
Dashed,
HalfLine[{{14/10,1/(5Sqrt[2])}, {1,1/Sqrt[2]}}],
HalfLine[{{1,1/Sqrt[2]}, {0,1}}],
HalfLine[ {{0,1}, {-1,1/Sqrt[2]}}],
HalfLine[{{-1,1/Sqrt[2]},{-14/10,-1/(5Sqrt[2])}}],
HalfLine[{{-14/10,-1/(5Sqrt[2])}, {-1,-1/Sqrt[2]}}],
HalfLine[ {{-1,-1/Sqrt[2]},{0,-1}}],
HalfLine[{{0,-1},{1,-1/Sqrt[2]}}],
HalfLine[{{1,-1/Sqrt[2]},{14/10,1/(5Sqrt[2])}}],

HalfLine[{ {1,1/Sqrt[2]},{14/10,1/(5Sqrt[2])}}],
HalfLine[{ {0,1},{1,1/Sqrt[2]}}],
HalfLine[ { {-1,1/Sqrt[2]},{0,1}}],
HalfLine[{{-14/10,-1/(5Sqrt[2])},{-1,1/Sqrt[2]}}],
HalfLine[{ {-1,-1/Sqrt[2]},{-14/10,-1/(5Sqrt[2])}}],
HalfLine[ {{0,-1},{-1,-1/Sqrt[2]}}],
HalfLine[{{1,-1/Sqrt[2]},{0,-1}}],
HalfLine[{{14/10,1/(5Sqrt[2])},{1,-1/Sqrt[2]}}],
Thickness[0.003],
Dashing[None],
Black,
PointSize[Medium],
Point[points2],
Line[Append[points2,points2[[1]]]],
PointSize[Medium],
Blue,
Point[hull],
LightGray,
Polygon[N[{M[[1]],M[[2]],L[[8]]}]],
Polygon[N[{M[[2]],M[[3]],L[[1]]}]],
Polygon[N[{M[[3]],M[[4]],L[[2]]}]],
Polygon[N[{M[[4]],M[[5]],L[[3]]}]],
Polygon[N[{M[[5]],M[[6]],L[[4]]}]],
Polygon[N[{M[[6]],M[[7]],L[[5]]}]],
Polygon[N[{M[[7]],M[[8]],L[[6]]}]],
Polygon[N[{M[[8]],M[[1]],L[[7]]}]]
}];

Další ukázky

Show[im5a]

Show[{im5a,g22,g11,regNofill,Graphics[{Thickness[0.002], Line[Append[points2,points2[[1]]]], Line[Append[hull,hull[[1]]]],Lpoints,Mpoints }]}]

Show[{regDashed,
Graphics[{
PointSize[Medium],
Point[points2],
(*Point[hull],*)
Line[Append[points2,points2[[1]]]],
(*Line[Append[hull,hull[[1]]]] ,*)
Text[Subscript[k,"+"],{11/10,1/(5Sqrt[2])}],
Text[Subscript[k,"-"],{-11/10,-1/(5Sqrt[2])}],
Gray,
Circle[{0,0},1/2],
PointSize[Medium],
Text["[0,0]",{0,-.15}],
Point[{{0,0}}],
Arrow[{{0,0},{1/2,0}}],
Arrow[{{0,0},{-1/2,0}}],
Dotted,
HalfLine[{{0,0},{1/2,0}}],
HalfLine[{{0,0},{-1/2,0}}],
InfiniteLine[{{0,0},{0,1}}],
Thickness[0.005],
Red,
Dashing[None],
InfiniteLine[{{14/10,-1/4},{14/10,1/2}}],
InfiniteLine[{{-14/10,-1/2},{-14/10,1/3}}],
Black,
Point[{{14/10,1/(5Sqrt[2])}}],
Point[{{-14/10,-1/(5Sqrt[2])}}],
Mpoints
}]
},PlotRange->{{-1.7,1.7},{-1.2,1.2}}]

Show[{regDashed,
Graphics[{
PointSize[Medium],
Line[Append[points2,points2[[1]]]],
Line[Append[hull,hull[[1]]]] ,
Text[Subscript[k,"+"],{11/10,1/(5Sqrt[2])}],
Text[Subscript[k,"-"],{-11/10,-1/(5Sqrt[2])}],
Thickness[0.005],
Red, 
Line[upperHullPart],
Line[upperPointPart],
Blue,
Line[lowerHullPart],
Line[lowerPointPart],
Black,
Point[points2],
Point[hull],
Lpoints,
Mpoints
}]
},PlotRange->{{-2,2},{-1.5,1.5}}]

imAproxes=Show[{regNofill,
Graphics[{
PointSize[Medium],
Line[Append[points2,points2[[1]]]],
Line[Append[hull,hull[[1]]]] ,
Thickness[0.005],
Red, 
Line[Append[Join[upperHullPart,lowerPointPart],Join[upperHullPart,lowerPointPart][[1]]]],
Blue,
Line[Append[Join[upperPointPart,lowerHullPart],Join[upperPointPart,lowerHullPart][[1]]]],
Black,
Point[points2],
Point[hull]
}]
}]

Show[{
Graphics[{
Arrowheads[0.02],
Text["E",{2.65,0}],
Arrow[{{2.5,steinY[upperAprox,128]},{2.5,steinY[lowerAprox,128]}}] ,
Arrow[{{2.5,steinY[lowerAprox,128]},{2.5,steinY[upperAprox,128]}}] ,
Dotted,
Line[{{steinX[upperAprox,128],steinY[upperAprox,128]}, {2.5,steinY[upperAprox,128]}}],
Line[{{steinX[lowerAprox,128],steinY[lowerAprox,128]}, {2.5,steinY[lowerAprox,128]}}],
Lpoints,
Mpoints,
Black,
Text[Subscript[s,y],{-0.15,0}]

}],
imAproxes,
ListPlot[{{steinX[upperAprox,128],steinY[upperAprox,128]}},PlotStyle->{Red,PointSize[Medium]}],
ListPlot[{{steinX[lowerAprox,128],steinY[lowerAprox,128]}},PlotStyle->{Blue,PointSize[Medium]}],
ListPlot[{{steinX[points2,128],steinY[points2,128]}},PlotStyle->{Black,PointSize[Medium]}]
},PlotRange->{{-2.1,2.75},{-1.5,1.5}}]

Kapitola 6: Demonstrace na konkrétních případech

Kruhové jádro

Funkce

kernelCirc[x_,y_,r_]:= Piecewise[{{1/(Pi*(r^2)),(x^2)+(y^2)≤(r^2)}}];
chiA[x_,y_]:= If[(((x))^2)+(((y))^2)≤1&& y≥0,1,0];

conCircNum[x_,y_,r_]:=Re[NIntegrate[ kernelCirc[x-u,y-v,r],Element[{u,v},Disk[{0,0},1,{0,Pi}]]]];
conCircMan[x_,y_,r_]:=Re[Integrate[ kernelCirc[x-u,y-v,r],Element[{u,v},Disk[{0,0},1,{0,Pi}]]]];

Ilustrace jádra

Plot3D[kernelCirc[x,y,1/2],{x,-0.75,0.75},{y,-0.75,0.75},PlotRange->All,Mesh->{1},AxesLabel->{"x",Framed["y",FrameStyle->None,FrameMargins->10],Framed["z",FrameStyle->None,FrameMargins->10]},ColorFunction->(Gray&),Lighting->"Neutral", Ticks->{Automatic,Automatic,{{0,"0.0"},{0.6,"0.6"},{1/(Pi * 1/4),4/Symbol["Pi"]}}}]

Průniky kruhu s půlkruhem - funkce

showImage[sx_,sy_,r_,x1_,x2_,y1_,y2_] :=
Module[{reg,im},
reg = RegionPlot[
{(x^2)+(y^2)≤ 1 && y≥ 0 && (((x-sx))^2)+(((y-sy))^2)≤(r^2)},
{x,x1,x2},{y,y1,y2},AspectRatio->Automatic,PlotStyle->Transparent,BoundaryStyle->Black,MeshFunctions->{#1-#2&},Mesh->{30}, Frame->None];
im= Show[{reg, 
Graphics[{
Circle[{0,0},1,{0,Pi}],
Line[{{-1,0},{1,0}}],
Circle[{sx,sy},r],
Point[{{sx,sy}}],
Text["[x,y]",{sx,sy},{0,-1.5}],
Text["A",{0,0.1},{0,-1.5}],
Point[{{0,0}}],
Text["[0,0]",{0,0},{0,1.5}]
}]},PlotRange->{{-1.5,1.5},{-0.5,1.5}}];
Print[im];
];

showImage2[sx_,sy_,r_,x1_,x2_,y1_,y2_] :=
Module[{reg,im,res,reg2,vec,a,b},
res = {a,b} /. Solve[(a^2)+(b^2) == 1 && b≥ 0 && (((a-sx))^2)+(((b-sy))^2)== (r^2),{a,b} ];
vec = Reverse[res[[1]]-res[[2]]];
vec = {vec[[1]]*-1,vec[[2]] };
reg = RegionPlot[
{Element[{x,y}, HalfPlane[{res[[1]], res[[2]]},vec]] && (x^2)+(y^2)≤ 1 && y≥ 0 && (((x-sx))^2)+(((y-sy))^2)≤(r^2) },
{x,x1,x2},{y,y1,y2},AspectRatio->Automatic,PlotStyle->Transparent,BoundaryStyle->Black,MeshFunctions->{#1-#2&},Mesh->{20}, Frame->None,PlotPoints->50];
reg2 = RegionPlot[
{Element[{x,y}, HalfPlane[{res[[1]], res[[2]]},-vec]] && (x^2)+(y^2)≤ 1 && y≥ 0 && (((x-sx))^2)+(((y-sy))^2)≤(r^2) },
{x,x1,x2},{y,y1,y2},AspectRatio->Automatic,PlotStyle->Transparent,BoundaryStyle->Black,MeshFunctions->{#1+#2&},Mesh->{20}, Frame->None,PlotPoints->50];

im= Show[{reg, reg2,
Graphics[{
Circle[{0,0},1,{0,Pi}],
Line[{{-1,0},{1,0}}],
Circle[{sx,sy},r],
Point[{{sx,sy}}],
Line[res],
(*Text["[x,y]",{sx,sy},{0,-1.5}],*)
Text["A",{0,0.1},{0,-1.5}],
Point[{{0,0}}],
Text["[0,0]",{0,0},{0,1.5}]
}]}];
Print[im];
];

Průniky kruhu s půlkruhem - ukázky

showImage[3/4,4/5,1/2,-1,1.25,-0.2,1.3]

showImage[3/4,1/2,1/2,-1,1.25,-0.2,1.3]

showImage[3/4,-0.1,1/2,-1,1.25,-0.2,1.3]

Regiony

{sx,sy,r,x1,x2,y1,y2} = {1/2,1/3,1/2,-1,1,-0.2,1};

reg0 =Graphics[{
Circle[{0,0},1,{0,Pi}],
Circle[{sx,sy},r],
Line[{{-1,0},{1,0}}],
Text["A",{0,0.1},{0,-1.5}],
Point[{{0,0}}],
Text["[0,0]",{0,0},{0,1.5}]
}];

reg1 = RegionPlot[
{  (((x-sx))^2)+(((y-sy))^2)≤(r^2)},
{x,x1,x2},{y,y1,y2},AspectRatio->Automatic,PlotStyle->Transparent,BoundaryStyle->Black,MeshFunctions->{#1-#2&},Mesh->{30}, Frame->None]

reg2 = RegionPlot[
{ y≤  0 && (((x-sx))^2)+(((y-sy))^2)≤(r^2)},
{x,x1,x2},{y,y1,y2},AspectRatio->Automatic,PlotStyle->Transparent,BoundaryStyle->Black,MeshFunctions->{#1+#2&},Mesh->{15}, Frame->None]

res = {a,b} /. Solve[(a^2)+(b^2) == 1 && b≥ 0 && (((a-sx))^2)+(((b-sy))^2)== (r^2),{a,b} ];
vec = Reverse[res[[1]]-res[[2]]];
vec = {vec[[1]]*-1,vec[[2]] };

reg3 = RegionPlot[
{ Element[{x,y},HalfPlane[{res[[1]],res[[2]]}, vec]] && (((x-sx))^2)+(((y-sy))^2)≤(r^2)},
{x,x1,x2},{y,y1,y2},AspectRatio->Automatic,PlotStyle->Transparent,BoundaryStyle->Black,MeshFunctions->{#1-#2&},Mesh->{15}, Frame->None]

reg4 = RegionPlot[
{ Element[{x,y},HalfPlane[{res[[1]],res[[2]]}, -vec]] && (((x-sx))^2)+(((y-sy))^2)≤(r^2)},
{x,x1,x2},{y,y1,y2},AspectRatio->Automatic,PlotStyle->Transparent,BoundaryStyle->Black,MeshFunctions->{#1+#2&},Mesh->{7}, Frame->None, PlotPoints->50]

reg5 = RegionPlot[
{ Element[{x,y},HalfPlane[{res[[1]],res[[2]]}, -vec]] && (((x))^2)+(((y))^2)≤1},
{x,x1,x2},{y,y1,y2},AspectRatio->Automatic,PlotStyle->Transparent,BoundaryStyle->Black,MeshFunctions->{#1-#2&},Mesh->{25}, Frame->None, PlotPoints->50]

Ukázky

r1 =Show[{reg0,reg1}]

r3 =Show[{reg0,reg5}]

r2 =Show[{reg0,reg1,reg2,reg4}]

Gauss

Funkce

muX = 0;muY = 0;
kernel[x_,y_] = PDF[MultinormalDistribution[{muX,muY},{{1,0},{0,1}}],{x,y}]

muX = 0; muY = 0;
kernel1[x_,y_] = PDF[MultinormalDistribution[{muX,muY},{{1,0},{0,1}}],{x,y}];
muX = -1; muY = -1;
kernel2[x_,y_] = PDF[MultinormalDistribution[{muX,muY},{{1,0},{0,1}}],{x,y}];
muX = 1; muY = 1;
kernel3[x_,y_] = PDF[MultinormalDistribution[{muX,muY},{{1,0},{0,1}}],{x,y}];
plot = Plot3D[{kernel1[x,y],kernel2[x,y],kernel3[x,y]},{x,-2,2},{y,-2,2},PlotRange->All]
kernel4[x_,y_] = PDF[MultinormalDistribution[{muX,muY},{{1/4,0},{0,1/3}}],{x,y}];

Pomocné obrázky

sx =-1; sy = 1;

r1 = RegionPlot3D[(x^2)+(y^2)≤1&&y≥0&&z≤   kernel1[x-sx,y-sy],{x,-2,2},{y,-2,2},{z,0,0.2},PlotPoints->150,Boxed->False, Mesh->None,ColorFunction->{Red &},PlotStyle->Opacity[0.25],Lighting->"Neutral",AspectRatio->Automatic];

r2 = RegionPlot3D[(x^2)+(y^2)≤ 1&&y≥0&& 0≤z≤0.01,{x,-2,2},{y,-2,2},{z,0,0.5},PlotRange->All,PlotPoints->150,Mesh->None,ColorFunction->{Black &},AspectRatio->Automatic];

p1 = Plot3D[kernel1[x-sx,y-sy]*Piecewise[{{1,(x^2)+(y^2)≤1&&y≥ 0}}],{x,-2,2},{y,0,2},PlotStyle->Automatic,Mesh->None,PlotPoints->25,Boxed->False,Lighting->"Neutral",ColorFunction->{Gray &}];

p2 = Plot3D[kernel1[x-sx,y-sy],{x,-2,2},{y,0,4},PlotStyle->{Gray,Opacity[0.25]},Mesh->20,PlotPoints->25,Boxed->False,ColorFunction->{Gray &}, AxesLabel->{"x","y",Framed["z",FrameStyle->None,FrameMargins->10]},AspectRatio->Automatic];

Ukázka

sh = Show[{p2,r1,r2}]

Přílohy

Konvoluce

Funkce

ClearAll[f,g,h]

g[x_]:=Piecewise[{{1,-1<x<1}}];
f[x_] := Piecewise[{{x/2, 0≤x≤2}}];
h[x_,s_] := Piecewise[{{x/2, s-1≤x≤s+1 && s > 0},{x/2,0≤x≤1 && s ==0}}];

Ukázka

GraphicsRow@Table[Show[
Plot[f[x],{x,-2,4}, Ticks->{Automatic,None},PlotRange -> All,AspectRatio->Automatic,ExclusionsStyle->Automatic],
Plot[g[x-i],{x,-2.01,4}, Ticks->{Automatic,None},PlotStyle->{Orange},PlotRange -> All,AspectRatio->Automatic,ExclusionsStyle->Automatic],
Plot[h[x,i],{x,-2,2},Filling->Axis,PlotStyle->Gray,PlotRange->All]
], {i, -1, 2}]

Plot[Convolve[f[x],g[x],x,y],{y,-2,4},PlotRange->All,AspectRatio->Automatic]

Show[
Plot[{0.25*(x+1)^2},{x,-1,1},PlotRange->All,AspectRatio->Automatic,PlotStyle->Orange,PlotLegends->"Expressions"],
Plot[{0.25*(x+1)^2},{x,1,3},PlotRange->All,AspectRatio->Automatic,PlotStyle->{Orange,Dashed}],
Plot[{0.25 * (4 - (x-1)^2)},{x,-1,1},PlotRange->All,AspectRatio->Automatic,PlotStyle->Dashed],
Plot[{0.25 * (4 - (x-1)^2)},{x,1,3},PlotRange->All,AspectRatio->Automatic]
]