aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorE7-87-83 <fungcheokyin@gmail.com>2021-08-01 04:42:40 +0800
committerE7-87-83 <fungcheokyin@gmail.com>2021-08-01 04:42:40 +0800
commit1e078f86d0f29d2c090bada2035a55afdbe05b77 (patch)
treeae514978a3895e341090af06d1be8829724ead73
parent85df61729cc854d57e1eb7e5f653a0a95fbacc31 (diff)
downloadperlweeklychallenge-club-1e078f86d0f29d2c090bada2035a55afdbe05b77.tar.gz
perlweeklychallenge-club-1e078f86d0f29d2c090bada2035a55afdbe05b77.tar.bz2
perlweeklychallenge-club-1e078f86d0f29d2c090bada2035a55afdbe05b77.zip
finalized
-rw-r--r--challenge-123/cheok-yin-fung/blog.txt1
-rw-r--r--challenge-123/cheok-yin-fung/perl/ch-2-cube-hypercube.pl (renamed from challenge-123/cheok-yin-fung/perl/ch-2x.pl)37
-rw-r--r--challenge-123/cheok-yin-fung/perl/ch-2.pl31
-rw-r--r--challenge-123/cheok-yin-fung/perl/ch-2a.pl312
-rw-r--r--challenge-123/cheok-yin-fung/perl/ch-2ax.pl323
5 files changed, 21 insertions, 683 deletions
diff --git a/challenge-123/cheok-yin-fung/blog.txt b/challenge-123/cheok-yin-fung/blog.txt
new file mode 100644
index 0000000000..10c25304a6
--- /dev/null
+++ b/challenge-123/cheok-yin-fung/blog.txt
@@ -0,0 +1 @@
+https://e7-87-83.github.io/coding/challenge_123.html
diff --git a/challenge-123/cheok-yin-fung/perl/ch-2x.pl b/challenge-123/cheok-yin-fung/perl/ch-2-cube-hypercube.pl
index 968afdfad9..a70526e819 100644
--- a/challenge-123/cheok-yin-fung/perl/ch-2x.pl
+++ b/challenge-123/cheok-yin-fung/perl/ch-2-cube-hypercube.pl
@@ -16,7 +16,7 @@ use Algorithm::Combinatorics qw(permutations); #use for hypercube
my $k = $ARGV[0] || 3;
my $D = $ARGV[1] || $k;
-die "Usage: ch-2x.pl [2, 3 or 4] (optional)[dimension of space] "
+die "Usage: ch-2-xxxxxxxxxx.pl [2, 3 or 4] (optional)[dimension of space] "
if $k > 4 or $k <= 1;
die "How can I put a $k-polytope into $D-dim space? \n" if $k > $D;
@@ -51,30 +51,15 @@ sub is_cube {
my $NW = vec_sum($N, $W);
my $WU = vec_sum($W, $U);
my $UN = vec_sum($U, $N);
+ my $iter_face = permutations([$NW, $WU, $UN]);
my $bool = undef;
- if (vec_same_f($NW, $v{$ind[3]})) {
- if ( vec_same_f($WU, $v{$ind[4]})
- && vec_same_f($UN, $v{$ind[5]}) ) { $bool = 1;
- } elsif ( vec_same_f($WU, $v{$ind[5]})
- && vec_same_f($UN, $v{$ind[4]}) ) { $bool = 1;
- }
- }
- if (!$bool && vec_same_f($NW, $v{$ind[4]})) {
- if ( vec_same_f($WU, $v{$ind[3]})
- && vec_same_f($UN, $v{$ind[5]}) ) { $bool = 1;
- } elsif ( vec_same_f($WU, $v{$ind[5]})
- && vec_same_f($UN, $v{$ind[3]}) ) { $bool = 1;
- }
- }
- if (!$bool && vec_same_f($NW, $v{$ind[5]})) {
- if ( vec_same_f($WU, $v{$ind[4]})
- && vec_same_f($UN, $v{$ind[3]}) ) { $bool = 1;
- } elsif ( vec_same_f($WU, $v{$ind[3]})
- && vec_same_f($UN, $v{$ind[4]}) ) { $bool = 1;
- } else {
- return 0;
- }
+ while (!$bool && (my $p = $iter_face->next)) {
+ $bool =
+ vec_same_f($v{$ind[3]}, $p->[0]) &&
+ vec_same_f($v{$ind[4]}, $p->[1]) &&
+ vec_same_f($v{$ind[5]}, $p->[2]) ;
}
+
return 0 if !$bool;
my $NWU = vec_sum( $N, $WU);
@@ -185,7 +170,7 @@ sub vec_sum {
sub vec_same {
my $first = $_[0];
my $second = $_[1];
- warn "Not the same dimension in vec_same_f \n" if $first->$#* != $second->$#*;
+ warn "Not the same dimension in vec_same\n" if $first->$#* != $second->$#*;
for my $s (0..$first->$#*) {
return undef if $first->[$s] != $second->[$s];
}
@@ -195,7 +180,7 @@ sub vec_same {
sub vec_same_f {
my $first = $_[0];
my $second = $_[1];
- warn "Not the same dimension in vec_same_f \n" if $first->$#* != $second->$#*;
+ warn "Not the same dimension in vec_same_f\n" if $first->$#* != $second->$#*;
for my $s (0..$first->$#*) {
return undef if sprintf("%f",$first->[$s]) != sprintf("%f",$second->[$s]);
}
@@ -271,7 +256,7 @@ ok is_square(
== 1,
"arctan(1/5) by atan2() of a much smaller size"
."(multiple by 0.0009), caught by the equalities"
- ."(_\"not ok\" is normal_)";
+ ."(_\"not ok\" is not rare_)";
ok is_square( [1, 2] , [4,3], [3,1], [2,4] ) == 1, "Knight's square";
ok is_square( [1, 1] , [-1, 1], [1,-1], [-1,-1] ) == 1, "centre at origin";
diff --git a/challenge-123/cheok-yin-fung/perl/ch-2.pl b/challenge-123/cheok-yin-fung/perl/ch-2.pl
index 7421f86fc7..c39cba05e1 100644
--- a/challenge-123/cheok-yin-fung/perl/ch-2.pl
+++ b/challenge-123/cheok-yin-fung/perl/ch-2.pl
@@ -12,6 +12,9 @@ use Test::More tests => 13;
my $D = $ARGV[0] || 2;
+say "Input coordinates of 4 points in $D dimensional space:";
+say "a point per line.";
+
my $pt0 = [split " ", <STDIN>];
my $pt1 = [split " ", <STDIN>];
my $pt2 = [split " ", <STDIN>];
@@ -42,7 +45,10 @@ sub is_square {
# times the edge length would not be a necessary check
# if we preserve the dot product test, because in
# Euclidean space, if two vectors are orthogonal and in equal length,
-# we can apply the Pythagorean theorem.
+# we can apply the Pythagorean theorem for the norm of the vector sum.
+# For DEMOSTRATION PURPOSE,
+# the test of orthogonality (the dot product test) is commented out by brace,
+# but the dot product test will be used both for cube and hypercube.
) {
return 1;
}
@@ -69,27 +75,6 @@ sub norm {
return $sum;
}
-sub vec_sum {
- my $first = $_[0];
- my $second = $_[1];
- my $ans = [];
- warn "Not the same dimension in vec_sum \n" if $first->$#* != $second->$#*;
- for my $s (0..$first->$#*) {
- push $ans->@*, $first->[$s] + $second->[$s];
- }
- return $ans;
-}
-
-sub vec_same {
- my $first = $_[0];
- my $second = $_[1];
- warn "Not the same dimension in vec_same \n" if $first->$#* != $second->$#*;
- for my $s (0..$first->$#*) {
- return 0 if $first->[$s] != $second->[$s];
- }
- return 1;
-}
-
sub vec_subtract {
my $first = $_[0];
my $second = $_[1];
@@ -106,6 +91,8 @@ ok is_square( [10,20], [20,20], [20, 10], [10, 10] ) == 1, "Example 1";
ok is_square( [12,24], [16,10], [20, 12], [18, 16] ) == 0, "Example 2";
ok is_square( [1, 2] , [4,3], [3,1], [2,4] ) == 1, "Knight's square";
ok is_square( [1, 1] , [-1, 1], [ 1,-1], [-1,-1] ) == 1, "centre at origin";
+
+# =========== test cases with irrational numbers ==============
ok is_square( [1, sqrt(3)/2, -1/2], [1, -sqrt(3)/2, 1/2],
[-1, sqrt(3)/2, -1/2], [-1, -sqrt(3)/2, 1/2] ) == 1,
"centre at origin, inclined";
diff --git a/challenge-123/cheok-yin-fung/perl/ch-2a.pl b/challenge-123/cheok-yin-fung/perl/ch-2a.pl
deleted file mode 100644
index e257c351dd..0000000000
--- a/challenge-123/cheok-yin-fung/perl/ch-2a.pl
+++ /dev/null
@@ -1,312 +0,0 @@
-#!/usr/bin/perl
-# The Weekly Challenge 123
-# Task 2 extension: Square/Cube/Hypercube Points
-# Usage: $ ch-2a.pl (optional) $k (optional)$D
-# $k: 2 or 3 or 4, stands for square or cube or hypercube, default is 3
-# $D: 2 or above, cannot be smaller than $k, default is same as $k
-
-# Note: check out $ diff ch-2a.pl ch-2ax.pl
-# ALSO: ch-2x.pl is the best implementation.
-
-use strict;
-use warnings;
-use v5.10.0;
-use Test::More tests => 14;
-
-use Algorithm::Combinatorics qw(permutations); #use for hypercube
-
-
-my $k = $ARGV[0] || 3;
-my $D = $ARGV[1] || $k;
-
-die "Usage: ch-2a.pl [2, 3 or 4] (optional)[dimension of space] "
- if $k > 4 or $k <= 1;
-die "How can I put a $k-polytope into $D-dim space? \n" if $k > $D;
-
-
-sub is_square {
- my ($p0,$p1,$p2,$p3) = @_;
- my $v0 = vec_subtract($p0, $p1);
- my $v1 = vec_subtract($p0, $p2);
- my $v2 = vec_subtract($p0, $p3);
- return 0 unless (vec_prod_f($v1, $v2) == 0) xor
- (vec_prod_f($v0, $v2) == 0) xor
- (vec_prod_f($v0, $v1) == 0);
-#========== BEGIN: diff of ch-2a.pl and ch-2ax.pl =========
- return 0 unless vec_same($v0, vec_sum($v1, $v2) ) xor
- vec_same($v1, vec_sum($v2, $v0) ) xor
- vec_same($v2, vec_sum($v0, $v1) );
-#=========== END: diff of ch-2a.pl and ch-2ax.pl ==========
-# COMMENT:
-# this test is mathematically NOT necessary,
-# and if you check it against ch-2ax.pl,
-# you will find this section is the source of failed tests!
- my @n_vector = map { norm_f($_) } ($v0, $v1, $v2);
- @n_vector = sort {$a<=>$b} @n_vector;
- if ( $n_vector[0] == $n_vector[1] ) {
- return 1;
- }
- else {
- return 0;
- }
-}
-
-sub is_cube {
- my @p = @_;
- my %v;
- $v{$_} = vec_subtract($p[0], $p[$_]) for (1..7);
- my @ind = sort { norm_f($v{$a}) <=> norm_f($v{$b}) } keys %v;
- my ($N, $W, $U) = ($v{$ind[0]} , $v{$ind[1]} , $v{$ind[2]}) ;
- return 0 unless norm_f($N) == norm_f($W) && norm_f($N) == norm_f($U);
- return 0 unless vec_prod_f($N,$W) == 0 && vec_prod_f($W,$U) == 0
- && vec_prod_f($U,$N) == 0;
- my $NW = vec_sum($N, $W);
- my $WU = vec_sum($W, $U);
- my $UN = vec_sum($U, $N);
- my $bool = undef;
- if (vec_same($NW, $v{$ind[3]})) {
- if ( vec_same($WU, $v{$ind[4]})
- && vec_same($UN, $v{$ind[5]}) ) { $bool = 1;
- } elsif ( vec_same($WU, $v{$ind[5]})
- && vec_same($UN, $v{$ind[4]}) ) { $bool = 1;
- }
- }
- if (!$bool && vec_same($NW, $v{$ind[4]})) {
- if ( vec_same($WU, $v{$ind[3]})
- && vec_same($UN, $v{$ind[5]}) ) { $bool = 1;
- } elsif ( vec_same($WU, $v{$ind[5]})
- && vec_same($UN, $v{$ind[3]}) ) { $bool = 1;
- }
- }
- if (!$bool && vec_same($NW, $v{$ind[5]})) {
- if ( vec_same($WU, $v{$ind[4]})
- && vec_same($UN, $v{$ind[3]}) ) { $bool = 1;
- } elsif ( vec_same($WU, $v{$ind[3]})
- && vec_same($UN, $v{$ind[4]}) ) { $bool = 1;
- } else {
- return 0;
- }
- }
- return 0 if !$bool;
-
- my $NWU = vec_sum( $N, $WU);
- if ( vec_same( $v{$ind[6]} , $NWU ) ) {
- return 1;
- }
- else {
- return 0;
- }
-}
-
-sub is_hypercube {
- my @p = @_;
- my %v;
- $v{$_} = vec_subtract($p[0], $p[$_]) for (1..15);
- my @ind = sort { norm_f($v{$a}) <=> norm_f($v{$b}) } keys %v;
- my ($N, $W, $U, $A) = ( $v{$ind[0]}, $v{$ind[1]} ,
- $v{$ind[2]}, $v{$ind[3]} );
- return 0 unless
- norm_f($N) == norm_f($W) && norm_f($W) == norm_f($U)
- && norm_f($U) == norm_f($A);
- return 0 unless
- vec_prod_f($N, $W) == 0 &&
- vec_prod_f($N, $U) == 0 &&
- vec_prod_f($N, $A) == 0 &&
- vec_prod_f($A, $W) == 0 &&
- vec_prod_f($A, $U) == 0 &&
- vec_prod_f($W, $U) == 0 ;
-
- my $AU = vec_sum($A, $U);
- my $AW = vec_sum($A, $W);
- my $AN = vec_sum($A, $N);
- my $NW = vec_sum($N, $W);
- my $WU = vec_sum($W, $U);
- my $UN = vec_sum($U, $N);
- my $bool_face = undef;
- my $iter_face = permutations([$AU, $UN, $NW, $WU, $AW, $AN]);
- while (!$bool_face && (my $p = $iter_face->next)) {
- $bool_face =
- vec_same($v{$ind[4]}, $p->[0]) &&
- vec_same($v{$ind[5]}, $p->[1]) &&
- vec_same($v{$ind[6]}, $p->[2]) &&
- vec_same($v{$ind[7]}, $p->[3]) &&
- vec_same($v{$ind[8]}, $p->[4]) &&
- vec_same($v{$ind[9]}, $p->[5]) ;
- }
- return 0 if !$bool_face;
-
- my $UNW = vec_sum($UN, $W);
- my $ANW = vec_sum($NW, $A);
- my $AWU = vec_sum($WU, $A);
- my $AUN = vec_sum($UN, $A);
- my $bool_cube = undef;
- my $iter_cube = permutations([$UNW, $ANW, $AWU, $AUN]);
- while (!$bool_cube && (my $p = $iter_cube->next)) {
- $bool_cube =
- vec_same($v{$ind[10]}, $p->[0]) &&
- vec_same($v{$ind[11]}, $p->[1]) &&
- vec_same($v{$ind[12]}, $p->[2]) &&
- vec_same($v{$ind[13]}, $p->[3]);
- }
- return 0 if !$bool_cube;
-
- my $AUNW = vec_sum($AU,$NW);
- if ( vec_same($v{$ind[14]}, $AUNW) ) {
- return 1;
- }
- else {
- return 0;
- }
-}
-
-sub vec_prod {
- my $first = $_[0];
- my $second = $_[1];
- warn "Not the same dimension in vec_prod \n" if $first->$#* != $second->$#*;
- my $sum = 0;
- $sum+= ($first->[$_]*$second->[$_]) for (0..$first->$#*);
- return $sum;
-}
-
-sub vec_prod_f {
- return sprintf("%f", vec_prod($_[0], $_[1]));
-}
-
-sub norm {
- my $p = $_[0];
- my $sum = 0;
- $sum+= ($p->[$_])**2 for (0..$p->$#*);
- return $sum;
-}
-
-sub norm_f {
- return sprintf("%f", norm($_[0]));
-}
-
-sub vec_sum {
- my $first = $_[0];
- my $second = $_[1];
- my $ans = [];
- warn "Not the same dimension in vec_sum \n" if $first->$#* != $second->$#*;
- for my $s (0..$first->$#*) {
- push $ans->@*, $first->[$s] + $second->[$s];
- }
- return $ans;
-}
-
-sub vec_same {
- my $first = $_[0];
- my $second = $_[1];
- warn "Not the same dimension in vec_same \n" if $first->$#* != $second->$#*;
- for my $s (0..$first->$#*) {
- return undef if $first->[$s] != $second->[$s];
- }
- return 1;
-}
-
-sub vec_subtract {
- my $first = $_[0];
- my $second = $_[1];
- my $ans = [];
- warn "Not the same dimension in vec_subtract\n" if $first->$#* != $second->$#*;
- for my $s (0..$first->$#*) {
- push $ans->@*, $second->[$s] - $first->[$s];
- }
- return $ans;
-}
-
-
-
-# 9 tests
-ok is_square( [1,0], [0,1], [-1,0],[0,-1]) == 1, "on x-axis and y-axis";
-
-ok is_square( [5/sqrt(26), 1/sqrt(26)],
- [-1/sqrt(26), 5/sqrt(26)],
- [-5/sqrt(26), -1/sqrt(26)],
- [1/sqrt(26), -5/sqrt(26)]) == 1,
- "inclined by arctan(1/5), centre at origin";
-
-ok is_square(
- [cos(atan2(1,5)), sin(atan2(1,5))],
- [-sin(atan2(1,5)), cos(atan2(1,5))],
- [-cos(atan2(1,5)), -sin(atan2(1,5))],
- [sin(atan2(1,5)), -cos(atan2(1,5))]
- )
- == 1, "arctan(1/5) by atan2(), caught by the equalities";
-
-ok is_square(
- [2.7*cos(atan2(1,5)), 2.7*sin(atan2(1,5))],
- [-2.7*sin(atan2(1,5)), 2.7*cos(atan2(1,5))],
- [-2.7*cos(atan2(1,5)), -2.7*sin(atan2(1,5))],
- [2.7*sin(atan2(1,5)), -2.7*cos(atan2(1,5))]
- )
- == 1,
- "arctan(1/5) by atan2() of larger size (multipled by 2.7),"
- ."caught by the equalities";
-
-ok is_square(
- [2.8*cos(atan2(1,5)), 2.8*sin(atan2(1,5))],
- [-2.8*sin(atan2(1,5)), 2.8*cos(atan2(1,5))],
- [-2.8*cos(atan2(1,5)), -2.8*sin(atan2(1,5))],
- [2.8*sin(atan2(1,5)), -2.8*cos(atan2(1,5))]
- )
- == 1,
- "arctan(1/5) by atan2() of larger size (multipled by 2.8),"
- ."caught by the equalities";
-
-ok is_square(
- [4.0*cos(atan2(1,5)), 4.0*sin(atan2(1,5))],
- [-4.0*sin(atan2(1,5)), 4.0*cos(atan2(1,5))],
- [-4.0*cos(atan2(1,5)), -4.0*sin(atan2(1,5))],
- [4.0*sin(atan2(1,5)), -4.0*cos(atan2(1,5))]
- )
- == 1,
- "arctan(1/5) by atan2() of larger size (multipled by 4.0),"
- ." caught by the equalities";
-
-ok is_square(
- [0.0009*cos(atan2(1,5)), 0.0009*sin(atan2(1,5))],
- [-0.0009*sin(atan2(1,5)), 0.0009*cos(atan2(1,5))],
- [-0.0009*cos(atan2(1,5)), -0.0009*sin(atan2(1,5))],
- [0.0009*sin(atan2(1,5)), -0.0009*cos(atan2(1,5))]
- )
- == 1,
- "arctan(1/5) by atan2() of a much smaller size"
- ."(multiple by 0.0009), caught by the equalities"
- ."(_\"not ok\" is normal_)";
-
-ok is_square( [1, 2] , [4,3], [3,1], [2,4] ) == 1, "Knight's square";
-ok is_square( [1, 1] , [-1, 1], [1,-1], [-1,-1] ) == 1, "centre at origin";
-
-# 4 tests
-ok is_cube( [1, 1, 1], [1, 1, 0], [1, 0, 1], [1, 0, 0],
- [0, 1, 1], [0, 1, 0], [0, 0, 1], [0, 0, 0] ) == 1,
- "standard 2**3";
-ok is_cube([ -2, -2, -2], [ -2, -2, 2], [ -2, 2, -2], [ -2, 2, 2],
- [ 2, -2, -2], [ 2, -2, 2], [ 2, 2, -2], [ 2, 2, 2]) == 1,
- "centre at origin";
-ok is_cube(
- [-2, -2*sqrt(3), 3-2*sqrt(3)] ,
- [-2, 4-2*sqrt(3), 3+2*sqrt(3)],
- [-2, 2*sqrt(3), -2*sqrt(3)-1 ],
- [-2, 4+2*sqrt(3), -1+2*sqrt(3) ],
- [ 6, -2*sqrt(3), 3-2*sqrt(3)],
- [ 6, 4-2*sqrt(3), 3+2*sqrt(3)],
- [ 6, 2*sqrt(3), -2*sqrt(3)-1],
- [ 6, 4+2*sqrt(3), -1+2*sqrt(3)]
- )
- == 1, "a rotated cube centred at (2,2,1)";
-ok is_cube([ 2, 2, 2], [ 2, 3, 2], [ 2, 2, 3], [ 2, 4, 2],
- [ 3, 3, 2], [ 2, 2, 1], [ 2, 3, 2], [ 2, 7, 3]) == 0,
- "this is not a cube";
-
-# 1 test
-ok is_hypercube(
- [0,0,0,0],[0,0,0,1],[0,0,1,0],
- [0,0,1,1],[0,1,0,0],[0,1,0,1],
- [0,1,1,0],[0,1,1,1],[1,0,0,0],
- [1,0,0,1],[1,0,1,0],[1,0,1,1],
- [1,1,0,0],[1,1,0,1],[1,1,1,0],
- [1,1,1,1]
- ) == 1, "hypercube";
-done_testing();
diff --git a/challenge-123/cheok-yin-fung/perl/ch-2ax.pl b/challenge-123/cheok-yin-fung/perl/ch-2ax.pl
deleted file mode 100644
index 5aab9c492c..0000000000
--- a/challenge-123/cheok-yin-fung/perl/ch-2ax.pl
+++ /dev/null
@@ -1,323 +0,0 @@
-#!/usr/bin/perl
-# The Weekly Challenge 123
-# Task 2 extension: Square/Cube/Hypercube Points
-# Usage: ch-2ax.pl (optional) $k (optional)$D
-# $k: 2 or 3 or 4, stands for square or cube or hypercube, default is 3
-# $D: 2 or above, cannot be smaller than $k, default is same as $k
-
-# Note: check out $ diff ch-2a.pl ch-2ax.pl
-# ALSO: ch-2x.pl is the best implementation.
-use strict;
-use warnings;
-use v5.10.0;
-use Test::More tests => 14;
-
-use Algorithm::Combinatorics qw(permutations); #use for hypercube
-
-
-my $k = $ARGV[0] || 3;
-my $D = $ARGV[1] || $k;
-
-die "Usage: ch-2ax.pl [2, 3 or 4] (optional)[dimension of space] "
- if $k > 4 or $k <= 1;
-die "How can I put a $k-polytope into $D-dim space? \n" if $k > $D;
-
-
-sub is_square {
- my ($p0,$p1,$p2,$p3) = @_;
- my $v0 = vec_subtract($p0, $p1);
- my $v1 = vec_subtract($p0, $p2);
- my $v2 = vec_subtract($p0, $p3);
- return 0 unless (vec_prod_f($v1, $v2) == 0) xor
- (vec_prod_f($v0, $v2) == 0) xor
- (vec_prod_f($v0, $v1) == 0);
- my @n_vector = map { norm_f($_) } ($v0, $v1, $v2);
- @n_vector = sort {$a<=>$b} @n_vector;
- if ( $n_vector[0] == $n_vector[1] ) {
- return 1;
- }
- else {
- return 0;
- }
-}
-
-sub is_cube {
- my @p = @_;
- my %v;
- $v{$_} = vec_subtract($p[0], $p[$_]) for (1..7);
- my @ind = sort { norm_f($v{$a}) <=> norm_f($v{$b}) } keys %v;
- my ($N, $W, $U) = ($v{$ind[0]} , $v{$ind[1]} , $v{$ind[2]}) ;
- return 0 unless norm_f($N) == norm_f($W) && norm_f($N) == norm_f($U);
- return 0 unless vec_prod_f($N,$W) == 0 && vec_prod_f($W,$U) == 0
- && vec_prod_f($U,$N) == 0;
- my $NW = vec_sum($N, $W);
- my $WU = vec_sum($W, $U);
- my $UN = vec_sum($U, $N);
- my $bool = undef;
- if (vec_same($NW, $v{$ind[3]})) {
- if ( vec_same($WU, $v{$ind[4]})
- && vec_same($UN, $v{$ind[5]}) ) { $bool = 1;
- } elsif ( vec_same($WU, $v{$ind[5]})
- && vec_same($UN, $v{$ind[4]}) ) { $bool = 1;
- }
- }
- if (!$bool && vec_same($NW, $v{$ind[4]})) {
- if ( vec_same($WU, $v{$ind[3]})
- && vec_same($UN, $v{$ind[5]}) ) { $bool = 1;
- } elsif ( vec_same($WU, $v{$ind[5]})
- && vec_same($UN, $v{$ind[3]}) ) { $bool = 1;
- }
- }
- if (!$bool && vec_same($NW, $v{$ind[5]})) {
- if ( vec_same($WU, $v{$ind[4]})
- && vec_same($UN, $v{$ind[3]}) ) { $bool = 1;
- } elsif ( vec_same($WU, $v{$ind[3]})
- && vec_same($UN, $v{$ind[4]}) ) { $bool = 1;
- } else {
- return 0;
- }
- }
- return 0 if !$bool;
-
- my $NWU = vec_sum( $N, $WU);
- if ( vec_same( $v{$ind[6]} , $NWU ) ) {
-=pod
- return 0 unless
- 2*norm_f($N) == norm_f($NW) &&
- norm_f($NW) == norm_f($WU) &&
- norm_f($WU) == norm_f($UN) &&
- 3*norm_f($N) == norm_f($NWU);
-=cut
- return 1;
- }
- else {
- return 0;
- }
-}
-
-sub is_hypercube {
- my @p = @_;
- my %v;
- $v{$_} = vec_subtract($p[0], $p[$_]) for (1..15);
- my @ind = sort { norm_f($v{$a}) <=> norm_f($v{$b}) } keys %v;
- my ($N, $W, $U, $A) = ( $v{$ind[0]}, $v{$ind[1]} ,
- $v{$ind[2]}, $v{$ind[3]} );
- return 0 unless
- norm_f($N) == norm_f($W) && norm_f($W) == norm_f($U)
- && norm_f($U) == norm_f($A);
- return 0 unless
- vec_prod_f($N, $W) == 0 &&
- vec_prod_f($N, $U) == 0 &&
- vec_prod_f($N, $A) == 0 &&
- vec_prod_f($A, $W) == 0 &&
- vec_prod_f($A, $U) == 0 &&
- vec_prod_f($W, $U) == 0 ;
-
- my $AU = vec_sum($A, $U);
- my $AW = vec_sum($A, $W);
- my $AN = vec_sum($A, $N);
- my $NW = vec_sum($N, $W);
- my $WU = vec_sum($W, $U);
- my $UN = vec_sum($U, $N);
- my $bool_face = undef;
- my $iter_face = permutations([$AU, $UN, $NW, $WU, $AW, $AN]);
- while (!$bool_face && (my $p = $iter_face->next)) {
- $bool_face =
- vec_same($v{$ind[4]}, $p->[0]) &&
- vec_same($v{$ind[5]}, $p->[1]) &&
- vec_same($v{$ind[6]}, $p->[2]) &&
- vec_same($v{$ind[7]}, $p->[3]) &&
- vec_same($v{$ind[8]}, $p->[4]) &&
- vec_same($v{$ind[9]}, $p->[5]) ;
- }
- return 0 if !$bool_face;
-
- my $UNW = vec_sum($UN, $W);
- my $ANW = vec_sum($NW, $A);
- my $AWU = vec_sum($WU, $A);
- my $AUN = vec_sum($UN, $A);
- my $bool_cube = undef;
- my $iter_cube = permutations([$UNW, $ANW, $AWU, $AUN]);
- while (!$bool_cube && (my $p = $iter_cube->next)) {
- $bool_cube =
- vec_same($v{$ind[10]}, $p->[0]) &&
- vec_same($v{$ind[11]}, $p->[1]) &&
- vec_same($v{$ind[12]}, $p->[2]) &&
- vec_same($v{$ind[13]}, $p->[3]);
- }
- return 0 if !$bool_cube;
-
- my $AUNW = vec_sum($AU,$NW);
- if ( vec_same($v{$ind[14]}, $AUNW) ) {
-=pod
- return 0 unless
- 2*norm_f($N) == norm_f($NW) &&
- norm_f($NW) == norm_f($AU) &&
- norm_f($NW) == norm_f($UN) &&
- norm_f($NW) == norm_f($WU) &&
- norm_f($NW) == norm_f($AW) &&
- norm_f($NW) == norm_f($AN) &&
- 3*norm_f($N) == norm_f($UNW) &&
- 3*norm_f($N) == norm_f($ANW) &&
- 3*norm_f($N) == norm_f($AWU) &&
- 3*norm_f($N) == norm_f($AUN) &&
- 4*norm_f($N) == norm_f($AUNW);
-=cut
- return 1;
- }
- else {
- return 0;
- }
-}
-
-sub vec_prod {
- my $first = $_[0];
- my $second = $_[1];
- warn "Not the same dimension in vec_prod \n" if $first->$#* != $second->$#*;
- my $sum = 0;
- $sum+= ($first->[$_]*$second->[$_]) for (0..$first->$#*);
- return $sum;
-}
-
-sub vec_prod_f {
- return sprintf("%f", vec_prod($_[0], $_[1]));
-}
-
-sub norm {
- my $p = $_[0];
- my $sum = 0;
- $sum+= ($p->[$_])**2 for (0..$p->$#*);
- return $sum;
-}
-
-sub norm_f {
- return sprintf("%f", norm($_[0]));
-}
-
-sub vec_sum {
- my $first = $_[0];
- my $second = $_[1];
- my $ans = [];
- warn "Not the same dimension in vec_sum \n" if $first->$#* != $second->$#*;
- for my $s (0..$first->$#*) {
- push $ans->@*, $first->[$s] + $second->[$s];
- }
- return $ans;
-}
-
-sub vec_same {
- my $first = $_[0];
- my $second = $_[1];
- warn "Not the same dimension in vec_same \n" if $first->$#* != $second->$#*;
- for my $s (0..$first->$#*) {
- return undef if $first->[$s] != $second->[$s];
- }
- return 1;
-}
-
-sub vec_subtract {
- my $first = $_[0];
- my $second = $_[1];
- my $ans = [];
- warn "Not the same dimension in vec_subtract\n" if $first->$#* != $second->$#*;
- for my $s (0..$first->$#*) {
- push $ans->@*, $second->[$s] - $first->[$s];
- }
- return $ans;
-}
-
-
-
-# 9 tests
-ok is_square( [1,0], [0,1], [-1,0],[0,-1]) == 1, "on x-axis and y-axis";
-
-ok is_square( [5/sqrt(26), 1/sqrt(26)],
- [-1/sqrt(26), 5/sqrt(26)],
- [-5/sqrt(26), -1/sqrt(26)],
- [1/sqrt(26), -5/sqrt(26)]) == 1,
- "inclined by arctan(1/5), centre at origin";
-
-ok is_square(
- [cos(atan2(1,5)), sin(atan2(1,5))],
- [-sin(atan2(1,5)), cos(atan2(1,5))],
- [-cos(atan2(1,5)), -sin(atan2(1,5))],
- [sin(atan2(1,5)), -cos(atan2(1,5))]
- )
- == 1, "arctan(1/5) by atan2(), caught by the equalities";
-
-ok is_square(
- [2.7*cos(atan2(1,5)), 2.7*sin(atan2(1,5))],
- [-2.7*sin(atan2(1,5)), 2.7*cos(atan2(1,5))],
- [-2.7*cos(atan2(1,5)), -2.7*sin(atan2(1,5))],
- [2.7*sin(atan2(1,5)), -2.7*cos(atan2(1,5))]
- )
- == 1,
- "arctan(1/5) by atan2() of larger size (multipled by 2.7),"
- ."caught by the equalities";
-
-ok is_square(
- [2.8*cos(atan2(1,5)), 2.8*sin(atan2(1,5))],
- [-2.8*sin(atan2(1,5)), 2.8*cos(atan2(1,5))],
- [-2.8*cos(atan2(1,5)), -2.8*sin(atan2(1,5))],
- [2.8*sin(atan2(1,5)), -2.8*cos(atan2(1,5))]
- )
- == 1,
- "arctan(1/5) by atan2() of larger size (multipled by 2.8),"
- ."caught by the equalities";
-
-ok is_square(
- [4.0*cos(atan2(1,5)), 4.0*sin(atan2(1,5))],
- [-4.0*sin(atan2(1,5)), 4.0*cos(atan2(1,5))],
- [-4.0*cos(atan2(1,5)), -4.0*sin(atan2(1,5))],
- [4.0*sin(atan2(1,5)), -4.0*cos(atan2(1,5))]
- )
- == 1,
- "arctan(1/5) by atan2() of larger size (multipled by 4.0),"
- ." caught by the equalities";
-
-ok is_square(
- [0.0009*cos(atan2(1,5)), 0.0009*sin(atan2(1,5))],
- [-0.0009*sin(atan2(1,5)), 0.0009*cos(atan2(1,5))],
- [-0.0009*cos(atan2(1,5)), -0.0009*sin(atan2(1,5))],
- [0.0009*sin(atan2(1,5)), -0.0009*cos(atan2(1,5))]
- )
- == 1,
- "arctan(1/5) by atan2() of a much smaller size"
- ."(multiple by 0.0009), caught by the equalities"
- ."(_\"not ok\" is normal_)";
-
-ok is_square( [1, 2] , [4,3], [3,1], [2,4] ) == 1, "Knight's square";
-ok is_square( [1, 1] , [-1, 1], [1,-1], [-1,-1] ) == 1, "centre at origin";
-
-# 4 tests
-ok is_cube( [1, 1, 1], [1, 1, 0], [1, 0, 1], [1, 0, 0],
- [0, 1, 1], [0, 1, 0], [0, 0, 1], [0, 0, 0] ) == 1,
- "standard 2**3";
-ok is_cube([ -2, -2, -2], [ -2, -2, 2], [ -2, 2, -2], [ -2, 2, 2],
- [ 2, -2, -2], [ 2, -2, 2], [ 2, 2, -2], [ 2, 2, 2]) == 1,
- "centre at origin";
-ok is_cube(
- [-2, -2*sqrt(3), 3-2*sqrt(3)] ,
- [-2, 4-2*sqrt(3), 3+2*sqrt(3)],
- [-2, 2*sqrt(3), -2*sqrt(3)-1 ],
- [-2, 4+2*sqrt(3), -1+2*sqrt(3) ],
- [ 6, -2*sqrt(3), 3-2*sqrt(3)],
- [ 6, 4-2*sqrt(3), 3+2*sqrt(3)],
- [ 6, 2*sqrt(3), -2*sqrt(3)-1],
- [ 6, 4+2*sqrt(3), -1+2*sqrt(3)]
- )
- == 1, "a rotated cube centred at (2,2,1)";
-ok is_cube([ 2, 2, 2], [ 2, 3, 2], [ 2, 2, 3], [ 2, 4, 2],
- [ 3, 3, 2], [ 2, 2, 1], [ 2, 3, 2], [ 2, 7, 3]) == 0,
- "this is not a cube";
-
-# 1 test
-ok is_hypercube(
- [0,0,0,0],[0,0,0,1],[0,0,1,0],
- [0,0,1,1],[0,1,0,0],[0,1,0,1],
- [0,1,1,0],[0,1,1,1],[1,0,0,0],
- [1,0,0,1],[1,0,1,0],[1,0,1,1],
- [1,1,0,0],[1,1,0,1],[1,1,1,0],
- [1,1,1,1]
- ) == 1, "hypercube";
-done_testing();