added 18 characters in body
Source Link
cvgmt
  • 45.6k
  • 3
  • 30
  • 66
Clear["Global`*"];
pts = {{0., 0.}, {10., 0.}, {5., 8.}, {1., 6.}} // Rationalize;Map@N // 
   Rationalize[#, 0] &;
reg = Polygon[pts];
L = 8.0 // Rationalize;
conditions = 
  Exists[{x1, y1, x2, 
    y2}, {x1, y1} ∈ reg && {x2, y2} ∈ 
     reg && {x2 - x1, y2 - y1} . {x2 - x1, y2 - y1} >= L^2, 
   x == (x1 + x2)/2 && y == (y1 + y2)/2];
results = Resolve[conditions, Reals] // FullSimplify;
plot = RegionPlot[results, {x, 0, 10}, {y, 0, 10}, PlotPoints -> 80, 
   MaxRecursion -> 4, Prolog -> {EdgeForm[Cyan], FaceForm[], reg}];
domain = DiscretizeGraphics[plot];
nearest = RegionNearest@domain;
pt0 = {x, y} /. FindInstance[results, {x, y}][[1]];
fig[pt_] := 
  Module[{instance, vector}, 
   instance = 
    FindInstance[{RegionWithin[reg, Line[{pt - {u, v}, pt + {u, v}}]],
       u^2 + v^2 >= (L/2)^2}, {u, v}];
   vector = If[instance =!= {}, instance[[1]], {u -> 1, v -> 0}];
   Show[plot, 
    Graphics[{Red, AbsolutePointSize[5], Point[pt], 
       Arrow[{pt, pt - L/2 Normalize@{u, v}}], 
       Arrow[{pt, pt + L/2 Normalize@{u, v}}]} /. vector, 
     PlotRange -> {{0, 10}, {0, 10}}]]];
Manipulate[
 fig[pt], {{pt, pt0}, Locator, 
  TrackingFunction -> {pt = nearest@#; &}}, SaveDefinitions -> True]
Clear["Global`*"];
pts = {{0., 0.}, {10., 0.}, {5., 8.}, {1., 6.}} // Rationalize;
reg = Polygon[pts];
L = 8.0 // Rationalize;
conditions = 
  Exists[{x1, y1, x2, 
    y2}, {x1, y1} ∈ reg && {x2, y2} ∈ 
     reg && {x2 - x1, y2 - y1} . {x2 - x1, y2 - y1} >= L^2, 
   x == (x1 + x2)/2 && y == (y1 + y2)/2];
results = Resolve[conditions, Reals] // FullSimplify;
plot = RegionPlot[results, {x, 0, 10}, {y, 0, 10}, PlotPoints -> 80, 
   MaxRecursion -> 4, Prolog -> {EdgeForm[Cyan], FaceForm[], reg}];
domain = DiscretizeGraphics[plot];
nearest = RegionNearest@domain;
pt0 = {x, y} /. FindInstance[results, {x, y}][[1]];
fig[pt_] := 
  Module[{instance, vector}, 
   instance = 
    FindInstance[{RegionWithin[reg, Line[{pt - {u, v}, pt + {u, v}}]],
       u^2 + v^2 >= (L/2)^2}, {u, v}];
   vector = If[instance =!= {}, instance[[1]], {u -> 1, v -> 0}];
   Show[plot, 
    Graphics[{Red, AbsolutePointSize[5], Point[pt], 
       Arrow[{pt, pt - L/2 Normalize@{u, v}}], 
       Arrow[{pt, pt + L/2 Normalize@{u, v}}]} /. vector, 
     PlotRange -> {{0, 10}, {0, 10}}]]];
Manipulate[
 fig[pt], {{pt, pt0}, Locator, 
  TrackingFunction -> {pt = nearest@#; &}}, SaveDefinitions -> True]
Clear["Global`*"];
pts = {{0., 0.}, {10., 0.}, {5, 8}, {1, 6}} // Map@N // 
   Rationalize[#, 0] &;
reg = Polygon[pts];
L = 8.0 // Rationalize;
conditions = 
  Exists[{x1, y1, x2, 
    y2}, {x1, y1} ∈ reg && {x2, y2} ∈ 
     reg && {x2 - x1, y2 - y1} . {x2 - x1, y2 - y1} >= L^2, 
   x == (x1 + x2)/2 && y == (y1 + y2)/2];
results = Resolve[conditions, Reals] // FullSimplify;
plot = RegionPlot[results, {x, 0, 10}, {y, 0, 10}, PlotPoints -> 80, 
   MaxRecursion -> 4, Prolog -> {EdgeForm[Cyan], FaceForm[], reg}];
domain = DiscretizeGraphics[plot];
nearest = RegionNearest@domain;
pt0 = {x, y} /. FindInstance[results, {x, y}][[1]];
fig[pt_] := 
  Module[{instance, vector}, 
   instance = 
    FindInstance[{RegionWithin[reg, Line[{pt - {u, v}, pt + {u, v}}]],
       u^2 + v^2 >= (L/2)^2}, {u, v}];
   vector = If[instance =!= {}, instance[[1]], {u -> 1, v -> 0}];
   Show[plot, 
    Graphics[{Red, AbsolutePointSize[5], Point[pt], 
       Arrow[{pt, pt - L/2 Normalize@{u, v}}], 
       Arrow[{pt, pt + L/2 Normalize@{u, v}}]} /. vector, 
     PlotRange -> {{0, 10}, {0, 10}}]]];
Manipulate[
 fig[pt], {{pt, pt0}, Locator, 
  TrackingFunction -> {pt = nearest@#; &}}, SaveDefinitions -> True]
deleted 11 characters in body
Source Link
cvgmt
  • 45.6k
  • 3
  • 30
  • 66
Clear["Global`*"];
pts = {{0., 0.}, {10., 0.}, {5., 8.}, {1., 6.}} // Rationalize;
reg = Polygon[pts];
L = 8.0 // Rationalize;
conditions = 
  Exists[{x1, y1, x2, 
    y2}, {x1, y1} ∈ reg && {x2, y2} ∈ 
     reg && {x2 - x1, y2 - y1} . {x2 - x1, y2 - y1} >= L^2, 
   x == (x1 + x2)/2 && y == (y1 + y2)/2];
results = Resolve[conditions, Reals] // FullSimplify;
plot = RegionPlot[results, {x, 0, 10}, {y, 0, 10}, PlotPoints -> 80, 
   MaxRecursion -> 4, Prolog -> {EdgeForm[Cyan], FaceForm[], reg}];
domain = DiscretizeGraphics[plot];
nearest = RegionNearest@domain;
pt0 = {x, y} /. FindInstance[results, {x, y}][[1]];
fig[pt_] := 
  Module[{instance, vector}, 
   instance = 
    FindInstance[{RegionWithin[reg, Line[{pt - {u, v}, pt + {u, v}}]],
       u^2 + v^2 >= (L/2)^2}, {u, v}];
   vector = If[instance =!= {}, instance[[1]], {u -> 1, v -> 0}];
   Show[plot, 
    Graphics[{Red, AbsolutePointSize[5], Point[pt], 
       Arrow[{pt, pt - L/2 Normalize@{u, v}}], 
       Arrow[{pt, pt + L/2 Normalize@{u, v}}]} /. vector]];
Manipulate[vector, 
 Show[plot, fig[pt],   PlotRange -> {{0, 10}, {0, 10}}, ]]];
  PerformanceGoal ->Manipulate[
 "Quality"]fig[pt], {{pt, pt0}, Locator, 
  TrackingFunction -> {pt = nearest@#; &}}, SaveDefinitions -> True]
Clear["Global`*"];
pts = {{0., 0.}, {10., 0.}, {5., 8.}, {1., 6.}} // Rationalize;
reg = Polygon[pts];
L = 8.0 // Rationalize;
conditions = 
  Exists[{x1, y1, x2, 
    y2}, {x1, y1} ∈ reg && {x2, y2} ∈ 
     reg && {x2 - x1, y2 - y1} . {x2 - x1, y2 - y1} >= L^2, 
   x == (x1 + x2)/2 && y == (y1 + y2)/2];
results = Resolve[conditions, Reals] // FullSimplify;
plot = RegionPlot[results, {x, 0, 10}, {y, 0, 10}, PlotPoints -> 80, 
   MaxRecursion -> 4, Prolog -> {EdgeForm[Cyan], FaceForm[], reg}];
domain = DiscretizeGraphics[plot];
nearest = RegionNearest@domain;
pt0 = {x, y} /. FindInstance[results, {x, y}][[1]];
fig[pt_] := 
  Module[{instance, vector}, 
   instance = 
    FindInstance[{RegionWithin[reg, Line[{pt - {u, v}, pt + {u, v}}]],
       u^2 + v^2 >= (L/2)^2}, {u, v}];
   vector = If[instance =!= {}, instance[[1]], {u -> 1, v -> 0}];
   Graphics[{Red, AbsolutePointSize[5], Point[pt], 
      Arrow[{pt, pt - L/2 Normalize@{u, v}}], 
      Arrow[{pt, pt + L/2 Normalize@{u, v}}]} /. vector]];
Manipulate[
 Show[plot, fig[pt], PlotRange -> {{0, 10}, {0, 10}}, 
  PerformanceGoal -> "Quality"], {{pt, pt0}, Locator, 
  TrackingFunction -> {pt = nearest@#; &}}, SaveDefinitions -> True]
Clear["Global`*"];
pts = {{0., 0.}, {10., 0.}, {5., 8.}, {1., 6.}} // Rationalize;
reg = Polygon[pts];
L = 8.0 // Rationalize;
conditions = 
  Exists[{x1, y1, x2, 
    y2}, {x1, y1} ∈ reg && {x2, y2} ∈ 
     reg && {x2 - x1, y2 - y1} . {x2 - x1, y2 - y1} >= L^2, 
   x == (x1 + x2)/2 && y == (y1 + y2)/2];
results = Resolve[conditions, Reals] // FullSimplify;
plot = RegionPlot[results, {x, 0, 10}, {y, 0, 10}, PlotPoints -> 80, 
   MaxRecursion -> 4, Prolog -> {EdgeForm[Cyan], FaceForm[], reg}];
domain = DiscretizeGraphics[plot];
nearest = RegionNearest@domain;
pt0 = {x, y} /. FindInstance[results, {x, y}][[1]];
fig[pt_] := 
  Module[{instance, vector}, 
   instance = 
    FindInstance[{RegionWithin[reg, Line[{pt - {u, v}, pt + {u, v}}]],
       u^2 + v^2 >= (L/2)^2}, {u, v}];
   vector = If[instance =!= {}, instance[[1]], {u -> 1, v -> 0}];
   Show[plot, 
    Graphics[{Red, AbsolutePointSize[5], Point[pt], 
       Arrow[{pt, pt - L/2 Normalize@{u, v}}], 
       Arrow[{pt, pt + L/2 Normalize@{u, v}}]} /. vector, 
     PlotRange -> {{0, 10}, {0, 10}}]]];
Manipulate[
 fig[pt], {{pt, pt0}, Locator, 
  TrackingFunction -> {pt = nearest@#; &}}, SaveDefinitions -> True]
deleted 18 characters in body
Source Link
cvgmt
  • 45.6k
  • 3
  • 30
  • 66
Clear["Global`*"];
pts = {{0., 0.}, {10., 0.}, {5., 8.}, {1., 6.}} // Rationalize;
reg = Polygon[pts];
L = 8.0 // Rationalize;
conditions = 
  Exists[{x1, y1, x2, 
    y2}, {x1, y1} \[Element] reg && {x2, y2} \[Element] 
     reg && {x2 - x1, y2 - y1} . {x2 - x1, y2 - y1} >= L^2, 
   x == (x1 + x2)/2 && y == (y1 + y2)/2];
results = Resolve[conditions, Reals] // FullSimplify;
plot = RegionPlot[results, {x, 0, 10}, {y, 0, 10}, PlotPoints -> 80, 
   MaxRecursion -> 4, Prolog -> {EdgeForm[Cyan], FaceForm[], reg}];
domain = DiscretizeGraphics[plot];
nearest = RegionNearest@domain;
pt0 = {x, y} /. FindInstance[results, {x, y}][[1]];
fig[pt_] := 
  Module[{instance, vector}, 
   instance = 
    FindInstance[{RegionWithin[reg, Line[{pt - {u, v}, pt + {u, v}}]],
       u^2 + v^2 >= (L/2)^2}, {u, v}];
   vector = If[instance =!= {}, instance[[1]], {u -> 1, v -> 0}];
   Graphics[{Red, AbsolutePointSize[5], Point[pt], 
      Arrow[{pt, pt - L/2 Normalize@{u, v}}], 
      Arrow[{pt, pt + L/2 Normalize@{u, v}}]} /. vector]];
Manipulate[
 Show[plot, fig[pt], PlotRange -> {{0, 10}, {0, 10}}, 
  PerformanceGoal -> "Quality"], {{pt, pt0}, Locator, 
  TrackingFunction -> {pt = nearest@#; &}}, SaveDefinitions -> True]
Clear["Global`*"];
pts = {{0., 0.}, {10., 0.}, {5., 8.}, {1., 6.}} // Rationalize;
reg = Polygon[pts];
L = 8.0 // Rationalize;
conditions = 
  Exists[{x1, y1, x2, 
    y2}, {x1, y1} \[Element] reg && {x2, y2} \[Element] 
     reg && {x2 - x1, y2 - y1} . {x2 - x1, y2 - y1} >= L^2, 
   x == (x1 + x2)/2 && y == (y1 + y2)/2];
results = Resolve[conditions, Reals] // FullSimplify;
plot = RegionPlot[results, {x, 0, 10}, {y, 0, 10}, PlotPoints -> 80, 
   MaxRecursion -> 4, Prolog -> {EdgeForm[Cyan], FaceForm[], reg}];
domain = DiscretizeGraphics[plot];
nearest = RegionNearest@domain;
pt0 = {x, y} /. FindInstance[results, {x, y}][[1]];
fig[pt_] := 
  Module[{instance, vector}, 
   instance = 
    FindInstance[{RegionWithin[reg, Line[{pt - {u, v}, pt + {u, v}}]],
       u^2 + v^2 >= (L/2)^2}, {u, v}];
   vector = If[instance =!= {}, instance[[1]], {u -> 1, v -> 0}];
   Graphics[{Red, AbsolutePointSize[5], Point[pt], 
      Arrow[{pt, pt - L/2 Normalize@{u, v}}], 
      Arrow[{pt, pt + L/2 Normalize@{u, v}}]} /. vector]];
Manipulate[
 Show[plot, fig[pt], PlotRange -> {{0, 10}, {0, 10}}, 
  PerformanceGoal -> "Quality"], {{pt, pt0}, Locator, 
  TrackingFunction -> {pt = nearest@#; &}}, SaveDefinitions -> True]
Clear["Global`*"];
pts = {{0., 0.}, {10., 0.}, {5., 8.}, {1., 6.}} // Rationalize;
reg = Polygon[pts];
L = 8.0 // Rationalize;
conditions = 
  Exists[{x1, y1, x2, 
    y2}, {x1, y1}  reg && {x2, y2}  
     reg && {x2 - x1, y2 - y1} . {x2 - x1, y2 - y1} >= L^2, 
   x == (x1 + x2)/2 && y == (y1 + y2)/2];
results = Resolve[conditions, Reals] // FullSimplify;
plot = RegionPlot[results, {x, 0, 10}, {y, 0, 10}, PlotPoints -> 80, 
   MaxRecursion -> 4, Prolog -> {EdgeForm[Cyan], FaceForm[], reg}];
domain = DiscretizeGraphics[plot];
nearest = RegionNearest@domain;
pt0 = {x, y} /. FindInstance[results, {x, y}][[1]];
fig[pt_] := 
  Module[{instance, vector}, 
   instance = 
    FindInstance[{RegionWithin[reg, Line[{pt - {u, v}, pt + {u, v}}]],
       u^2 + v^2 >= (L/2)^2}, {u, v}];
   vector = If[instance =!= {}, instance[[1]], {u -> 1, v -> 0}];
   Graphics[{Red, AbsolutePointSize[5], Point[pt], 
      Arrow[{pt, pt - L/2 Normalize@{u, v}}], 
      Arrow[{pt, pt + L/2 Normalize@{u, v}}]} /. vector]];
Manipulate[
 Show[plot, fig[pt], PlotRange -> {{0, 10}, {0, 10}}, 
  PerformanceGoal -> "Quality"], {{pt, pt0}, Locator, 
  TrackingFunction -> {pt = nearest@#; &}}, SaveDefinitions -> True]
added 12 characters in body
Source Link
cvgmt
  • 45.6k
  • 3
  • 30
  • 66
Loading
added 1367 characters in body
Source Link
cvgmt
  • 45.6k
  • 3
  • 30
  • 66
Loading
added 594 characters in body
Source Link
cvgmt
  • 45.6k
  • 3
  • 30
  • 66
Loading
added 594 characters in body
Source Link
cvgmt
  • 45.6k
  • 3
  • 30
  • 66
Loading
added 16 characters in body
Source Link
cvgmt
  • 45.6k
  • 3
  • 30
  • 66
Loading
added 2 characters in body
Source Link
cvgmt
  • 45.6k
  • 3
  • 30
  • 66
Loading
added 106 characters in body
Source Link
cvgmt
  • 45.6k
  • 3
  • 30
  • 66
Loading
added 17 characters in body
Source Link
cvgmt
  • 45.6k
  • 3
  • 30
  • 66
Loading
added 17 characters in body
Source Link
cvgmt
  • 45.6k
  • 3
  • 30
  • 66
Loading
added 6 characters in body
Source Link
cvgmt
  • 45.6k
  • 3
  • 30
  • 66
Loading
added 114 characters in body
Source Link
cvgmt
  • 45.6k
  • 3
  • 30
  • 66
Loading
added 526 characters in body
Source Link
cvgmt
  • 45.6k
  • 3
  • 30
  • 66
Loading
Source Link
cvgmt
  • 45.6k
  • 3
  • 30
  • 66
Loading