How to determine the longest edge in a graph?












9














I have a list of 2D points such as in the image. 



coord = {{0, 0}, {10, 0}, {20, 0}, {30, 0}, {25, 10}, {0, 10}, {0, 

5}};


enter image description here



I would like to determine the longest "edge" length in a way that if 2 segments are in same line, they would be considered as part of 1 edge. For example, segments 1-2, 2-3, 3-4 are continuous and in the same line, so we consider it as 1 edge connecting Vertex 1 and Vertex 4. In this example, the longest edge length would be the distance from vertex 1 to vertex 4. How can I determine the longest edge length in Mathematica?






list-manipulation graphics







share|improve this question



























    9














    I have a list of 2D points such as in the image. 



    coord = {{0, 0}, {10, 0}, {20, 0}, {30, 0}, {25, 10}, {0, 10}, {0, 
    
5}};


    enter image description here



    I would like to determine the longest "edge" length in a way that if 2 segments are in same line, they would be considered as part of 1 edge. For example, segments 1-2, 2-3, 3-4 are continuous and in the same line, so we consider it as 1 edge connecting Vertex 1 and Vertex 4. In this example, the longest edge length would be the distance from vertex 1 to vertex 4. How can I determine the longest edge length in Mathematica?






    list-manipulation graphics







    share|improve this question

























      9












      9








      9


      1





      I have a list of 2D points such as in the image. 



      coord = {{0, 0}, {10, 0}, {20, 0}, {30, 0}, {25, 10}, {0, 10}, {0, 
      
5}};


      enter image description here



      I would like to determine the longest "edge" length in a way that if 2 segments are in same line, they would be considered as part of 1 edge. For example, segments 1-2, 2-3, 3-4 are continuous and in the same line, so we consider it as 1 edge connecting Vertex 1 and Vertex 4. In this example, the longest edge length would be the distance from vertex 1 to vertex 4. How can I determine the longest edge length in Mathematica?






      list-manipulation graphics







      share|improve this question













      I have a list of 2D points such as in the image. 



      coord = {{0, 0}, {10, 0}, {20, 0}, {30, 0}, {25, 10}, {0, 10}, {0, 
      
5}};


      enter image description here



      I would like to determine the longest "edge" length in a way that if 2 segments are in same line, they would be considered as part of 1 edge. For example, segments 1-2, 2-3, 3-4 are continuous and in the same line, so we consider it as 1 edge connecting Vertex 1 and Vertex 4. In this example, the longest edge length would be the distance from vertex 1 to vertex 4. How can I determine the longest edge length in Mathematica?






      list-manipulation graphics




      list-manipulation graphics






      share|improve this question













      share|improve this question











      share|improve this question




      share|improve this question










      asked yesterday









      N.T.C

      38917




      38917






















          1 Answer
          1






          active

          oldest

          votes


















          9














          Update: The function in the original answer does not work for arbitrary polygons. The following seems to work



          ClearAll[nonCollinearHull]
          
nonCollinearHull = DeleteCases[#, Alternatives @@ 
          
  (SequenceCases[PadRight[#, 1 + Length@#, "Periodic"],
          
    {a_, Longest[b__], c_} /; (And @@ (RegionMember[ConvexHullMesh[{a, c}]] /@ {b})) :> b, 
          
      Overlaps -> True])] &;


          Examples:



          coord = {{0, 0}, {10, 0}, {20, 0}, {30, 0}, {25, 10}, {0, 10}, {0, 5}};
          
lines = Line /@ Partition[nonCollinearHull[coord], 2, 1];
          
longest = Last@SortBy[lines, N@ArcLength[#] &];
          
Graphics[{EdgeForm[Gray], FaceForm, Polygon@coord, Blue, 
          
  PointSize[Large], Point@coord, Opacity[.5, Green], 
          
  AbsolutePointSize[15], Point[nonCollinearHull[coord]], 
          
  Thickness[.03], CapForm["Round"], Opacity[.5], Red, longest}]


          enter image description here



          Using



          SeedRandom[123]
          
coord2 = DeleteDuplicates[#[[FindShortestTour[#][[2]]]] & @
          
   DeleteDuplicates@RandomInteger[10, {50, 2}];


          we get



          enter image description here



          And with



          SeedRandom[123]
          
coord3 = DeleteDuplicates[#[[FindShortestTour[#][[2]]]] &@ 
          
   DeleteDuplicates@RandomInteger[20, {200, 2}]];


          enter image description here



          Original answer:



          Using the function noncollinearF from this answer:



          ClearAll[noncollinearF]
          
noncollinearF[verts_] := Function[{k}, Nor @@ (RegionMember[ConvexHullMesh[#], k] & /@ 
          
  Subsets[Complement[verts, {k}], {2}])]
          

          
lines = Line /@ Partition[Pick[#, noncollinearF[#] /@ #], 2, 1, {1, 1}]& @ coord;
          
longest = Last@SortBy[lines, N@ArcLength[#] &]; 
          
Graphics[{EdgeForm[Gray], FaceForm, Polygon@coord, 
          
  Blue, PointSize[Large], Point@coord, 
          
  Thickness[.03], CapForm["Round"], Opacity[.5], Red, longest}]


          enter image description here






          share|improve this answer























          • Why ConvexHullMesh and not just Line?
            – swish
            3 hours ago










          • It breaks if a coordinate list starts in the middle of the longest edge. Try RotateLeft[coord, 2] for the original example.
            – swish
            3 hours ago











          Your Answer





          StackExchange.ifUsing("editor", function () {
          return StackExchange.using("mathjaxEditing", function () {
          StackExchange.MarkdownEditor.creationCallbacks.add(function (editor, postfix) {
          StackExchange.mathjaxEditing.prepareWmdForMathJax(editor, postfix, [["$", "$"], ["\\(","\\)"]]);
          });
          });
          }, "mathjax-editing");

          StackExchange.ready(function() {
          var channelOptions = {
          tags: "".split(" "),
          id: "387"
          };
          initTagRenderer("".split(" "), "".split(" "), channelOptions);

          StackExchange.using("externalEditor", function() {
          // Have to fire editor after snippets, if snippets enabled
          if (StackExchange.settings.snippets.snippetsEnabled) {
          StackExchange.using("snippets", function() {
          createEditor();
          });
          }
          else {
          createEditor();
          }
          });

          function createEditor() {
          StackExchange.prepareEditor({
          heartbeatType: 'answer',
          autoActivateHeartbeat: false,
          convertImagesToLinks: false,
          noModals: true,
          showLowRepImageUploadWarning: true,
          reputationToPostImages: null,
          bindNavPrevention: true,
          postfix: "",
          imageUploader: {
          brandingHtml: "Powered by u003ca class="icon-imgur-white" href="https://imgur.com/"u003eu003c/au003e",
          contentPolicyHtml: "User contributions licensed under u003ca href="https://creativecommons.org/licenses/by-sa/3.0/"u003ecc by-sa 3.0 with attribution requiredu003c/au003e u003ca href="https://stackoverflow.com/legal/content-policy"u003e(content policy)u003c/au003e",
          allowUrls: true
          },
          onDemand: true,
          discardSelector: ".discard-answer"
          ,immediatelyShowMarkdownHelp:true
          });


          }
          });














          draft saved

          draft discarded


















          StackExchange.ready(
          function () {
          StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fmathematica.stackexchange.com%2fquestions%2f188760%2fhow-to-determine-the-longest-edge-in-a-graph%23new-answer', 'question_page');
          }
          );

          Post as a guest















          Required, but never shown

























          1 Answer
          1






          active

          oldest

          votes








          1 Answer
          1






          active

          oldest

          votes









          active

          oldest

          votes






          active

          oldest

          votes









          9














          Update: The function in the original answer does not work for arbitrary polygons. The following seems to work



          ClearAll[nonCollinearHull]
          
nonCollinearHull = DeleteCases[#, Alternatives @@ 
          
  (SequenceCases[PadRight[#, 1 + Length@#, "Periodic"],
          
    {a_, Longest[b__], c_} /; (And @@ (RegionMember[ConvexHullMesh[{a, c}]] /@ {b})) :> b, 
          
      Overlaps -> True])] &;


          Examples:



          coord = {{0, 0}, {10, 0}, {20, 0}, {30, 0}, {25, 10}, {0, 10}, {0, 5}};
          
lines = Line /@ Partition[nonCollinearHull[coord], 2, 1];
          
longest = Last@SortBy[lines, N@ArcLength[#] &];
          
Graphics[{EdgeForm[Gray], FaceForm, Polygon@coord, Blue, 
          
  PointSize[Large], Point@coord, Opacity[.5, Green], 
          
  AbsolutePointSize[15], Point[nonCollinearHull[coord]], 
          
  Thickness[.03], CapForm["Round"], Opacity[.5], Red, longest}]


          enter image description here



          Using



          SeedRandom[123]
          
coord2 = DeleteDuplicates[#[[FindShortestTour[#][[2]]]] & @
          
   DeleteDuplicates@RandomInteger[10, {50, 2}];


          we get



          enter image description here



          And with



          SeedRandom[123]
          
coord3 = DeleteDuplicates[#[[FindShortestTour[#][[2]]]] &@ 
          
   DeleteDuplicates@RandomInteger[20, {200, 2}]];


          enter image description here



          Original answer:



          Using the function noncollinearF from this answer:



          ClearAll[noncollinearF]
          
noncollinearF[verts_] := Function[{k}, Nor @@ (RegionMember[ConvexHullMesh[#], k] & /@ 
          
  Subsets[Complement[verts, {k}], {2}])]
          

          
lines = Line /@ Partition[Pick[#, noncollinearF[#] /@ #], 2, 1, {1, 1}]& @ coord;
          
longest = Last@SortBy[lines, N@ArcLength[#] &]; 
          
Graphics[{EdgeForm[Gray], FaceForm, Polygon@coord, 
          
  Blue, PointSize[Large], Point@coord, 
          
  Thickness[.03], CapForm["Round"], Opacity[.5], Red, longest}]


          enter image description here






          share|improve this answer























          • Why ConvexHullMesh and not just Line?
            – swish
            3 hours ago










          • It breaks if a coordinate list starts in the middle of the longest edge. Try RotateLeft[coord, 2] for the original example.
            – swish
            3 hours ago
















          9














          Update: The function in the original answer does not work for arbitrary polygons. The following seems to work



          ClearAll[nonCollinearHull]
          
nonCollinearHull = DeleteCases[#, Alternatives @@ 
          
  (SequenceCases[PadRight[#, 1 + Length@#, "Periodic"],
          
    {a_, Longest[b__], c_} /; (And @@ (RegionMember[ConvexHullMesh[{a, c}]] /@ {b})) :> b, 
          
      Overlaps -> True])] &;


          Examples:



          coord = {{0, 0}, {10, 0}, {20, 0}, {30, 0}, {25, 10}, {0, 10}, {0, 5}};
          
lines = Line /@ Partition[nonCollinearHull[coord], 2, 1];
          
longest = Last@SortBy[lines, N@ArcLength[#] &];
          
Graphics[{EdgeForm[Gray], FaceForm, Polygon@coord, Blue, 
          
  PointSize[Large], Point@coord, Opacity[.5, Green], 
          
  AbsolutePointSize[15], Point[nonCollinearHull[coord]], 
          
  Thickness[.03], CapForm["Round"], Opacity[.5], Red, longest}]


          enter image description here



          Using



          SeedRandom[123]
          
coord2 = DeleteDuplicates[#[[FindShortestTour[#][[2]]]] & @
          
   DeleteDuplicates@RandomInteger[10, {50, 2}];


          we get



          enter image description here



          And with



          SeedRandom[123]
          
coord3 = DeleteDuplicates[#[[FindShortestTour[#][[2]]]] &@ 
          
   DeleteDuplicates@RandomInteger[20, {200, 2}]];


          enter image description here



          Original answer:



          Using the function noncollinearF from this answer:



          ClearAll[noncollinearF]
          
noncollinearF[verts_] := Function[{k}, Nor @@ (RegionMember[ConvexHullMesh[#], k] & /@ 
          
  Subsets[Complement[verts, {k}], {2}])]
          

          
lines = Line /@ Partition[Pick[#, noncollinearF[#] /@ #], 2, 1, {1, 1}]& @ coord;
          
longest = Last@SortBy[lines, N@ArcLength[#] &]; 
          
Graphics[{EdgeForm[Gray], FaceForm, Polygon@coord, 
          
  Blue, PointSize[Large], Point@coord, 
          
  Thickness[.03], CapForm["Round"], Opacity[.5], Red, longest}]


          enter image description here






          share|improve this answer























          • Why ConvexHullMesh and not just Line?
            – swish
            3 hours ago










          • It breaks if a coordinate list starts in the middle of the longest edge. Try RotateLeft[coord, 2] for the original example.
            – swish
            3 hours ago














          9












          9








          9






          Update: The function in the original answer does not work for arbitrary polygons. The following seems to work



          ClearAll[nonCollinearHull]
          
nonCollinearHull = DeleteCases[#, Alternatives @@ 
          
  (SequenceCases[PadRight[#, 1 + Length@#, "Periodic"],
          
    {a_, Longest[b__], c_} /; (And @@ (RegionMember[ConvexHullMesh[{a, c}]] /@ {b})) :> b, 
          
      Overlaps -> True])] &;


          Examples:



          coord = {{0, 0}, {10, 0}, {20, 0}, {30, 0}, {25, 10}, {0, 10}, {0, 5}};
          
lines = Line /@ Partition[nonCollinearHull[coord], 2, 1];
          
longest = Last@SortBy[lines, N@ArcLength[#] &];
          
Graphics[{EdgeForm[Gray], FaceForm, Polygon@coord, Blue, 
          
  PointSize[Large], Point@coord, Opacity[.5, Green], 
          
  AbsolutePointSize[15], Point[nonCollinearHull[coord]], 
          
  Thickness[.03], CapForm["Round"], Opacity[.5], Red, longest}]


          enter image description here



          Using



          SeedRandom[123]
          
coord2 = DeleteDuplicates[#[[FindShortestTour[#][[2]]]] & @
          
   DeleteDuplicates@RandomInteger[10, {50, 2}];


          we get



          enter image description here



          And with



          SeedRandom[123]
          
coord3 = DeleteDuplicates[#[[FindShortestTour[#][[2]]]] &@ 
          
   DeleteDuplicates@RandomInteger[20, {200, 2}]];


          enter image description here



          Original answer:



          Using the function noncollinearF from this answer:



          ClearAll[noncollinearF]
          
noncollinearF[verts_] := Function[{k}, Nor @@ (RegionMember[ConvexHullMesh[#], k] & /@ 
          
  Subsets[Complement[verts, {k}], {2}])]
          

          
lines = Line /@ Partition[Pick[#, noncollinearF[#] /@ #], 2, 1, {1, 1}]& @ coord;
          
longest = Last@SortBy[lines, N@ArcLength[#] &]; 
          
Graphics[{EdgeForm[Gray], FaceForm, Polygon@coord, 
          
  Blue, PointSize[Large], Point@coord, 
          
  Thickness[.03], CapForm["Round"], Opacity[.5], Red, longest}]


          enter image description here






          share|improve this answer














          Update: The function in the original answer does not work for arbitrary polygons. The following seems to work



          ClearAll[nonCollinearHull]
          
nonCollinearHull = DeleteCases[#, Alternatives @@ 
          
  (SequenceCases[PadRight[#, 1 + Length@#, "Periodic"],
          
    {a_, Longest[b__], c_} /; (And @@ (RegionMember[ConvexHullMesh[{a, c}]] /@ {b})) :> b, 
          
      Overlaps -> True])] &;


          Examples:



          coord = {{0, 0}, {10, 0}, {20, 0}, {30, 0}, {25, 10}, {0, 10}, {0, 5}};
          
lines = Line /@ Partition[nonCollinearHull[coord], 2, 1];
          
longest = Last@SortBy[lines, N@ArcLength[#] &];
          
Graphics[{EdgeForm[Gray], FaceForm, Polygon@coord, Blue, 
          
  PointSize[Large], Point@coord, Opacity[.5, Green], 
          
  AbsolutePointSize[15], Point[nonCollinearHull[coord]], 
          
  Thickness[.03], CapForm["Round"], Opacity[.5], Red, longest}]


          enter image description here



          Using



          SeedRandom[123]
          
coord2 = DeleteDuplicates[#[[FindShortestTour[#][[2]]]] & @
          
   DeleteDuplicates@RandomInteger[10, {50, 2}];


          we get



          enter image description here



          And with



          SeedRandom[123]
          
coord3 = DeleteDuplicates[#[[FindShortestTour[#][[2]]]] &@ 
          
   DeleteDuplicates@RandomInteger[20, {200, 2}]];


          enter image description here



          Original answer:



          Using the function noncollinearF from this answer:



          ClearAll[noncollinearF]
          
noncollinearF[verts_] := Function[{k}, Nor @@ (RegionMember[ConvexHullMesh[#], k] & /@ 
          
  Subsets[Complement[verts, {k}], {2}])]
          

          
lines = Line /@ Partition[Pick[#, noncollinearF[#] /@ #], 2, 1, {1, 1}]& @ coord;
          
longest = Last@SortBy[lines, N@ArcLength[#] &]; 
          
Graphics[{EdgeForm[Gray], FaceForm, Polygon@coord, 
          
  Blue, PointSize[Large], Point@coord, 
          
  Thickness[.03], CapForm["Round"], Opacity[.5], Red, longest}]


          enter image description here







          share|improve this answer














          share|improve this answer



          share|improve this answer








          edited 6 hours ago

























          answered 23 hours ago









          kglr

          177k9198406




          177k9198406












          • Why ConvexHullMesh and not just Line?
            – swish
            3 hours ago










          • It breaks if a coordinate list starts in the middle of the longest edge. Try RotateLeft[coord, 2] for the original example.
            – swish
            3 hours ago


















          • Why ConvexHullMesh and not just Line?
            – swish
            3 hours ago










          • It breaks if a coordinate list starts in the middle of the longest edge. Try RotateLeft[coord, 2] for the original example.
            – swish
            3 hours ago
















          Why ConvexHullMesh and not just Line?
          – swish
          3 hours ago




          Why ConvexHullMesh and not just Line?
          – swish
          3 hours ago












          It breaks if a coordinate list starts in the middle of the longest edge. Try RotateLeft[coord, 2] for the original example.
          – swish
          3 hours ago




          It breaks if a coordinate list starts in the middle of the longest edge. Try RotateLeft[coord, 2] for the original example.
          – swish
          3 hours ago


















          draft saved

          draft discarded




















































          Thanks for contributing an answer to Mathematica Stack Exchange!


          • Please be sure to answer the question. Provide details and share your research!

          But avoid …



          • Asking for help, clarification, or responding to other answers.

          • Making statements based on opinion; back them up with references or personal experience.


          Use MathJax to format equations. MathJax reference.


          To learn more, see our tips on writing great answers.





          Some of your past answers have not been well-received, and you're in danger of being blocked from answering.


          Please pay close attention to the following guidance:


          • Please be sure to answer the question. Provide details and share your research!

          But avoid …



          • Asking for help, clarification, or responding to other answers.

          • Making statements based on opinion; back them up with references or personal experience.


          To learn more, see our tips on writing great answers.




          draft saved


          draft discarded














          StackExchange.ready(
          function () {
          StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fmathematica.stackexchange.com%2fquestions%2f188760%2fhow-to-determine-the-longest-edge-in-a-graph%23new-answer', 'question_page');
          }
          );

          Post as a guest















          Required, but never shown





















































          Required, but never shown














          Required, but never shown












          Required, but never shown







          Required, but never shown

































          Required, but never shown














          Required, but never shown












          Required, but never shown







          Required, but never shown







          -

          Popular posts from this blog

          1300-talet

          Image
          Den här artikeln handlar om hundraårsperioden 1300–1399. För decenniet 1300–1309, se 1300-talet (decennium). .mw-parser-output .infobox{border:1px solid #aaa;background-color:#f9f9f9;color:black;margin:.5em 0 .5em 1em;padding:.2em;float:right;clear:right;width:22em;text-align:left;font-size:88%;line-height:1.6em}.mw-parser-output .infobox td,.mw-parser-output .infobox th{vertical-align:top;padding:0 .2em}.mw-parser-output .infobox caption{font-size:larger}.mw-parser-output .infobox.bordered{border-collapse:collapse}.mw-parser-output .infobox.bordered td,.mw-parser-output .infobox.bordered th{border:1px solid #aaa}.mw-parser-output .infobox.bordered .borderless td,.mw-parser-output .infobox.bordered .borderless th{border:0}.mw-parser-output .infobox-showbutton .mw-collapsible-text{color:inherit}.mw-parser-output .infobox.bordered .mergedtoprow td,.mw-parser-output .infobox.bordered .mergedtoprow th{border:0;border-top:1px solid #aaa;border-right:1px solid #aaa}.mw-parser-output ...
          Read more

          1300-talet

          Image
          Den här artikeln handlar om hundraårsperioden 1300–1399. För decenniet 1300–1309, se 1300-talet (decennium). .mw-parser-output .infobox{border:1px solid #aaa;background-color:#f9f9f9;color:black;margin:.5em 0 .5em 1em;padding:.2em;float:right;clear:right;width:22em;text-align:left;font-size:88%;line-height:1.6em}.mw-parser-output .infobox td,.mw-parser-output .infobox th{vertical-align:top;padding:0 .2em}.mw-parser-output .infobox caption{font-size:larger}.mw-parser-output .infobox.bordered{border-collapse:collapse}.mw-parser-output .infobox.bordered td,.mw-parser-output .infobox.bordered th{border:1px solid #aaa}.mw-parser-output .infobox.bordered .borderless td,.mw-parser-output .infobox.bordered .borderless th{border:0}.mw-parser-output .infobox-showbutton .mw-collapsible-text{color:inherit}.mw-parser-output .infobox.bordered .mergedtoprow td,.mw-parser-output .infobox.bordered .mergedtoprow th{border:0;border-top:1px solid #aaa;border-right:1px solid #aaa}.mw-parser-output ...
          Read more

          Display a custom attribute below product name in the front-end Magento 1.9.3.8

          Image
          0 I need to display a custom attribute bellow the product name and I don't know how can I call this attribute. I am editing the file /app/design/frontend/templatemela/MAG100219_1/template/catalog/product/view.phtml But how can I call this attribute in php? I tried calling a string echo with the name I put in the attribute, but it didn't work. Code is as below: <div class="page-title product-title"> <h1><?php echo $_helper->productAttribute($_product, $_product->getName(), 'name') ?></h1> </div> <div class="codigoinmetro"> <h2><?php echo $_helper->productAttribute($_product, $_product->getName(), 'registroinmetro') ?></h2> </div> php attrib...
          Read more