diff options
| author | E7-87-83 <fungcheokyin@gmail.com> | 2021-07-27 17:19:56 +0800 |
|---|---|---|
| committer | E7-87-83 <fungcheokyin@gmail.com> | 2021-07-27 17:19:56 +0800 |
| commit | 54cf90ee94a5999e86f461136ea213fb5e469fe0 (patch) | |
| tree | cd2ee8d72e657a74f94b095b162e0c0569d7cf64 | |
| parent | 3e8d68681e174e95505b1c5152a9eb4932c7365b (diff) | |
| download | perlweeklychallenge-club-54cf90ee94a5999e86f461136ea213fb5e469fe0.tar.gz perlweeklychallenge-club-54cf90ee94a5999e86f461136ea213fb5e469fe0.tar.bz2 perlweeklychallenge-club-54cf90ee94a5999e86f461136ea213fb5e469fe0.zip | |
week 123
| -rw-r--r-- | challenge-123/cheok-yin-fung/perl/ch-2.pl | 19 | ||||
| -rw-r--r-- | challenge-123/cheok-yin-fung/perl/ch-2a.pl | 129 | ||||
| -rw-r--r-- | challenge-123/cheok-yin-fung/perl/temp.txt | 16 |
3 files changed, 109 insertions, 55 deletions
diff --git a/challenge-123/cheok-yin-fung/perl/ch-2.pl b/challenge-123/cheok-yin-fung/perl/ch-2.pl index f684c14efe..f9ea6f305e 100644 --- a/challenge-123/cheok-yin-fung/perl/ch-2.pl +++ b/challenge-123/cheok-yin-fung/perl/ch-2.pl @@ -8,7 +8,7 @@ use strict; use warnings; use v5.10.0; -use Test::More tests => 4; +use Test::More tests => 5; #extend to 7 test cases after writing cases for rotation or 3D my $D = $ARGV[0] || 2; @@ -19,24 +19,31 @@ my $pt2 = [split " ", <STDIN>]; my $pt3 = [split " ", <STDIN>]; say is_square($pt0, $pt1, $pt2, $pt3); -say ""; + sub is_square { my ($p0,$p1,$p2,$p3) = ($_[0], $_[1], $_[2], $_[3]); my $v0 = vec_subtract($p0, $p1); my $v1 = vec_subtract($p0, $p2); my $v2 = vec_subtract($p0, $p3); + # "cross product test"; return 0 unless (vec_prod($v1, $v2) == 0) xor (vec_prod($v0, $v2) == 0) xor (vec_prod($v0, $v1) == 0); + # "vector sum test"; 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) ); my @n_vector = map { norm($_) } ($v0, $v1, $v2); @n_vector = sort {$a<=>$b} @n_vector; - if ( $n_vector[0] == $n_vector[1] ) { + # "norm test" + #if ( $n_vector[0] == $n_vector[1] ) { +# the above conditional is fit for integter coordinates +# the below is special arrangement for the 5th test case +# or floating point number in general + if ( sprintf("%f",$n_vector[0]) eq sprintf("%f", $n_vector[1]) ) { return 1; - } + } return 0; } @@ -93,5 +100,7 @@ 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"; - +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"; done_testing(); diff --git a/challenge-123/cheok-yin-fung/perl/ch-2a.pl b/challenge-123/cheok-yin-fung/perl/ch-2a.pl index 62b1ee947a..6ce99a1730 100644 --- a/challenge-123/cheok-yin-fung/perl/ch-2a.pl +++ b/challenge-123/cheok-yin-fung/perl/ch-2a.pl @@ -1,22 +1,22 @@ #!/usr/bin/perl # The Weekly Challenge 123 # Task 2 extension: Square/Cube/Hypercube Points -# Usage: ch-2a.pl (optional $k) (optional)$D +# 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 3 +# $D: 2 or above, cannot be smaller than $k, default is same as $k use strict; use warnings; use v5.10.0; -use Test::More tests => 5; #7 #extend to 10 after writing cases for rotation -# extends after writing cases for 3D or above +use Test::More tests => 9; + use Algorithm::Combinatorics qw(permutations); #use for hypercube my $k = $ARGV[0] || 3; -my $D = $ARGV[1] || 3; +my $D = $ARGV[1] || $k; -die "Usage: ch-2a.pl [2, 3 or 4] [(optional)dimension of space] " +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; @@ -32,7 +32,7 @@ sub is_square { 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) ); - my @n_vector = map { norm($_) } ($v0, $v1, $v2); + 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; @@ -48,7 +48,7 @@ sub is_cube { $v{$_} = vec_subtract($p[0], $p[$_]) for (1..7); my @ind = sort { norm($v{$a}) <=> norm($v{$b}) } keys %v; my ($N, $W, $U) = ($v{$ind[0]} , $v{$ind[1]} , $v{$ind[2]}) ; - return 0 unless norm($N) == norm($W) && norm($N) == norm($U); + return 0 unless norm_f($N) == norm_f($W) && norm_f($N) == norm_f($U); return 0 unless vec_prod($N,$W) == 0 && vec_prod($W,$U) == 0 && vec_prod($U,$N) == 0; my $NW = vec_sum($N, $W); @@ -84,25 +84,20 @@ sub is_cube { } return 0 if !$bool; - my $NWU = vec_sum( $N, vec_sum($W, $U) ); + my $NWU = vec_sum( $N, $WU); if ( vec_same( $v{$ind[6]} , $NWU ) ) { - return 1; - } - else { - return 0; - } -=pod - if ( vec_same( $v{$ind[6]} , $NWU ) ) { +=pod return 0 unless 2*norm($N) == norm($NW) && norm($NW) == norm($WU) && norm($WU) == norm($UN) && 3*norm($N) == norm($NWU); +=cut return 1; - } else { + } + else { return 0; } -=cut } sub is_hypercube { @@ -113,15 +108,16 @@ sub is_hypercube { my ($N, $W, $U, $A) = ( $v{$ind[0]}, $v{$ind[1]} , $v{$ind[2]}, $v{$ind[3]} ); return 0 unless - norm($N) == norm($W) && norm($W) == norm($U) - && norm($U) == norm($A); + norm_f($N) == norm_f($W) && norm_f($W) == norm_f($U) + && norm_f($U) == norm_f($A); return 0 unless vec_prod($N, $W) == 0 && vec_prod($N, $U) == 0 && vec_prod($N, $A) == 0 && - vec_prod($A, $W ) == 0 && - vec_prod($A, $U ) == 0 && - vec_prod($W, $U ) == 0 ; + vec_prod($A, $W) == 0 && + vec_prod($A, $U) == 0 && + vec_prod($W, $U) == 0 ; + my $AU = vec_sum($A, $U); my $AW = vec_sum($A, $W); my $AN = vec_sum($A, $N); @@ -132,12 +128,12 @@ sub is_hypercube { 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]}, $AU) && - vec_same($v{$ind[5]}, $UN) && - vec_same($v{$ind[6]}, $NW) && - vec_same($v{$ind[7]}, $WU) && - vec_same($v{$ind[8]}, $AW) && - vec_same($v{$ind[9]}, $AN) ; + 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; @@ -149,21 +145,16 @@ sub is_hypercube { my $iter_cube = permutations([$UNW, $ANW, $AWU, $AUN]); while (!$bool_cube && (my $p = $iter_cube->next)) { $bool_cube = - vec_same($v{$ind[10]}, $UNW) && - vec_same($v{$ind[11]}, $ANW) && - vec_same($v{$ind[12]}, $AWU) && - vec_same($v{$ind[13]}, $AUN); + 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; - } =pod - if ( vec_same($v{$ind[14]}, $AUNW) ) { return 0 unless 2*norm($N) == norm($NW) && norm($NW) == norm($AU) && @@ -176,11 +167,12 @@ sub is_hypercube { 3*norm($N) == norm($AWU) && 3*norm($N) == norm($AUN) && 4*norm($N) == norm($AUNW); +=cut return 1; - } else { + } + else { return 0; } -=cut } sub vec_prod { @@ -199,6 +191,10 @@ sub norm { return $sum; } +sub norm_f { + return sprintf("%f", norm($_[0])); +} + sub vec_sum { my $first = $_[0]; my $second = $_[1]; @@ -231,22 +227,55 @@ sub vec_subtract { return $ans; } -# 2 tests + + +# 4 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))] +# ) +# == 0, "arctan(1/5) by atan2(), fail to catch the equalities due to floating-point"; + 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"; +ok is_square( [1, 1] , [-1, 1], [1,-1], [-1,-1] ) == 1, "centre at origin"; -# 3 tests +# 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, - "center at origin"; -# ok is_cube( [1, 1, 1] , [-1,1], [1,-1], [-1,-1] ) == 1, -# "a rotated cube centred at somewhere"; + "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, - "not a cube"; - + "this is not a cube"; -# test for hypercube is needed +# 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/temp.txt b/challenge-123/cheok-yin-fung/perl/temp.txt new file mode 100644 index 0000000000..dcc1130480 --- /dev/null +++ b/challenge-123/cheok-yin-fung/perl/temp.txt @@ -0,0 +1,16 @@ +[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], |
