fork download 
  1. #!/usr/bin/perl
  2. use feature qw{say current_sub};
  3.  
  4. sub permutation {
  5.   sub {
  6.     my ($le, $pv, @ri) = @_;
  7.     defined $pv ? map {[$pv, @$_]} __SUB__->([], @$le, @ri) : ([])
  8.       , @ri ? __SUB__->([@$le, $pv], @ri) : ()
  9.     }->([], @_);
  10. }
  11. @vttab = permutation(0..3);
  12. push @{$vttab[$_]}, @{$vttab[$_]}[0,1] for 0..$#vttab; # ring overlap
  13.  
  14. sub norm2d {
  15.   my ($x, $y) = @_;
  16.   sqrt($x**2 + $y**2);
  17. }
  18.  
  19. use Math::Trig qw{asin asin_real rad2deg};
  20. sub sigangvv { # Signed angle between two vectors
  21.     my ($x1, $y1, $x2, $y2) = @_;
  22.     sub normalize2d {
  23.       my ($x, $y) = @_;
  24.       $norm = norm2d($x, $y);
  25.       ($x / $norm, $y / $norm);
  26.     }
  27.     sub vprod2d {
  28.       my ($x1, $y1, $x2, $y2) = @_;
  29.       ($x1 * $y2) - ($y1 * $x2);
  30.     }
  31.     $vprod = vprod2d(normalize2d($x1, $y1), normalize2d($x2, $y2));
  32.     $sigang = rad2deg(asin_real($vprod)); # -90..0..+90
  33. }
  34.  
  35. use constant EPS => 0.0001;
  36.  
  37. for (<DATA>) {
  38.   chomp;
  39.   my @xys = eval "($_)";
  40.  
  41.   for $vtlst (@vttab) {
  42.     my @angles = ();
  43.     for $ie (0..3) {
  44.       my ($v1, $v2, $v3) = @{$vtlst}[$ie, $ie+1, $ie+2];
  45.       my $x1 = $xys[$v2][0] - $xys[$v1][0];
  46.       my $y1 = $xys[$v2][1] - $xys[$v1][1];
  47.       my $x2 = $xys[$v3][0] - $xys[$v2][0];
  48.       my $y2 = $xys[$v3][1] - $xys[$v2][1];
  49.       if (norm2d($x1, $y1) < EPS) {
  50. 	#warn "skip too short vector(1): $v2 - $v1 => ($x1, $y1)\n";
  51. 	next;
  52.       }
  53.       if (norm2d($x2, $y2) < EPS) {
  54. 	#warn "skip too short vector(2): $v3 - $v2 => ($x2, $y2)\n";
  55. 	next;
  56.       }
  57.       my $sigang = sigangvv($x1, $y1, $x2, $y2);
  58.       if (abs($sigang) < EPS) {
  59. 	#warn "skip too thin angle: ($x1, $y1)..($x2, $y2)\n";
  60. 	next;
  61.       }
  62.       push @angles, $sigang;
  63.     }
  64.     use List::Util 'sum';
  65.     my $angsum = sum @angles;
  66.     if (abs(abs($angsum) - 360.0) < EPS) {
  67.       say "$_ : true";
  68.       goto L1;
  69.     }
  70.   }
  71.   say "$_ : false";
  72.  L1:;
  73. }
  74. __DATA__
  75. [0, 0], [1, 0], [1, 1], [0, 1]
  76. [0, 0], [1, 1], [1, 0], [0, 1]
  77. [0, 0], [2, 0], [1, 1], [0, 2]
  78. [0, 0], [1, 1], [2, 2], [3, 3]
  79. [0, 0], [0, 0], [0, 0], [0, 0]
Success #stdin #stdout 0.04s 7244KB
comments (?)
stdin 
Standard input is empty
stdout 
[0, 0], [1, 0], [1, 1], [0, 1] : true
[0, 0], [1, 1], [1, 0], [0, 1] : true
[0, 0], [2, 0], [1, 1], [0, 2] : false
[0, 0], [1, 1], [2, 2], [3, 3] : false
[0, 0], [0, 0], [0, 0], [0, 0] : false
https://ideone.com/2NE6z1
language:
Perl (perl 5.28.1)
created:
6 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!