| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | # Copyright 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Kevin Ryde | 
| 2 |  |  |  |  |  |  |  | 
| 3 |  |  |  |  |  |  | # This file is part of Math-PlanePath. | 
| 4 |  |  |  |  |  |  | # | 
| 5 |  |  |  |  |  |  | # Math-PlanePath is free software; you can redistribute it and/or modify | 
| 6 |  |  |  |  |  |  | # it under the terms of the GNU General Public License as published by the | 
| 7 |  |  |  |  |  |  | # Free Software Foundation; either version 3, or (at your option) any later | 
| 8 |  |  |  |  |  |  | # version. | 
| 9 |  |  |  |  |  |  | # | 
| 10 |  |  |  |  |  |  | # Math-PlanePath is distributed in the hope that it will be useful, but | 
| 11 |  |  |  |  |  |  | # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY | 
| 12 |  |  |  |  |  |  | # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License | 
| 13 |  |  |  |  |  |  | # for more details. | 
| 14 |  |  |  |  |  |  | # | 
| 15 |  |  |  |  |  |  | # You should have received a copy of the GNU General Public License along | 
| 16 |  |  |  |  |  |  | # with Math-PlanePath.  If not, see . | 
| 17 |  |  |  |  |  |  |  | 
| 18 |  |  |  |  |  |  |  | 
| 19 |  |  |  |  |  |  | # ENHANCE-ME: Explanation for this bit ... | 
| 20 |  |  |  |  |  |  | # 'arms=4' => | 
| 21 |  |  |  |  |  |  | # { dSum  => 'A020985', # GRS | 
| 22 |  |  |  |  |  |  | #   # OEIS-Other: A020985 planepath=AlternatePaper,arms=4 delta_type=dSum | 
| 23 |  |  |  |  |  |  | # }, | 
| 24 |  |  |  |  |  |  |  | 
| 25 |  |  |  |  |  |  |  | 
| 26 |  |  |  |  |  |  | package Math::PlanePath::AlternatePaper; | 
| 27 | 2 |  |  | 2 |  | 10044 | use 5.004; | 
|  | 2 |  |  |  |  | 8 |  | 
| 28 | 2 |  |  | 2 |  | 10 | use strict; | 
|  | 2 |  |  |  |  | 3 |  | 
|  | 2 |  |  |  |  | 77 |  | 
| 29 | 2 |  |  | 2 |  | 14 | use List::Util 'min'; # 'max' | 
|  | 2 |  |  |  |  | 2 |  | 
|  | 2 |  |  |  |  | 226 |  | 
| 30 |  |  |  |  |  |  | *max = \&Math::PlanePath::_max; | 
| 31 |  |  |  |  |  |  |  | 
| 32 | 2 |  |  | 2 |  | 13 | use vars '$VERSION', '@ISA'; | 
|  | 2 |  |  |  |  | 4 |  | 
|  | 2 |  |  |  |  | 168 |  | 
| 33 |  |  |  |  |  |  | $VERSION = 129; | 
| 34 | 2 |  |  | 2 |  | 770 | use Math::PlanePath; | 
|  | 2 |  |  |  |  | 4 |  | 
|  | 2 |  |  |  |  | 50 |  | 
| 35 | 2 |  |  | 2 |  | 437 | use Math::PlanePath::Base::NSEW; | 
|  | 2 |  |  |  |  | 3 |  | 
|  | 2 |  |  |  |  | 81 |  | 
| 36 |  |  |  |  |  |  | @ISA = ('Math::PlanePath::Base::NSEW', | 
| 37 |  |  |  |  |  |  | 'Math::PlanePath'); | 
| 38 |  |  |  |  |  |  |  | 
| 39 |  |  |  |  |  |  | use Math::PlanePath::Base::Generic | 
| 40 | 2 |  |  |  |  | 108 | 'is_infinite', | 
| 41 | 2 |  |  | 2 |  | 14 | 'round_nearest'; | 
|  | 2 |  |  |  |  | 2 |  | 
| 42 |  |  |  |  |  |  | use Math::PlanePath::Base::Digits | 
| 43 | 2 |  |  |  |  | 233 | 'round_down_pow', | 
| 44 |  |  |  |  |  |  | 'digit_split_lowtohigh', | 
| 45 |  |  |  |  |  |  | 'digit_join_lowtohigh', | 
| 46 | 2 |  |  | 2 |  | 505 | 'bit_split_lowtohigh'; | 
|  | 2 |  |  |  |  | 4 |  | 
| 47 |  |  |  |  |  |  | *_divrem = \&Math::PlanePath::_divrem; | 
| 48 |  |  |  |  |  |  | *_divrem_mutate = \&Math::PlanePath::_divrem_mutate; | 
| 49 |  |  |  |  |  |  |  | 
| 50 |  |  |  |  |  |  | # uncomment this to run the ### lines | 
| 51 |  |  |  |  |  |  | # use Smart::Comments; | 
| 52 |  |  |  |  |  |  |  | 
| 53 |  |  |  |  |  |  |  | 
| 54 | 2 |  |  |  |  | 124 | use constant parameter_info_array => [ { name      => 'arms', | 
| 55 |  |  |  |  |  |  | share_key => 'arms_8', | 
| 56 |  |  |  |  |  |  | display   => 'Arms', | 
| 57 |  |  |  |  |  |  | type      => 'integer', | 
| 58 |  |  |  |  |  |  | minimum   => 1, | 
| 59 |  |  |  |  |  |  | maximum   => 8, | 
| 60 |  |  |  |  |  |  | default   => 1, | 
| 61 |  |  |  |  |  |  | width     => 1, | 
| 62 |  |  |  |  |  |  | description => 'Arms', | 
| 63 | 2 |  |  | 2 |  | 15 | } ]; | 
|  | 2 |  |  |  |  | 4 |  | 
| 64 |  |  |  |  |  |  |  | 
| 65 | 2 |  |  | 2 |  | 12 | use constant n_start => 0; | 
|  | 2 |  |  |  |  | 4 |  | 
|  | 2 |  |  |  |  | 558 |  | 
| 66 |  |  |  |  |  |  | sub x_negative { | 
| 67 | 6 |  |  | 6 | 1 | 107 | my ($self) = @_; | 
| 68 | 6 |  |  |  |  | 17 | return ($self->{'arms'} >= 3); | 
| 69 |  |  |  |  |  |  | } | 
| 70 |  |  |  |  |  |  | sub y_negative { | 
| 71 | 6 |  |  | 6 | 1 | 364 | my ($self) = @_; | 
| 72 | 6 |  |  |  |  | 20 | return ($self->{'arms'} >= 5); | 
| 73 |  |  |  |  |  |  | } | 
| 74 |  |  |  |  |  |  | { | 
| 75 |  |  |  |  |  |  | my @x_negative_at_n = (undef, | 
| 76 |  |  |  |  |  |  | undef,undef,8,7, | 
| 77 |  |  |  |  |  |  | 4,4,4,4); | 
| 78 |  |  |  |  |  |  | sub x_negative_at_n { | 
| 79 | 0 |  |  | 0 | 1 | 0 | my ($self) = @_; | 
| 80 | 0 |  |  |  |  | 0 | return $x_negative_at_n[$self->{'arms'}]; | 
| 81 |  |  |  |  |  |  | } | 
| 82 |  |  |  |  |  |  | } | 
| 83 |  |  |  |  |  |  | { | 
| 84 |  |  |  |  |  |  | my @y_negative_at_n = (undef, | 
| 85 |  |  |  |  |  |  | undef,undef,undef,undef, | 
| 86 |  |  |  |  |  |  | 44,23,13,14); | 
| 87 |  |  |  |  |  |  | sub y_negative_at_n { | 
| 88 | 0 |  |  | 0 | 1 | 0 | my ($self) = @_; | 
| 89 | 0 |  |  |  |  | 0 | return $y_negative_at_n[$self->{'arms'}]; | 
| 90 |  |  |  |  |  |  | } | 
| 91 |  |  |  |  |  |  | } | 
| 92 |  |  |  |  |  |  |  | 
| 93 |  |  |  |  |  |  | sub sumxy_minimum { | 
| 94 | 0 |  |  | 0 | 1 | 0 | my ($self) = @_; | 
| 95 | 0 | 0 |  |  |  | 0 | return ($self->arms_count <= 3 | 
| 96 |  |  |  |  |  |  | ? 0        # 1,2,3 arms above X=-Y diagonal | 
| 97 |  |  |  |  |  |  | : undef); | 
| 98 |  |  |  |  |  |  | } | 
| 99 |  |  |  |  |  |  | sub diffxy_minimum { | 
| 100 | 0 |  |  | 0 | 1 | 0 | my ($self) = @_; | 
| 101 | 0 | 0 |  |  |  | 0 | return ($self->arms_count == 1 | 
| 102 |  |  |  |  |  |  | ? 0        # 1 arms right of X=Y diagonal | 
| 103 |  |  |  |  |  |  | : undef); | 
| 104 |  |  |  |  |  |  | } | 
| 105 |  |  |  |  |  |  |  | 
| 106 | 2 |  |  | 2 |  | 15 | use constant turn_any_straight => 0; # never straight | 
|  | 2 |  |  |  |  | 3 |  | 
|  | 2 |  |  |  |  | 3517 |  | 
| 107 |  |  |  |  |  |  |  | 
| 108 |  |  |  |  |  |  |  | 
| 109 |  |  |  |  |  |  | #------------------------------------------------------------------------------ | 
| 110 |  |  |  |  |  |  |  | 
| 111 |  |  |  |  |  |  | sub new { | 
| 112 | 37 |  |  | 37 | 1 | 6402 | my $self = shift->SUPER::new(@_); | 
| 113 | 37 |  | 100 |  |  | 335 | $self->{'arms'} = max(1, min(8, $self->{'arms'} || 1)); | 
| 114 | 37 |  |  |  |  | 93 | return $self; | 
| 115 |  |  |  |  |  |  | } | 
| 116 |  |  |  |  |  |  |  | 
| 117 |  |  |  |  |  |  | { | 
| 118 |  |  |  |  |  |  | #                        <------ | 
| 119 |  |  |  |  |  |  | #  state=0   /|        +----+----+ | 
| 120 |  |  |  |  |  |  | #  (dir=0)  / |        |\ 1||<--/ | 
| 121 |  |  |  |  |  |  | #          /2 |        |^\ || 0/ | 
| 122 |  |  |  |  |  |  | #         /-->|        || \v| / | 
| 123 |  |  |  |  |  |  | #        +----+        ||3 \|/ | 
| 124 |  |  |  |  |  |  | #       /|\ 3||        +----+ | 
| 125 |  |  |  |  |  |  | #      / |^\ ||        |<--/   state=4 | 
| 126 |  |  |  |  |  |  | #     / 0|| \v|        | 2/    (dir=2) | 
| 127 |  |  |  |  |  |  | #    /-->||1 \|        | / | 
| 128 |  |  |  |  |  |  | #   +----+----+        |/ | 
| 129 |  |  |  |  |  |  | #    --------> | 
| 130 |  |  |  |  |  |  | # | 
| 131 |  |  |  |  |  |  | #   |\    state=8      +----+----+   state=12 | 
| 132 |  |  |  |  |  |  | # ^ |^\   (dir=1)       \ 1||<--/| |  (dir=3) | 
| 133 |  |  |  |  |  |  | # | || \                 \ || 0/ | | | 
| 134 |  |  |  |  |  |  | # | ||3 \                 \v| /2 | | | 
| 135 |  |  |  |  |  |  | # | +----+                 \|/-->| | | 
| 136 |  |  |  |  |  |  | # | |<--/|\                 +----+ | | 
| 137 |  |  |  |  |  |  | # | | 2/ |^\                 \ 3|| | | 
| 138 |  |  |  |  |  |  | # | | /0 || \                 \ || | | 
| 139 |  |  |  |  |  |  | # | |/-->||1 \                 \v| v | 
| 140 |  |  |  |  |  |  | #   +----+----+                 \| | 
| 141 |  |  |  |  |  |  |  | 
| 142 |  |  |  |  |  |  | my @next_state = (0,  8, 0, 12,   # forward | 
| 143 |  |  |  |  |  |  | 4, 12, 4,  8,   # forward NW | 
| 144 |  |  |  |  |  |  | 0,  8, 4,  8,   # reverse | 
| 145 |  |  |  |  |  |  | 4, 12, 0, 12,   # reverse NE | 
| 146 |  |  |  |  |  |  | ); | 
| 147 |  |  |  |  |  |  | my @digit_to_x = (0,1,1,1, | 
| 148 |  |  |  |  |  |  | 1,0,0,0, | 
| 149 |  |  |  |  |  |  | 0,1,0,0, | 
| 150 |  |  |  |  |  |  | 1,0,1,1, | 
| 151 |  |  |  |  |  |  | ); | 
| 152 |  |  |  |  |  |  | my @digit_to_y = (0,0,1,0, | 
| 153 |  |  |  |  |  |  | 1,1,0,1, | 
| 154 |  |  |  |  |  |  | 0,0,0,1, | 
| 155 |  |  |  |  |  |  | 1,1,1,0, | 
| 156 |  |  |  |  |  |  | ); | 
| 157 |  |  |  |  |  |  |  | 
| 158 |  |  |  |  |  |  | # state_to_dx[S] == state_to_x[S+3] - state_to_x[S+0] | 
| 159 |  |  |  |  |  |  | my @state_to_dx = (1, -1, 0, 0); | 
| 160 |  |  |  |  |  |  | my @state_to_dy = (0, 0, 1, -1); | 
| 161 |  |  |  |  |  |  |  | 
| 162 |  |  |  |  |  |  | sub n_to_xy { | 
| 163 | 7847 |  |  | 7847 | 1 | 252779 | my ($self, $n) = @_; | 
| 164 |  |  |  |  |  |  | ### AlternatePaper n_to_xy(): $n | 
| 165 |  |  |  |  |  |  |  | 
| 166 | 7847 | 50 |  |  |  | 15428 | if ($n < 0) { return; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 167 | 7847 | 50 |  |  |  | 15546 | if (is_infinite($n)) { return ($n, $n); } | 
|  | 0 |  |  |  |  | 0 |  | 
| 168 |  |  |  |  |  |  |  | 
| 169 | 7847 |  |  |  |  | 14588 | my $int = int($n);  # integer part | 
| 170 | 7847 |  |  |  |  | 11811 | $n -= $int;         # fraction part | 
| 171 |  |  |  |  |  |  | ### $int | 
| 172 |  |  |  |  |  |  | ### $n | 
| 173 |  |  |  |  |  |  |  | 
| 174 | 7847 |  |  |  |  | 11019 | my $zero = ($int * 0);  # inherit bignum 0 | 
| 175 | 7847 |  |  |  |  | 19281 | my $arm = _divrem_mutate ($int, $self->{'arms'}); | 
| 176 |  |  |  |  |  |  |  | 
| 177 |  |  |  |  |  |  | ### $arm | 
| 178 |  |  |  |  |  |  | ### $int | 
| 179 |  |  |  |  |  |  |  | 
| 180 | 7847 |  |  |  |  | 16584 | my @digits = digit_split_lowtohigh($int,4); | 
| 181 | 7847 |  |  |  |  | 11173 | my $state = 0; | 
| 182 | 7847 |  |  |  |  | 11090 | my (@xbits,@ybits); # bits low to high (like @digits) | 
| 183 |  |  |  |  |  |  |  | 
| 184 | 7847 |  |  |  |  | 14671 | foreach my $i (reverse 0 .. $#digits) {  # high to low | 
| 185 | 19082 |  |  |  |  | 26605 | $state += $digits[$i]; | 
| 186 | 19082 |  |  |  |  | 27147 | $xbits[$i] = $digit_to_x[$state]; | 
| 187 | 19082 |  |  |  |  | 26613 | $ybits[$i] = $digit_to_y[$state]; | 
| 188 | 19082 |  |  |  |  | 28304 | $state = $next_state[$state]; | 
| 189 |  |  |  |  |  |  | } | 
| 190 | 7847 |  |  |  |  | 17873 | my $x = digit_join_lowtohigh(\@xbits,2,$zero); | 
| 191 | 7847 |  |  |  |  | 15480 | my $y = digit_join_lowtohigh(\@ybits,2,$zero); | 
| 192 |  |  |  |  |  |  |  | 
| 193 |  |  |  |  |  |  | # X+1,Y+1 for final state=4 or state=12 | 
| 194 | 7847 |  |  |  |  | 11947 | $x += $digit_to_x[$state]; | 
| 195 | 7847 |  |  |  |  | 11011 | $y += $digit_to_y[$state]; | 
| 196 |  |  |  |  |  |  |  | 
| 197 |  |  |  |  |  |  | ### final: "xy=$x,$y state=$state" | 
| 198 |  |  |  |  |  |  |  | 
| 199 |  |  |  |  |  |  | # apply possible fraction part of $n in direction of $state | 
| 200 | 7847 |  |  |  |  | 12474 | $x = $n * $state_to_dx[$state >>= 2] + $x; | 
| 201 | 7847 |  |  |  |  | 10868 | $y = $n * $state_to_dy[$state] + $y; | 
| 202 |  |  |  |  |  |  |  | 
| 203 |  |  |  |  |  |  | # rotate,transpose for arm number | 
| 204 | 7847 | 100 |  |  |  | 14890 | if ($arm & 1) { | 
| 205 | 3366 |  |  |  |  | 5982 | ($x,$y) = ($y,$x);   # transpose | 
| 206 |  |  |  |  |  |  | } | 
| 207 | 7847 | 100 |  |  |  | 13562 | if ($arm & 2) { | 
| 208 | 2886 |  |  |  |  | 5076 | ($x,$y) = (-$y,$x+1);  # rotate +90 and shift origin to X=0,Y=1 | 
| 209 |  |  |  |  |  |  | } | 
| 210 | 7847 | 100 |  |  |  | 13544 | if ($arm & 4) { | 
| 211 | 2023 |  |  |  |  | 2734 | $x = -1 - $x;      # rotate +180 and shift origin to X=-1,Y=1 | 
| 212 | 2023 |  |  |  |  | 2636 | $y = 1 - $y; | 
| 213 |  |  |  |  |  |  | } | 
| 214 |  |  |  |  |  |  |  | 
| 215 |  |  |  |  |  |  | ### rotated return: "$x,$y" | 
| 216 | 7847 |  |  |  |  | 19134 | return ($x,$y); | 
| 217 |  |  |  |  |  |  | } | 
| 218 |  |  |  |  |  |  | } | 
| 219 |  |  |  |  |  |  |  | 
| 220 |  |  |  |  |  |  | #                                                      8 | 
| 221 |  |  |  |  |  |  | # | 
| 222 |  |  |  |  |  |  | #                                          42   43     7 | 
| 223 |  |  |  |  |  |  | # | 
| 224 |  |  |  |  |  |  | #                                    40 41/45   44     6 | 
| 225 |  |  |  |  |  |  | # | 
| 226 |  |  |  |  |  |  | #                              34 35/39 38/46   47     5 | 
| 227 |  |  |  |  |  |  | # | 
| 228 |  |  |  |  |  |  | #                        32-33/53-36/52-37/49---48     4 | 
| 229 |  |  |  |  |  |  | #                        | \ | 
| 230 |  |  |  |  |  |  | #                  10 11/31 30/54 51/55 50/58   59     3 | 
| 231 |  |  |  |  |  |  | #                        |       \ | 
| 232 |  |  |  |  |  |  | #             8  9/13 12/28 25/29 24/56 57/61   60     2 | 
| 233 |  |  |  |  |  |  | #                        |             \ | 
| 234 |  |  |  |  |  |  | #       2   3/7  6/14 15/27 18/26 19/23 22/62   63     1 | 
| 235 |  |  |  |  |  |  | #                        |                   \ | 
| 236 |  |  |  |  |  |  | # 0     1     4     5    16    17    20    21 ==64     0 | 
| 237 |  |  |  |  |  |  | # | 
| 238 |  |  |  |  |  |  | # 0     1     2     3     4     5     6     7    8 | 
| 239 |  |  |  |  |  |  |  | 
| 240 |  |  |  |  |  |  | sub xy_to_n { | 
| 241 | 121 |  |  | 121 | 1 | 8387 | return scalar((shift->xy_to_n_list(@_))[0]); | 
| 242 |  |  |  |  |  |  | } | 
| 243 |  |  |  |  |  |  | sub xy_to_n_list { | 
| 244 | 159 |  |  | 159 | 1 | 5252 | my ($self, $x, $y) = @_; | 
| 245 |  |  |  |  |  |  | ### AlternatePaper xy_to_n(): "$x, $y" | 
| 246 |  |  |  |  |  |  |  | 
| 247 | 159 |  |  |  |  | 400 | $x = round_nearest($x); | 
| 248 | 159 |  |  |  |  | 317 | $y = round_nearest($y); | 
| 249 | 159 | 50 |  |  |  | 329 | if (is_infinite($x)) { return $x; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 250 | 159 | 50 |  |  |  | 340 | if (is_infinite($y)) { return $y; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 251 |  |  |  |  |  |  |  | 
| 252 | 159 |  |  |  |  | 331 | my $arms = $self->{'arms'}; | 
| 253 | 159 |  |  |  |  | 234 | my $arm = 0; | 
| 254 | 159 |  |  |  |  | 216 | my @ret; | 
| 255 | 159 |  |  |  |  | 320 | foreach (1 .. 4) { | 
| 256 | 231 |  |  |  |  | 441 | push @ret, map {$_*$arms+$arm} _xy_to_n_list__onearm($self,$x,$y); | 
|  | 181 |  |  |  |  | 400 |  | 
| 257 | 231 | 100 |  |  |  | 506 | last if ++$arm >= $arms; | 
| 258 |  |  |  |  |  |  |  | 
| 259 | 113 |  |  |  |  | 226 | ($x,$y) = ($y,$x); # transpose | 
| 260 | 113 |  |  |  |  | 213 | push @ret, map {$_*$arms+$arm} _xy_to_n_list__onearm($self,$x,$y); | 
|  | 41 |  |  |  |  | 87 |  | 
| 261 | 113 | 100 |  |  |  | 247 | last if ++$arm >= $arms; | 
| 262 |  |  |  |  |  |  |  | 
| 263 |  |  |  |  |  |  | # X,Y -> Y,X | 
| 264 |  |  |  |  |  |  | #     -> Y,X-1     # Y-1 shift | 
| 265 |  |  |  |  |  |  | #     -> X-1,-Y    # rot -90 | 
| 266 |  |  |  |  |  |  | # ie. mirror across X axis and shift | 
| 267 | 72 |  |  |  |  | 146 | ($x,$y) = ($x-1,-$y); | 
| 268 |  |  |  |  |  |  | } | 
| 269 | 159 |  |  |  |  | 501 | return sort {$a<=>$b} @ret; | 
|  | 86 |  |  |  |  | 294 |  | 
| 270 |  |  |  |  |  |  | } | 
| 271 |  |  |  |  |  |  |  | 
| 272 |  |  |  |  |  |  | sub _xy_to_n_list__onearm { | 
| 273 | 344 |  |  | 344 |  | 561 | my ($self, $x, $y) = @_; | 
| 274 |  |  |  |  |  |  | ### _xy_to_n_list__onearm(): "$x,$y" | 
| 275 |  |  |  |  |  |  |  | 
| 276 | 344 | 100 | 100 |  |  | 1117 | if ($y < 0 || $y > $x || $x < 0) { | 
|  |  |  | 66 |  |  |  |  | 
| 277 |  |  |  |  |  |  | ### outside first octant ... | 
| 278 | 182 |  |  |  |  | 296 | return; | 
| 279 |  |  |  |  |  |  | } | 
| 280 |  |  |  |  |  |  |  | 
| 281 | 162 |  |  |  |  | 389 | my ($len,$level) = round_down_pow($x, 2); | 
| 282 |  |  |  |  |  |  | ### $len | 
| 283 |  |  |  |  |  |  | ### $level | 
| 284 | 162 | 50 |  |  |  | 370 | if (is_infinite($level)) { | 
| 285 | 0 |  |  |  |  | 0 | return; | 
| 286 |  |  |  |  |  |  | } | 
| 287 |  |  |  |  |  |  |  | 
| 288 | 162 |  |  |  |  | 325 | my $n = my $big_n = $x * 0 * $y;  # inherit bignum 0 | 
| 289 | 162 |  |  |  |  | 215 | my $rev = 0; | 
| 290 |  |  |  |  |  |  |  | 
| 291 | 162 |  |  |  |  | 225 | my $big_x = $x; | 
| 292 | 162 |  |  |  |  | 226 | my $big_y = $y; | 
| 293 | 162 |  |  |  |  | 244 | my $big_rev = 0; | 
| 294 |  |  |  |  |  |  |  | 
| 295 | 162 |  |  |  |  | 312 | while ($level-- >= 0) { | 
| 296 |  |  |  |  |  |  | ### at: "$x,$y  len=$len  n=$n" | 
| 297 |  |  |  |  |  |  |  | 
| 298 |  |  |  |  |  |  | # the smaller N | 
| 299 |  |  |  |  |  |  | { | 
| 300 | 447 |  |  |  |  | 600 | $n *= 4; | 
| 301 | 447 | 100 |  |  |  | 691 | if ($rev) { | 
| 302 | 135 | 100 |  |  |  | 256 | if ($x+$y < 2*$len) { | 
| 303 |  |  |  |  |  |  | ### rev 0 or 1 ... | 
| 304 | 51 | 100 |  |  |  | 83 | if ($x < $len) { | 
| 305 |  |  |  |  |  |  | } else { | 
| 306 |  |  |  |  |  |  | ### rev 1 ... | 
| 307 | 24 |  |  |  |  | 42 | $rev = 0; | 
| 308 | 24 |  |  |  |  | 34 | $n -= 2; | 
| 309 | 24 |  |  |  |  | 43 | ($x,$y) = ($len-$y, $x-$len);   # x-len,y-len then rotate +90 | 
| 310 |  |  |  |  |  |  | } | 
| 311 |  |  |  |  |  |  |  | 
| 312 |  |  |  |  |  |  | } else { | 
| 313 |  |  |  |  |  |  | ### rev 2 or 3 ... | 
| 314 | 84 | 100 | 66 |  |  | 268 | if ($y > $len || ($x==$len && $y==$len)) { | 
|  |  |  | 100 |  |  |  |  | 
| 315 |  |  |  |  |  |  | ### rev 2 ... | 
| 316 | 35 |  |  |  |  | 55 | $n -= 2; | 
| 317 | 35 |  |  |  |  | 46 | $x -= $len; | 
| 318 | 35 |  |  |  |  | 48 | $y -= $len; | 
| 319 |  |  |  |  |  |  | } else { | 
| 320 |  |  |  |  |  |  | ### rev 3 ... | 
| 321 | 49 |  |  |  |  | 86 | $n -= 4; | 
| 322 | 49 |  |  |  |  | 67 | $rev = 0; | 
| 323 | 49 |  |  |  |  | 97 | ($x,$y) = ($y, 2*$len-$x);   # to origin then rotate -90 | 
| 324 |  |  |  |  |  |  | } | 
| 325 |  |  |  |  |  |  | } | 
| 326 |  |  |  |  |  |  | } else { | 
| 327 | 312 | 100 | 100 |  |  | 1338 | if ($x+$y <= 2*$len | 
|  |  |  | 100 |  |  |  |  | 
|  |  |  | 66 |  |  |  |  | 
|  |  |  | 100 |  |  |  |  | 
| 328 |  |  |  |  |  |  | && !($x==$len && $y==$len) | 
| 329 |  |  |  |  |  |  | && !($x==2*$len && $y==0)) { | 
| 330 |  |  |  |  |  |  | ### 0 or 1 ... | 
| 331 | 180 | 100 |  |  |  | 342 | if ($x <= $len) { | 
| 332 |  |  |  |  |  |  | } else { | 
| 333 |  |  |  |  |  |  | ### 1 ... | 
| 334 | 57 |  |  |  |  | 90 | $n += 2; | 
| 335 | 57 |  |  |  |  | 83 | $rev = 1; | 
| 336 | 57 |  |  |  |  | 122 | ($x,$y) = ($len-$y, $x-$len);   # x-len,y-len then rotate +90 | 
| 337 |  |  |  |  |  |  | } | 
| 338 |  |  |  |  |  |  |  | 
| 339 |  |  |  |  |  |  | } else { | 
| 340 |  |  |  |  |  |  | ### 2 or 3 ... | 
| 341 | 132 | 100 | 100 |  |  | 447 | if ($y >= $len && !($x==2*$len && $y==$len)) { | 
|  |  |  | 100 |  |  |  |  | 
| 342 | 75 |  |  |  |  | 109 | $n += 2; | 
| 343 | 75 |  |  |  |  | 111 | $x -= $len; | 
| 344 | 75 |  |  |  |  | 102 | $y -= $len; | 
| 345 |  |  |  |  |  |  | } else { | 
| 346 | 57 |  |  |  |  | 86 | $n += 4; | 
| 347 | 57 |  |  |  |  | 80 | $rev = 1; | 
| 348 | 57 |  |  |  |  | 105 | ($x,$y) = ($y, 2*$len-$x);   # to origin then rotate -90 | 
| 349 |  |  |  |  |  |  | } | 
| 350 |  |  |  |  |  |  | } | 
| 351 |  |  |  |  |  |  | } | 
| 352 |  |  |  |  |  |  | } | 
| 353 |  |  |  |  |  |  |  | 
| 354 |  |  |  |  |  |  | # the bigger N | 
| 355 |  |  |  |  |  |  | { | 
| 356 | 447 |  |  |  |  | 563 | $big_n *= 4; | 
|  | 447 |  |  |  |  | 533 |  | 
|  | 447 |  |  |  |  | 595 |  | 
| 357 | 447 | 100 |  |  |  | 694 | if ($big_rev) { | 
| 358 | 169 | 100 | 100 |  |  | 667 | if ($big_x+$big_y <= 2*$len | 
|  |  |  | 100 |  |  |  |  | 
|  |  |  | 66 |  |  |  |  | 
|  |  |  | 100 |  |  |  |  | 
| 359 |  |  |  |  |  |  | && !($big_x==$len && $big_y==$len) | 
| 360 |  |  |  |  |  |  | && !($big_x==2*$len && $big_y==0)) { | 
| 361 |  |  |  |  |  |  | ### rev 0 or 1 ... | 
| 362 | 77 | 100 |  |  |  | 130 | if ($big_x <= $len) { | 
| 363 |  |  |  |  |  |  | } else { | 
| 364 |  |  |  |  |  |  | ### rev 1 ... | 
| 365 | 30 |  |  |  |  | 53 | $big_rev = 0; | 
| 366 | 30 |  |  |  |  | 39 | $big_n -= 2; | 
| 367 | 30 |  |  |  |  | 57 | ($big_x,$big_y) = ($len-$big_y, $big_x-$len);   # x-len,y-len then rotate +90 | 
| 368 |  |  |  |  |  |  | } | 
| 369 |  |  |  |  |  |  |  | 
| 370 |  |  |  |  |  |  | } else { | 
| 371 |  |  |  |  |  |  | ### rev 2 or 3 ... | 
| 372 | 92 | 100 | 100 |  |  | 277 | if ($big_y >= $len && !($big_x==2*$len && $big_y==$len)) { | 
|  |  |  | 100 |  |  |  |  | 
| 373 |  |  |  |  |  |  | ### rev 2 ... | 
| 374 | 37 |  |  |  |  | 55 | $big_n -= 2; | 
| 375 | 37 |  |  |  |  | 52 | $big_x -= $len; | 
| 376 | 37 |  |  |  |  | 58 | $big_y -= $len; | 
| 377 |  |  |  |  |  |  | } else { | 
| 378 |  |  |  |  |  |  | ### rev 3 ... | 
| 379 | 55 |  |  |  |  | 89 | $big_n -= 4; | 
| 380 | 55 |  |  |  |  | 69 | $big_rev = 0; | 
| 381 | 55 |  |  |  |  | 98 | ($big_x,$big_y) = ($big_y, 2*$len-$big_x);   # to origin then rotate -90 | 
| 382 |  |  |  |  |  |  | } | 
| 383 |  |  |  |  |  |  | } | 
| 384 |  |  |  |  |  |  | } else { | 
| 385 | 278 | 100 |  |  |  | 485 | if ($big_x+$big_y < 2*$len) { | 
| 386 |  |  |  |  |  |  | ### 0 or 1 ... | 
| 387 | 177 | 100 |  |  |  | 284 | if ($big_x < $len) { | 
| 388 |  |  |  |  |  |  | } else { | 
| 389 |  |  |  |  |  |  | ### 1 ... | 
| 390 | 108 |  |  |  |  | 143 | $big_n += 2; | 
| 391 | 108 |  |  |  |  | 143 | $big_rev = 1; | 
| 392 | 108 |  |  |  |  | 205 | ($big_x,$big_y) = ($len-$big_y, $big_x-$len);   # x-len,y-len then rotate +90 | 
| 393 |  |  |  |  |  |  | } | 
| 394 |  |  |  |  |  |  |  | 
| 395 |  |  |  |  |  |  | } else { | 
| 396 |  |  |  |  |  |  | ### 2 or 3 ... | 
| 397 | 101 | 100 | 66 |  |  | 330 | if ($big_y > $len || ($big_x==$len && $big_y==$len)) { | 
|  |  |  | 100 |  |  |  |  | 
| 398 | 60 |  |  |  |  | 85 | $big_n += 2; | 
| 399 | 60 |  |  |  |  | 76 | $big_x -= $len; | 
| 400 | 60 |  |  |  |  | 81 | $big_y -= $len; | 
| 401 |  |  |  |  |  |  | } else { | 
| 402 | 41 |  |  |  |  | 60 | $big_n += 4; | 
| 403 | 41 |  |  |  |  | 51 | $big_rev = 1; | 
| 404 | 41 |  |  |  |  | 77 | ($big_x,$big_y) = ($big_y, 2*$len-$big_x);   # to origin then rotate -90 | 
| 405 |  |  |  |  |  |  | } | 
| 406 |  |  |  |  |  |  | } | 
| 407 |  |  |  |  |  |  | } | 
| 408 |  |  |  |  |  |  | } | 
| 409 | 447 |  |  |  |  | 858 | $len /= 2; | 
| 410 |  |  |  |  |  |  | } | 
| 411 |  |  |  |  |  |  |  | 
| 412 | 162 | 100 |  |  |  | 282 | if ($x) { | 
| 413 | 66 | 100 |  |  |  | 122 | $n += ($rev ? -1 : 1); | 
| 414 |  |  |  |  |  |  | } | 
| 415 | 162 | 100 |  |  |  | 280 | if ($big_x) { | 
| 416 | 66 | 100 |  |  |  | 108 | $big_n += ($big_rev ? -1 : 1); | 
| 417 |  |  |  |  |  |  | } | 
| 418 |  |  |  |  |  |  |  | 
| 419 |  |  |  |  |  |  | ### final: "$x,$y  n=$n  rev=$rev" | 
| 420 |  |  |  |  |  |  | ### final: "$x,$y  big_n=$n  big_rev=$rev" | 
| 421 |  |  |  |  |  |  |  | 
| 422 | 162 | 100 |  |  |  | 411 | return ($n, | 
| 423 |  |  |  |  |  |  | ($n == $big_n ? () : ($big_n))); | 
| 424 |  |  |  |  |  |  | } | 
| 425 |  |  |  |  |  |  |  | 
| 426 |  |  |  |  |  |  |  | 
| 427 |  |  |  |  |  |  | # not exact | 
| 428 |  |  |  |  |  |  | sub rect_to_n_range { | 
| 429 | 40 |  |  | 40 | 1 | 3466 | my ($self, $x1,$y1, $x2,$y2) = @_; | 
| 430 |  |  |  |  |  |  | ### AlternatePaper rect_to_n_range(): "$x1,$y1  $x2,$y2" | 
| 431 |  |  |  |  |  |  |  | 
| 432 | 40 |  |  |  |  | 105 | $x1 = round_nearest($x1); | 
| 433 | 40 |  |  |  |  | 82 | $x2 = round_nearest($x2); | 
| 434 | 40 |  |  |  |  | 78 | $y1 = round_nearest($y1); | 
| 435 | 40 |  |  |  |  | 74 | $y2 = round_nearest($y2); | 
| 436 |  |  |  |  |  |  |  | 
| 437 | 40 | 50 |  |  |  | 83 | ($x1,$x2) = ($x2,$x1) if $x1 > $x2; | 
| 438 | 40 | 50 |  |  |  | 83 | ($y1,$y2) = ($y2,$y1) if $y1 > $y2; | 
| 439 |  |  |  |  |  |  |  | 
| 440 |  |  |  |  |  |  | ### rounded: "$x1,$y1  $x2,$y2" | 
| 441 |  |  |  |  |  |  |  | 
| 442 | 40 |  |  |  |  | 82 | my $arms = $self->{'arms'}; | 
| 443 | 40 | 50 | 66 |  |  | 260 | if (($arms == 1 && $y1 > $x2)       # x2,y1 bottom right corner | 
|  |  |  | 66 |  |  |  |  | 
|  |  |  | 33 |  |  |  |  | 
|  |  |  | 66 |  |  |  |  | 
|  |  |  | 33 |  |  |  |  | 
| 444 |  |  |  |  |  |  | || ($arms <= 2 && $x2 < 0) | 
| 445 |  |  |  |  |  |  | || ($arms <= 4 && $y2 < 0)) { | 
| 446 |  |  |  |  |  |  | ### outside ... | 
| 447 | 0 |  |  |  |  | 0 | return (1,0); | 
| 448 |  |  |  |  |  |  | } | 
| 449 |  |  |  |  |  |  |  | 
| 450 |  |  |  |  |  |  | # arm start 0,1 at X=0,Y=0 | 
| 451 |  |  |  |  |  |  | #           2,3 at X=0,Y=1 | 
| 452 |  |  |  |  |  |  | #           4,5 at X=-1,Y=1 | 
| 453 |  |  |  |  |  |  | #           6,7 at X=-1,Y=1 | 
| 454 |  |  |  |  |  |  | # arms>=6 is arm=5 starting at Y=+1, so 1-$y1 | 
| 455 |  |  |  |  |  |  | # arms>=8 starts at X=-1 so extra +1 for x2 to the right in that case | 
| 456 | 40 | 100 |  |  |  | 174 | my ($len, $level) =round_down_pow (max ($x2+($arms>=8), | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
| 457 |  |  |  |  |  |  | ($arms >= 2 ? $y2 : ()), | 
| 458 |  |  |  |  |  |  | ($arms >= 4 ? -$x1 : ()), | 
| 459 |  |  |  |  |  |  | ($arms >= 6 ? 1-$y1 : ())), | 
| 460 |  |  |  |  |  |  | 2); | 
| 461 | 40 |  |  |  |  | 123 | return (0, 4*$arms*$len*$len-1); | 
| 462 |  |  |  |  |  |  | } | 
| 463 |  |  |  |  |  |  |  | 
| 464 |  |  |  |  |  |  |  | 
| 465 |  |  |  |  |  |  | my @dir4_to_dx = (1,0,-1,0); | 
| 466 |  |  |  |  |  |  | my @dir4_to_dy = (0,1,0,-1); | 
| 467 |  |  |  |  |  |  |  | 
| 468 |  |  |  |  |  |  | sub n_to_dxdy { | 
| 469 | 2000 |  |  | 2000 | 1 | 37422 | my ($self, $n) = @_; | 
| 470 |  |  |  |  |  |  | ### n_to_dxdy(): $n | 
| 471 |  |  |  |  |  |  |  | 
| 472 | 2000 | 50 |  |  |  | 3579 | if ($n < 0) { return; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 473 | 2000 | 50 |  |  |  | 3557 | if (is_infinite($n)) { return ($n,$n); } | 
|  | 0 |  |  |  |  | 0 |  | 
| 474 | 2000 |  |  |  |  | 3445 | my $int = int($n); | 
| 475 | 2000 |  |  |  |  | 2642 | $n -= $int;  # $n fraction part | 
| 476 |  |  |  |  |  |  | ### $int | 
| 477 |  |  |  |  |  |  | ### $n | 
| 478 |  |  |  |  |  |  |  | 
| 479 | 2000 |  |  |  |  | 3928 | my $arm = _divrem_mutate ($int, $self->{'arms'}); | 
| 480 |  |  |  |  |  |  | ### $arm | 
| 481 |  |  |  |  |  |  | ### $int | 
| 482 |  |  |  |  |  |  |  | 
| 483 |  |  |  |  |  |  | # $dir initial direction from the arm. | 
| 484 |  |  |  |  |  |  | # $inc +/-1 according to the bit position odd or even, but also odd | 
| 485 |  |  |  |  |  |  | # numbered arms are transposed so flip them. | 
| 486 |  |  |  |  |  |  | # | 
| 487 | 2000 |  |  |  |  | 3796 | my @bits = bit_split_lowtohigh($int); | 
| 488 | 2000 |  |  |  |  | 3498 | my $dir = ($arm+1) >> 1; | 
| 489 | 2000 | 100 |  |  |  | 3885 | my $inc = (($#bits ^ $arm) & 1 ? -1 : 1); | 
| 490 | 2000 |  |  |  |  | 2875 | my $prev = 0; | 
| 491 |  |  |  |  |  |  |  | 
| 492 |  |  |  |  |  |  | ### @bits | 
| 493 |  |  |  |  |  |  | ### initial dir: $dir | 
| 494 |  |  |  |  |  |  | ### initial inc: $inc | 
| 495 |  |  |  |  |  |  |  | 
| 496 | 2000 |  |  |  |  | 3086 | foreach my $bit (reverse @bits) { | 
| 497 | 15991 | 100 |  |  |  | 27218 | if ($bit != $prev) { | 
| 498 | 9088 |  |  |  |  | 11439 | $dir += $inc; | 
| 499 | 9088 |  |  |  |  | 12230 | $prev = $bit; | 
| 500 |  |  |  |  |  |  | } | 
| 501 | 15991 |  |  |  |  | 22596 | $inc = -$inc;   # opposite at each bit | 
| 502 |  |  |  |  |  |  | } | 
| 503 | 2000 |  |  |  |  | 2700 | $dir &= 3; | 
| 504 | 2000 |  |  |  |  | 2884 | my $dx = $dir4_to_dx[$dir]; | 
| 505 | 2000 |  |  |  |  | 2497 | my $dy = $dir4_to_dy[$dir]; | 
| 506 |  |  |  |  |  |  | ### $dx | 
| 507 |  |  |  |  |  |  | ### $dy | 
| 508 |  |  |  |  |  |  |  | 
| 509 | 2000 | 50 |  |  |  | 3449 | if ($n) { | 
| 510 |  |  |  |  |  |  | ### apply fraction part: $n | 
| 511 |  |  |  |  |  |  |  | 
| 512 |  |  |  |  |  |  | # maybe: | 
| 513 |  |  |  |  |  |  | # +/- $n as dx or dy | 
| 514 |  |  |  |  |  |  | # +/- (1-$n) as other dy or dx | 
| 515 |  |  |  |  |  |  |  | 
| 516 |  |  |  |  |  |  | # strip any low 1-bits, and the 0-bit above them | 
| 517 |  |  |  |  |  |  | # $inc is +1 at an even bit position or -1 at an odd bit position | 
| 518 | 0 | 0 |  |  |  | 0 | $inc = my $inc = ($arm & 1 ? -1 : 1); | 
| 519 | 0 |  |  |  |  | 0 | while (shift @bits) { | 
| 520 | 0 |  |  |  |  | 0 | $inc = -$inc; | 
| 521 |  |  |  |  |  |  | } | 
| 522 | 0 | 0 |  |  |  | 0 | if ($bits[0]) { # bit above lowest 0-bit, 1=right,0=left | 
| 523 | 0 |  |  |  |  | 0 | $inc = -$inc; | 
| 524 |  |  |  |  |  |  | } | 
| 525 | 0 |  |  |  |  | 0 | $dir += $inc;   # apply turn to give $dir at $n+1 | 
| 526 | 0 |  |  |  |  | 0 | $dir &= 3; | 
| 527 | 0 |  |  |  |  | 0 | $dx += $n*($dir4_to_dx[$dir] - $dx); | 
| 528 | 0 |  |  |  |  | 0 | $dy += $n*($dir4_to_dy[$dir] - $dy); | 
| 529 |  |  |  |  |  |  | } | 
| 530 |  |  |  |  |  |  |  | 
| 531 |  |  |  |  |  |  | ### result: "$dx, $dy" | 
| 532 | 2000 |  |  |  |  | 5433 | return ($dx,$dy); | 
| 533 |  |  |  |  |  |  | } | 
| 534 |  |  |  |  |  |  |  | 
| 535 |  |  |  |  |  |  | # { | 
| 536 |  |  |  |  |  |  | #   sub print_table { | 
| 537 |  |  |  |  |  |  | #     my ($name, $aref) = @_; | 
| 538 |  |  |  |  |  |  | #     print "my \@$name = ("; | 
| 539 |  |  |  |  |  |  | #     my $entry_width = max (map {length($_//'')} @$aref); | 
| 540 |  |  |  |  |  |  | # | 
| 541 |  |  |  |  |  |  | #     foreach my $i (0 .. $#$aref) { | 
| 542 |  |  |  |  |  |  | #       printf "%*s", $entry_width, $aref->[$i]//'undef'; | 
| 543 |  |  |  |  |  |  | #       if ($i == $#$aref) { | 
| 544 |  |  |  |  |  |  | #         print ");\n"; | 
| 545 |  |  |  |  |  |  | #       } else { | 
| 546 |  |  |  |  |  |  | #         print ","; | 
| 547 |  |  |  |  |  |  | #         if (($i % 16) == 15 | 
| 548 |  |  |  |  |  |  | #             || ($entry_width >= 3 && ($i % 4) == 3)) { | 
| 549 |  |  |  |  |  |  | #           print "\n        ".(" " x length($name)); | 
| 550 |  |  |  |  |  |  | #         } elsif (($i % 4) == 3) { | 
| 551 |  |  |  |  |  |  | #           print " "; | 
| 552 |  |  |  |  |  |  | #         } | 
| 553 |  |  |  |  |  |  | #       } | 
| 554 |  |  |  |  |  |  | #     } | 
| 555 |  |  |  |  |  |  | #   } | 
| 556 |  |  |  |  |  |  | # | 
| 557 |  |  |  |  |  |  | #   my @next_state; | 
| 558 |  |  |  |  |  |  | # my @state_to_dxdy; | 
| 559 |  |  |  |  |  |  | # | 
| 560 |  |  |  |  |  |  | # sub make_state { | 
| 561 |  |  |  |  |  |  | #   my %values = @_; | 
| 562 |  |  |  |  |  |  | #   #  if ($oddpos) { $rot = ($rot-1)&3; } | 
| 563 |  |  |  |  |  |  | #   my $state = delete $values{'nextturn'}; | 
| 564 |  |  |  |  |  |  | #   $state <<= 2; $state |= delete $values{'rot'}; | 
| 565 |  |  |  |  |  |  | #   $state <<= 1; $state |= delete $values{'oddpos'}; | 
| 566 |  |  |  |  |  |  | #   $state <<= 1; $state |= delete $values{'lowerbit'}; | 
| 567 |  |  |  |  |  |  | #   $state <<= 1; $state |= delete $values{'bit'}; | 
| 568 |  |  |  |  |  |  | #   die if %values; | 
| 569 |  |  |  |  |  |  | #   return $state; | 
| 570 |  |  |  |  |  |  | # } | 
| 571 |  |  |  |  |  |  | # sub state_string { | 
| 572 |  |  |  |  |  |  | #   my ($state) = @_; | 
| 573 |  |  |  |  |  |  | #   my $bit = $state & 1;  $state >>= 1; | 
| 574 |  |  |  |  |  |  | #   my $lowerbit = $state & 1;  $state >>= 1; | 
| 575 |  |  |  |  |  |  | #   my $oddpos = $state & 1;  $state >>= 1; | 
| 576 |  |  |  |  |  |  | #   my $rot = $state & 3;  $state >>= 2; | 
| 577 |  |  |  |  |  |  | #   my $nextturn = $state; | 
| 578 |  |  |  |  |  |  | #   #  if ($oddpos) { $rot = ($rot+1)&3; } | 
| 579 |  |  |  |  |  |  | #   return "rot=$rot,oddpos=$oddpos nextturn=$nextturn  lowerbit=$lowerbit (bit=$bit)"; | 
| 580 |  |  |  |  |  |  | # } | 
| 581 |  |  |  |  |  |  | # | 
| 582 |  |  |  |  |  |  | # foreach my $nextturn (0, 1, 2) { | 
| 583 |  |  |  |  |  |  | #   foreach my $rot (0, 1, 2, 3) { | 
| 584 |  |  |  |  |  |  | #     foreach my $oddpos (0, 1) { | 
| 585 |  |  |  |  |  |  | #       foreach my $lowerbit (0, 1) { | 
| 586 |  |  |  |  |  |  | #         foreach my $bit (0, 1) { | 
| 587 |  |  |  |  |  |  | #           my $state = make_state (bit      => $bit, | 
| 588 |  |  |  |  |  |  | #                                   lowerbit => $lowerbit, | 
| 589 |  |  |  |  |  |  | #                                   rot      => $rot, | 
| 590 |  |  |  |  |  |  | #                                   oddpos   => $oddpos, | 
| 591 |  |  |  |  |  |  | #                                   nextturn => $nextturn); | 
| 592 |  |  |  |  |  |  | #           ### $state | 
| 593 |  |  |  |  |  |  | # | 
| 594 |  |  |  |  |  |  | #           my $new_nextturn = $nextturn; | 
| 595 |  |  |  |  |  |  | #           my $new_lowerbit = $bit; | 
| 596 |  |  |  |  |  |  | #           my $new_rot = $rot; | 
| 597 |  |  |  |  |  |  | #           my $new_oddpos = $oddpos ^ 1; | 
| 598 |  |  |  |  |  |  | # | 
| 599 |  |  |  |  |  |  | #           if ($bit != $lowerbit) { | 
| 600 |  |  |  |  |  |  | #             if ($oddpos) { | 
| 601 |  |  |  |  |  |  | #               $new_rot++; | 
| 602 |  |  |  |  |  |  | #             } else { | 
| 603 |  |  |  |  |  |  | #               $new_rot--; | 
| 604 |  |  |  |  |  |  | #             } | 
| 605 |  |  |  |  |  |  | #             $new_rot &= 3; | 
| 606 |  |  |  |  |  |  | #           } | 
| 607 |  |  |  |  |  |  | #           if ($lowerbit == 0 && ! $nextturn) { | 
| 608 |  |  |  |  |  |  | #             $new_nextturn = ($bit ^ $oddpos ? 1 : 2);  # bit above lowest 0 | 
| 609 |  |  |  |  |  |  | #           } | 
| 610 |  |  |  |  |  |  | # | 
| 611 |  |  |  |  |  |  | #           my $dx = 1; | 
| 612 |  |  |  |  |  |  | #           my $dy = 0; | 
| 613 |  |  |  |  |  |  | #           if ($rot & 2) { | 
| 614 |  |  |  |  |  |  | #             $dx = -$dx; | 
| 615 |  |  |  |  |  |  | #             $dy = -$dy; | 
| 616 |  |  |  |  |  |  | #           } | 
| 617 |  |  |  |  |  |  | #           if ($rot & 1) { | 
| 618 |  |  |  |  |  |  | #             ($dx,$dy) = (-$dy,$dx); # rotate +90 | 
| 619 |  |  |  |  |  |  | #           } | 
| 620 |  |  |  |  |  |  | #           ### rot to: "$dx, $dy" | 
| 621 |  |  |  |  |  |  | # | 
| 622 |  |  |  |  |  |  | #           # if ($oddpos) { | 
| 623 |  |  |  |  |  |  | #           #   ($dx,$dy) = (-$dy,$dx); # rotate +90 | 
| 624 |  |  |  |  |  |  | #           # } else { | 
| 625 |  |  |  |  |  |  | #           #   ($dx,$dy) = ($dy,-$dx); # rotate -90 | 
| 626 |  |  |  |  |  |  | #           # } | 
| 627 |  |  |  |  |  |  | # | 
| 628 |  |  |  |  |  |  | #           my $next_dx = $dx; | 
| 629 |  |  |  |  |  |  | #           my $next_dy = $dy; | 
| 630 |  |  |  |  |  |  | #           if ($nextturn == 2) { | 
| 631 |  |  |  |  |  |  | #             ($next_dx,$next_dy) = (-$next_dy,$next_dx); # left, rotate +90 | 
| 632 |  |  |  |  |  |  | #           } else { | 
| 633 |  |  |  |  |  |  | #             ($next_dx,$next_dy) = ($next_dy,-$next_dx); # right, rotate -90 | 
| 634 |  |  |  |  |  |  | #           } | 
| 635 |  |  |  |  |  |  | #           my $frac_dx = $next_dx - $dx; | 
| 636 |  |  |  |  |  |  | #           my $frac_dy = $next_dy - $dy; | 
| 637 |  |  |  |  |  |  | # | 
| 638 |  |  |  |  |  |  | #           # mask to rot,oddpos only, ignore bit,lowerbit | 
| 639 |  |  |  |  |  |  | #           my $masked_state = $state & ~3; | 
| 640 |  |  |  |  |  |  | #           $state_to_dxdy[$masked_state]     = $dx; | 
| 641 |  |  |  |  |  |  | #           $state_to_dxdy[$masked_state + 1] = $dy; | 
| 642 |  |  |  |  |  |  | #           $state_to_dxdy[$masked_state + 2] = $frac_dx; | 
| 643 |  |  |  |  |  |  | #           $state_to_dxdy[$masked_state + 3] = $frac_dy; | 
| 644 |  |  |  |  |  |  | # | 
| 645 |  |  |  |  |  |  | #           my $next_state =  make_state (bit      => 0, | 
| 646 |  |  |  |  |  |  | #                                         lowerbit => $new_lowerbit, | 
| 647 |  |  |  |  |  |  | #                                         rot      => $new_rot, | 
| 648 |  |  |  |  |  |  | #                                         oddpos   => $new_oddpos, | 
| 649 |  |  |  |  |  |  | #                                         nextturn => $new_nextturn); | 
| 650 |  |  |  |  |  |  | #           $next_state[$state] = $next_state; | 
| 651 |  |  |  |  |  |  | #         } | 
| 652 |  |  |  |  |  |  | #       } | 
| 653 |  |  |  |  |  |  | #     } | 
| 654 |  |  |  |  |  |  | #   } | 
| 655 |  |  |  |  |  |  | # } | 
| 656 |  |  |  |  |  |  | # | 
| 657 |  |  |  |  |  |  | # my @arm_to_state; | 
| 658 |  |  |  |  |  |  | # foreach my $arm (0 .. 7) { | 
| 659 |  |  |  |  |  |  | #   my $rot = $arm >> 1; | 
| 660 |  |  |  |  |  |  | #   my $oddpos = 0; | 
| 661 |  |  |  |  |  |  | #   if ($arm & 1) { | 
| 662 |  |  |  |  |  |  | #     $rot++; | 
| 663 |  |  |  |  |  |  | #     $oddpos ^= 1; | 
| 664 |  |  |  |  |  |  | #   } | 
| 665 |  |  |  |  |  |  | #   $arm_to_state[$arm] = make_state (bit => 0, | 
| 666 |  |  |  |  |  |  | #                                     lowerbit => 0, | 
| 667 |  |  |  |  |  |  | #                                     rot => $rot, | 
| 668 |  |  |  |  |  |  | #                                     oddpos => $oddpos, | 
| 669 |  |  |  |  |  |  | #                                     nextturn => 0); | 
| 670 |  |  |  |  |  |  | # } | 
| 671 |  |  |  |  |  |  | # | 
| 672 |  |  |  |  |  |  | # ### @next_state | 
| 673 |  |  |  |  |  |  | # ### @state_to_dxdy | 
| 674 |  |  |  |  |  |  | # ### next_state length: 4*(4*2*2 + 4*2) | 
| 675 |  |  |  |  |  |  | # | 
| 676 |  |  |  |  |  |  | # print "# next_state length ", scalar(@next_state), "\n"; | 
| 677 |  |  |  |  |  |  | # print_table ("next_state", \@next_state); | 
| 678 |  |  |  |  |  |  | # print_table ("state_to_dxdy", \@state_to_dxdy); | 
| 679 |  |  |  |  |  |  | # print_table ("arm_to_state", \@arm_to_state); | 
| 680 |  |  |  |  |  |  | # print "\n"; | 
| 681 |  |  |  |  |  |  | # | 
| 682 |  |  |  |  |  |  | # foreach my $arm (0 .. 7) { | 
| 683 |  |  |  |  |  |  | #   print "# arm=$arm  ",state_string($arm_to_state[$arm]),"\n"; | 
| 684 |  |  |  |  |  |  | # } | 
| 685 |  |  |  |  |  |  | # print "\n"; | 
| 686 |  |  |  |  |  |  | # | 
| 687 |  |  |  |  |  |  | # | 
| 688 |  |  |  |  |  |  | # | 
| 689 |  |  |  |  |  |  | #   use Smart::Comments; | 
| 690 |  |  |  |  |  |  | # | 
| 691 |  |  |  |  |  |  | #   sub n_to_dxdy { | 
| 692 |  |  |  |  |  |  | #     my ($self, $n) = @_; | 
| 693 |  |  |  |  |  |  | #     ### n_to_dxdy(): $n | 
| 694 |  |  |  |  |  |  | # | 
| 695 |  |  |  |  |  |  | #     my $int = int($n); | 
| 696 |  |  |  |  |  |  | #     $n -= $int;  # $n fraction part | 
| 697 |  |  |  |  |  |  | #     ### $int | 
| 698 |  |  |  |  |  |  | #     ### $n | 
| 699 |  |  |  |  |  |  | # | 
| 700 |  |  |  |  |  |  | #     my $state = _divrem_mutate ($int, $self->{'arms'}) << 2; | 
| 701 |  |  |  |  |  |  | #     ### arm as initial state: $state | 
| 702 |  |  |  |  |  |  | # | 
| 703 |  |  |  |  |  |  | #     foreach my $bit (bit_split_lowtohigh($int)) { | 
| 704 |  |  |  |  |  |  | #       $state = $next_state[$state + $bit]; | 
| 705 |  |  |  |  |  |  | #     } | 
| 706 |  |  |  |  |  |  | #     $state &= 0x1C;  # mask out "prevbit" | 
| 707 |  |  |  |  |  |  | # | 
| 708 |  |  |  |  |  |  | #     ### final state: $state | 
| 709 |  |  |  |  |  |  | #     ### dx: $state_to_dxdy[$state] | 
| 710 |  |  |  |  |  |  | #     ### dy: $state_to_dxdy[$state+1], | 
| 711 |  |  |  |  |  |  | #     ### frac dx: $state_to_dxdy[$state+2], | 
| 712 |  |  |  |  |  |  | #     ### frac dy: $state_to_dxdy[$state+3], | 
| 713 |  |  |  |  |  |  | # | 
| 714 |  |  |  |  |  |  | #     return ($state_to_dxdy[$state]   + $n * $state_to_dxdy[$state+2], | 
| 715 |  |  |  |  |  |  | #             $state_to_dxdy[$state+1] + $n * $state_to_dxdy[$state+3]); | 
| 716 |  |  |  |  |  |  | #   } | 
| 717 |  |  |  |  |  |  | # | 
| 718 |  |  |  |  |  |  | # } | 
| 719 |  |  |  |  |  |  |  | 
| 720 |  |  |  |  |  |  | #------------------------------------------------------------------------------ | 
| 721 |  |  |  |  |  |  | # levels | 
| 722 |  |  |  |  |  |  |  | 
| 723 | 2 |  |  | 2 |  | 1285 | use Math::PlanePath::DragonCurve; | 
|  | 2 |  |  |  |  | 6 |  | 
|  | 2 |  |  |  |  | 1843 |  | 
| 724 |  |  |  |  |  |  | *level_to_n_range = \&Math::PlanePath::DragonCurve::level_to_n_range; | 
| 725 |  |  |  |  |  |  | *n_to_level       = \&Math::PlanePath::DragonCurve::n_to_level; | 
| 726 |  |  |  |  |  |  |  | 
| 727 |  |  |  |  |  |  | #------------------------------------------------------------------------------ | 
| 728 |  |  |  |  |  |  |  | 
| 729 |  |  |  |  |  |  | sub _UNDOCUMENTED_level_to_right_line_boundary { | 
| 730 | 0 |  |  | 0 |  |  | my ($self, $level) = @_; | 
| 731 | 0 | 0 |  |  |  |  | if ($level == 0) { | 
| 732 | 0 |  |  |  |  |  | return 1; | 
| 733 |  |  |  |  |  |  | } | 
| 734 | 0 |  |  |  |  |  | my ($h,$odd) = _divrem($level,2); | 
| 735 | 0 | 0 |  |  |  |  | return ($odd | 
| 736 |  |  |  |  |  |  | ? 6 * 2**$h - 4 | 
| 737 |  |  |  |  |  |  | : 2 * 2**$h); | 
| 738 |  |  |  |  |  |  | } | 
| 739 |  |  |  |  |  |  | sub _UNDOCUMENTED_level_to_left_line_boundary { | 
| 740 | 0 |  |  | 0 |  |  | my ($self, $level) = @_; | 
| 741 | 0 | 0 |  |  |  |  | if ($level == 0) { | 
| 742 | 0 |  |  |  |  |  | return 1; | 
| 743 |  |  |  |  |  |  | } | 
| 744 | 0 |  |  |  |  |  | my ($h,$odd) = _divrem($level,2); | 
| 745 | 0 | 0 |  |  |  |  | return ($odd | 
| 746 |  |  |  |  |  |  | ? 2 * 2**$h | 
| 747 |  |  |  |  |  |  | : 4 * 2**$h - 4); | 
| 748 |  |  |  |  |  |  | } | 
| 749 |  |  |  |  |  |  | sub _UNDOCUMENTED_level_to_line_boundary { | 
| 750 | 0 |  |  | 0 |  |  | my ($self, $level) = @_; | 
| 751 | 0 |  |  |  |  |  | my ($h,$odd) = _divrem($level,2); | 
| 752 | 0 | 0 |  |  |  |  | return (($odd?8:6) * 2**$h - 4); | 
| 753 |  |  |  |  |  |  | } | 
| 754 |  |  |  |  |  |  |  | 
| 755 |  |  |  |  |  |  | sub _UNDOCUMENTED_level_to_hull_area { | 
| 756 | 0 |  |  | 0 |  |  | my ($self, $level) = @_; | 
| 757 | 0 |  |  |  |  |  | return (2**$level - 1)/2; | 
| 758 |  |  |  |  |  |  | } | 
| 759 |  |  |  |  |  |  |  | 
| 760 |  |  |  |  |  |  | sub _UNDOCUMENTED__n_is_x_positive { | 
| 761 | 0 |  |  | 0 |  |  | my ($self, $n) = @_; | 
| 762 | 0 | 0 | 0 |  |  |  | if (! ($n >= 0) || is_infinite($n)) { return 0; } | 
|  | 0 |  |  |  |  |  |  | 
| 763 |  |  |  |  |  |  |  | 
| 764 | 0 |  |  |  |  |  | $n = int($n); | 
| 765 |  |  |  |  |  |  | { | 
| 766 | 0 |  |  |  |  |  | my $arm = _divrem_mutate($n, $self->{'arms'}); | 
|  | 0 |  |  |  |  |  |  | 
| 767 |  |  |  |  |  |  |  | 
| 768 |  |  |  |  |  |  | # arm 1 good only on N=1 which is remaining $n==0 | 
| 769 | 0 | 0 |  |  |  |  | if ($arm == 1) { | 
| 770 | 0 |  |  |  |  |  | return ($n == 0); | 
| 771 |  |  |  |  |  |  | } | 
| 772 |  |  |  |  |  |  |  | 
| 773 |  |  |  |  |  |  | # arm 0 good | 
| 774 |  |  |  |  |  |  | # arm 8 good for N>=15 which is remaining $n>=1 | 
| 775 | 0 | 0 | 0 |  |  |  | unless ($arm == 0 | 
|  |  |  | 0 |  |  |  |  | 
| 776 |  |  |  |  |  |  | || ($arm == 7 && $n > 0)) { | 
| 777 | 0 |  |  |  |  |  | return 0; | 
| 778 |  |  |  |  |  |  | } | 
| 779 |  |  |  |  |  |  | } | 
| 780 |  |  |  |  |  |  |  | 
| 781 | 0 |  |  |  |  |  | return _is_base4_01($n); | 
| 782 |  |  |  |  |  |  | } | 
| 783 |  |  |  |  |  |  |  | 
| 784 |  |  |  |  |  |  | sub _UNDOCUMENTED__n_is_diagonal_NE { | 
| 785 | 0 |  |  | 0 |  |  | my ($self, $n) = @_; | 
| 786 | 0 | 0 | 0 |  |  |  | if (! ($n >= 0) || is_infinite($n)) { return 0; } | 
|  | 0 |  |  |  |  |  |  | 
| 787 |  |  |  |  |  |  |  | 
| 788 | 0 |  |  |  |  |  | $n = int($n); | 
| 789 | 0 | 0 | 0 |  |  |  | if ($self->{'arms'} >= 8 && $n == 15) { return 1; } | 
|  | 0 |  |  |  |  |  |  | 
| 790 | 0 | 0 |  |  |  |  | if (_divrem_mutate($n, $self->{'arms'}) >= 2) { return 0; } | 
|  | 0 |  |  |  |  |  |  | 
| 791 | 0 |  |  |  |  |  | return _is_base4_02($n); | 
| 792 |  |  |  |  |  |  | } | 
| 793 |  |  |  |  |  |  |  | 
| 794 |  |  |  |  |  |  | # X axis N is base4 digits 0,1 | 
| 795 |  |  |  |  |  |  | # and -1 from even is 0,1 low 0333333 | 
| 796 |  |  |  |  |  |  | # and -2 from even is 0,1 low 0333332 | 
| 797 |  |  |  |  |  |  | # so $n+2 low digit any then 0,1s above | 
| 798 |  |  |  |  |  |  | sub _UNDOCUMENTED__n_segment_is_right_boundary { | 
| 799 | 0 |  |  | 0 |  |  | my ($self, $n) = @_; | 
| 800 | 0 | 0 | 0 |  |  |  | if ($self->{'arms'} >= 8 | 
|  |  |  | 0 |  |  |  |  | 
| 801 |  |  |  |  |  |  | || ! ($n >= 0) | 
| 802 |  |  |  |  |  |  | || is_infinite($n)) { | 
| 803 | 0 |  |  |  |  |  | return 0; | 
| 804 |  |  |  |  |  |  | } | 
| 805 | 0 |  |  |  |  |  | $n = int($n); | 
| 806 |  |  |  |  |  |  |  | 
| 807 | 0 | 0 |  |  |  |  | if (_divrem_mutate($n, $self->{'arms'}) >= 1) { | 
| 808 | 0 |  |  |  |  |  | return 0; | 
| 809 |  |  |  |  |  |  | } | 
| 810 | 0 |  |  |  |  |  | $n += 2; | 
| 811 | 0 |  |  |  |  |  | _divrem_mutate($n,4); | 
| 812 | 0 |  |  |  |  |  | return _is_base4_01($n); | 
| 813 |  |  |  |  |  |  | } | 
| 814 |  |  |  |  |  |  |  | 
| 815 |  |  |  |  |  |  | # diagonal N is base4 digits 0,2, | 
| 816 |  |  |  |  |  |  | # and -1 from there is 0,2 low 1 | 
| 817 |  |  |  |  |  |  | #                   or 0,2 low 13333 | 
| 818 |  |  |  |  |  |  | # so $n+1 low digit possible 1 or 3 then 0,2s above | 
| 819 |  |  |  |  |  |  | # which means $n+1 low digit any and 0,2s above | 
| 820 |  |  |  |  |  |  | #use Smart::Comments; | 
| 821 |  |  |  |  |  |  |  | 
| 822 |  |  |  |  |  |  | sub _UNDOCUMENTED__n_segment_is_left_boundary { | 
| 823 | 0 |  |  | 0 |  |  | my ($self, $n) = @_; | 
| 824 |  |  |  |  |  |  | ### _UNDOCUMENTED__n_segment_is_left_boundary(): $n | 
| 825 |  |  |  |  |  |  |  | 
| 826 | 0 |  |  |  |  |  | my $arms = $self->{'arms'}; | 
| 827 | 0 | 0 | 0 |  |  |  | if ($arms >= 8 | 
|  |  |  | 0 |  |  |  |  | 
| 828 |  |  |  |  |  |  | || ! ($n >= 0) | 
| 829 |  |  |  |  |  |  | || is_infinite($n)) { | 
| 830 | 0 |  |  |  |  |  | return 0; | 
| 831 |  |  |  |  |  |  | } | 
| 832 | 0 |  |  |  |  |  | $n = int($n); | 
| 833 |  |  |  |  |  |  |  | 
| 834 | 0 | 0 | 0 |  |  |  | if (($n == 1 && $arms >= 4) | 
|  |  |  | 0 |  |  |  |  | 
|  |  |  | 0 |  |  |  |  | 
|  |  |  | 0 |  |  |  |  | 
|  |  |  | 0 |  |  |  |  | 
| 835 |  |  |  |  |  |  | || ($n == 3 && $arms >= 5) | 
| 836 |  |  |  |  |  |  | || ($n == 5 && $arms == 7)) { | 
| 837 | 0 |  |  |  |  |  | return 1; | 
| 838 |  |  |  |  |  |  | } | 
| 839 | 0 | 0 |  |  |  |  | if (_divrem_mutate($n, $arms) < $arms-1) { | 
| 840 |  |  |  |  |  |  | ### no, not last arm ... | 
| 841 | 0 |  |  |  |  |  | return 0; | 
| 842 |  |  |  |  |  |  | } | 
| 843 |  |  |  |  |  |  |  | 
| 844 | 0 | 0 |  |  |  |  | if ($arms % 2) { | 
| 845 |  |  |  |  |  |  | ### odd arms, stair-step boundary ... | 
| 846 | 0 |  |  |  |  |  | $n += 1; | 
| 847 | 0 |  |  |  |  |  | _divrem_mutate($n,4); | 
| 848 | 0 |  |  |  |  |  | return _is_base4_02($n); | 
| 849 |  |  |  |  |  |  | } else { | 
| 850 |  |  |  |  |  |  | # even arms, notched like right boundary | 
| 851 | 0 |  |  |  |  |  | $n += 2; | 
| 852 | 0 |  |  |  |  |  | _divrem_mutate($n,4); | 
| 853 | 0 |  |  |  |  |  | return _is_base4_01($n); | 
| 854 |  |  |  |  |  |  | } | 
| 855 |  |  |  |  |  |  | } | 
| 856 |  |  |  |  |  |  |  | 
| 857 |  |  |  |  |  |  | sub _is_base4_01 { | 
| 858 | 0 |  |  | 0 |  |  | my ($n) = @_; | 
| 859 | 0 |  |  |  |  |  | while ($n) { | 
| 860 | 0 |  |  |  |  |  | my $digit = _divrem_mutate($n,4); | 
| 861 | 0 | 0 |  |  |  |  | if ($digit >= 2) { return 0; } | 
|  | 0 |  |  |  |  |  |  | 
| 862 |  |  |  |  |  |  | } | 
| 863 | 0 |  |  |  |  |  | return 1; | 
| 864 |  |  |  |  |  |  | } | 
| 865 |  |  |  |  |  |  | sub _is_base4_02 { | 
| 866 | 0 |  |  | 0 |  |  | my ($n) = @_; | 
| 867 | 0 |  |  |  |  |  | while ($n) { | 
| 868 | 0 |  |  |  |  |  | my $digit = _divrem_mutate($n,4); | 
| 869 | 0 | 0 | 0 |  |  |  | if ($digit == 1 || $digit == 3) { return 0; } | 
|  | 0 |  |  |  |  |  |  | 
| 870 |  |  |  |  |  |  | } | 
| 871 | 0 |  |  |  |  |  | return 1; | 
| 872 |  |  |  |  |  |  | } | 
| 873 |  |  |  |  |  |  |  | 
| 874 |  |  |  |  |  |  | 1; | 
| 875 |  |  |  |  |  |  | __END__ |